diff options
Diffstat (limited to 'gcc/cobol')
| -rw-r--r-- | gcc/cobol/ChangeLog | 402 | ||||
| -rw-r--r-- | gcc/cobol/Make-lang.in | 19 | ||||
| -rw-r--r-- | gcc/cobol/cbldiag.h | 20 | ||||
| -rw-r--r-- | gcc/cobol/cdf.y | 2 | ||||
| -rw-r--r-- | gcc/cobol/cobol1.cc | 8 | ||||
| -rw-r--r-- | gcc/cobol/dts.h | 2 | ||||
| -rw-r--r-- | gcc/cobol/except.cc | 2 | ||||
| -rw-r--r-- | gcc/cobol/gcobolspec.cc | 26 | ||||
| -rw-r--r-- | gcc/cobol/genapi.cc | 786 | ||||
| -rw-r--r-- | gcc/cobol/genapi.h | 47 | ||||
| -rw-r--r-- | gcc/cobol/gengen.cc | 120 | ||||
| -rw-r--r-- | gcc/cobol/gengen.h | 10 | ||||
| -rw-r--r-- | gcc/cobol/genmath.cc | 27 | ||||
| -rw-r--r-- | gcc/cobol/genutil.cc | 101 | ||||
| -rw-r--r-- | gcc/cobol/genutil.h | 14 | ||||
| -rw-r--r-- | gcc/cobol/lexio.cc | 33 | ||||
| -rw-r--r-- | gcc/cobol/lexio.h | 4 | ||||
| -rw-r--r-- | gcc/cobol/parse.y | 26 | ||||
| -rw-r--r-- | gcc/cobol/parse_ante.h | 10 | ||||
| -rw-r--r-- | gcc/cobol/scan.l | 40 | ||||
| -rw-r--r-- | gcc/cobol/scan_ante.h | 391 | ||||
| -rw-r--r-- | gcc/cobol/show_parse.h | 49 | ||||
| -rw-r--r-- | gcc/cobol/symbols.cc | 49 | ||||
| -rw-r--r-- | gcc/cobol/symbols.h | 2 | ||||
| -rw-r--r-- | gcc/cobol/symfind.cc | 14 | ||||
| -rw-r--r-- | gcc/cobol/util.cc | 166 | ||||
| -rw-r--r-- | gcc/cobol/util.h | 4 |
27 files changed, 1765 insertions, 609 deletions
diff --git a/gcc/cobol/ChangeLog b/gcc/cobol/ChangeLog index 6c3e1bd..35d645c 100644 --- a/gcc/cobol/ChangeLog +++ b/gcc/cobol/ChangeLog @@ -1,3 +1,405 @@ +2025-08-02 Jakub Jelinek <jakub@redhat.com> + + * parse.y (intrinsic): Use %td format specifier with no cast on + argument instead of %ld with cast to long. + * scan_ante.h (numstr_of): Likewise. + * util.cc (cbl_field_t::report_invalid_initial_value): Likewise. + +2025-08-01 Robert Dubner <rdubner@symas.com> + + PR cobol/119324 + * cbldiag.h (location_dump): Inline suppression of knownConditionTrueFalse. + * genapi.cc (parser_statement_begin): Combine two if() statements. + * genutil.cc (get_binary_value): File-level suppression of duplicateBreak. + * symbols.cc (symbol_elem_cmp): File-level suppression of duplicateBreak. + +2025-07-31 Robert Dubner <rdubner@symas.com> + + PR cobol/120244 + * genapi.cc (get_level_88_domain): Increase array size for final byte. + (psa_FldLiteralA): Use correct length in build_string_literal call. + * scan.l: Use a loop instead of std:transform to avoid EOF overrun. + * scan_ante.h (binary_integer_usage): Use a variable-length buffer. + +2025-07-25 David Malcolm <dmalcolm@redhat.com> + + * util.cc: Update for diagnostic_t becoming + enum class diagnostics::kind. + +2025-07-25 David Malcolm <dmalcolm@redhat.com> + + * util.cc: Update for renaming of diagnostic_option_id to + diagnostics::option_id. + +2025-07-25 David Malcolm <dmalcolm@redhat.com> + + * util.cc: Remove redundant #includes + +2025-07-24 Robert Dubner <rdubner@symas.com> + + PR cobol/119231 + * gcobolspec.cc: (lang_specific_driver): Pass OPT_static through. + Handle -static and -static-libgcobol properly. + +2025-07-23 Robert Dubner <rdubner@symas.com> + + * genapi.cc (leave_procedure): Adjust location_t for PERFORM. + (parser_perform_times): Likewise. + (internal_perform_through_times): Likewise. + (perform_outofline_before_until): Likewise. + (perform_outofline_after_until): Likewise. + (perform_outofline_testafter_varying): Likewise. + (perform_outofline_before_varying): Likewise. + +2025-07-21 Robert Dubner <rdubner@symas.com> + James K. Lowden <jklowden@cobolworx.com> + + PR cobol/120402 + * Make-lang.in: Elminate commented-out scripting. + * cbldiag.h (_CBLDIAG_H): Change #if 0 to #if GCOBOL_GETENV + (warn_msg): Add printf attributes. + (location_dump): Add debugging message. + * cdf.y: Improved linemap tracking. + * genapi.cc (treeplet_fill_source): const attribute for formal parameter. + (insert_nop): Created to consolidate var_decl_nop writes. + (build_main_that_calls_something): Move generation to the end of executable. + (level_88_helper): Formatting. + (parser_call_targets_dump): Formatting. + (function_pointer_from_name): const attribute for formal parameter. + (parser_initialize_programs): const attribute for formal parameter. + (parser_statement_begin): Improved linemap handling. + (section_label): Improved linemap handling. + (paragraph_label): Improved linemap handling. + (pseudo_return_pop): Improved linemap handling. + (leave_procedure): Formatting. + (parser_enter_section): Improved linemap handling. + (parser_enter_paragraph): Improved linemap handling. + (parser_perform): Formatting. + (parser_leave_file): Move creation of main() to this routine. + (parser_enter_program): Move creation of main from here to leave_file. + (parser_accept): Formatting. const attribute for formal parameter. + (parser_accept_command_line): const attribute for formal parameter. + (parser_accept_command_line_count): const attribute for formal parameter. + (parser_accept_envar): Likewise. + (parser_set_envar): Likewise. + (parser_display): Likewise. + (get_exhibit_name): Implement EXHIBIT verb. + (parser_exhibit): Likewise. + (parser_sleep): const attribute for formal parameter. + (parser_division): Improved linemap handling. + (parser_classify): const attribute for formal parameter. + (create_iline_address_pairs): Improved linemap handling. + (parser_perform_start): Likewise. + (perform_inline_until): Likewise. + (perform_inline_testbefore_varying): Likewise. + (parser_perform_until): Likewise. + (parser_perform_inline_times): Likewise. + (parser_intrinsic_subst): const attribute for formal parameter. + (parser_file_merge): Formatting. + (create_and_call): Improved linemap handling. + (mh_identical): const attribute for formal parameter. + (mh_numeric_display): const attribute for formal parameter. + (mh_little_endian): Likewise. + (mh_source_is_group): Likewise. + (psa_FldLiteralA): Formatting. + * genapi.h (parser_accept): const attribute for formal parameter. + (parser_accept_envar): Likewise. + (parser_set_envar): Likewise. + (parser_accept_command_line): Likewise. + (parser_accept_command_line_count): Likewise. + (parser_add): Likewise. + (parser_classify): Likewise. + (parser_sleep): Likewise. + (parser_exhibit): Likewise. + (parser_display): Likewise. + (parser_initialize_programs): Likewise. + (parser_intrinsic_subst): Likewise. + * gengen.cc (gg_assign): Improved linemap handling. + (gg_add_field_to_structure): Likewise. + (gg_define_from_declaration): Likewise. + (gg_build_relational_expression): Likewise. + (gg_goto_label_decl): Likewise. + (gg_goto): Likewise. + (gg_printf): Likewise. + (gg_fprintf): Likewise. + (gg_memset): Likewise. + (gg_memchr): Likewise. + (gg_memcpy): Likewise. + (gg_memmove): Likewise. + (gg_strcpy): Likewise. + (gg_strcmp): Likewise. + (gg_strncmp): Likewise. + (gg_return): Likewise. + (chain_parameter_to_function): Likewise. + (gg_define_function): Likewise. + (gg_get_function_decl): Likewise. + (gg_call_expr): Likewise. + (gg_call): Likewise. + (gg_call_expr_list): Likewise. + (gg_exit): Likewise. + (gg_abort): Likewise. + (gg_strlen): Likewise. + (gg_strdup): Likewise. + (gg_malloc): Likewise. + (gg_realloc): Likewise. + (gg_free): Likewise. + (gg_set_current_line_number): Likewise. + (gg_get_current_line_number): Likewise. + (gg_insert_into_assembler): Likewise. + (token_location_override): Likewise. + (gg_token_location): Likewise. + * gengen.h (location_from_lineno): Likewise. + (gg_set_current_line_number): Likewise. + (gg_get_current_line_number): Likewise. + (gg_token_location): Likewise. + (current_token_location): Likewise. + (current_location_minus_one): Likewise. + (current_location_minus_one_clear): Likewise. + (token_location_override): Likewise. + * genmath.cc (fast_divide): const attribute for formal parameter. + * genutil.cc (get_and_check_refstart_and_reflen): Likewise. + (get_data_offset): Likewise. + (refer_refmod_length): Likewise. + (refer_offset): Likewise. + (refer_size): Likewise. + (refer_size_dest): Likewise. + (refer_size_source): Likewise. + (qualified_data_location): Likewise. + * genutil.h (refer_offset): Likewise. + (refer_size_source): Likewise. + (refer_size_dest): Likewise. + (qualified_data_location): Likewise. + * parse.y: EVALUATE token; Implement EXHIBIT verb; + Improved linemap handling. + * parse_ante.h (input_file_status_notify): Improved linemap handling. + (location_set): Likewise. + * scan.l: PICTURE string validation. + * scan_ante.h (class picture_t): PICTURE string validation. + (validate_picture): Likewise. + * symbols.cc (symbol_currency): Revised default currency handling. + * symbols.h (symbol_currency): Likewise. + * util.cc (location_from_lineno): Improved linemap handling. + (current_token_location): Improved linemap handling. + (current_location_minus_one): Improved linemap handling. + (current_location_minus_one_clear): Improved linemap handling. + (gcc_location_set_impl): Improved linemap handling. + (warn_msg): Improved linemap handling. + * util.h (cobol_lineno): Improved linemap handling. + +2025-07-15 Jakub Jelinek <jakub@redhat.com> + Jason Merrill <jason@redhat.com> + + PR c/44677 + * gcobolspec.cc (lang_specific_driver): Remove unused but set variable + n_cobol_files. + +2025-07-14 Robert Dubner <rdubner@symas.com> + + * cobol1.cc (cobol_langhook_handle_option): Eliminate cppcheck warnings. + * dts.h: Likewise. + * except.cc (cbl_enabled_exceptions_t::dump): Likewise. + * gcobolspec.cc (lang_specific_driver): Likewise. + * genapi.cc (parser_file_merge): Likewise. + * gengen.cc (gg_unique_in_function): Likewise. + (gg_declare_variable): Likewise. + (gg_peek_fn_decl): Likewise. + (gg_define_function): Likewise. + * genmath.cc (set_up_on_exception_label): Likewise. + (set_up_compute_error_label): Likewise. + (arithmetic_operation): Likewise. + (fast_divide): Likewise. + * genutil.cc (get_and_check_refstart_and_reflen): Likewise. + (get_depending_on_value_from_odo): Likewise. + (get_data_offset): Likewise. + (get_binary_value): Likewise. + (process_this_exception): Likewise. + (copy_little_endian_into_place): Likewise. + (refer_is_clean): Likewise. + (refer_fill_depends): Likewise. + * genutil.h (process_this_exception): Likewise. + (copy_little_endian_into_place): Likewise. + (refer_is_clean): Likewise. + * lexio.cc (check_push_pop_directive): Likewise. + (check_source_format_directive): Likewise. + (location_in): Likewise. + (lexer_input): Likewise. + (cdftext::lex_open): Likewise. + (lexio_dialect_mf): Likewise. + (valid_sequence_area): Likewise. + (cdftext::free_form_reference_format): Likewise. + (cdftext::segment_line): Likewise. + * lexio.h (struct span_t): Likewise. + * scan_ante.h (trim_location): Likewise. + * symbols.cc (symbol_elem_cmp): Likewise. + (symbol_alphabet): Likewise. + (end_of_group): Likewise. + (cbl_field_t::attr_str): Likewise. + (symbols_update): Likewise. + (symbol_typedef_add): Likewise. + (symbol_field_add): Likewise. + (new_temporary_impl): Likewise. + (symbol_label_section_exists): Likewise. + (symbol_program_callables): Likewise. + (file_status_status_of): Likewise. + * symfind.cc (is_data_field): Likewise. + (finalize_symbol_map2): Likewise. + (class in_scope): Likewise. + (symbol_match2): Likewise. + * util.cc (get_current_dir_name): Likewise. + (gb4): Likewise. + (class cdf_directives_t): Likewise. + (cbl_field_t::report_invalid_initial_value): Likewise. + (literal_subscript_oob): Likewise. + (cbl_refer_t::str): Likewise. + (date_time_fmt): Likewise. + (class unique_stack): Likewise. + (cobol_set_pp_option): Likewise. + (cobol_filename): Likewise. + (cobol_filename_restore): Likewise. + (gcc_location_set_impl): Likewise. + (ydferror): Likewise. + (error_msg_direct): Likewise. + (yyerror): Likewise. + (cbl_unimplemented_at): Likewise. + +2025-07-13 Robert Dubner <rdubner@symas.com> + + * Make-lang.in: Eliminate the .cc.o override. + * genapi.cc (level_88_helper): Eliminate cppcheck warning. + (get_level_88_domain): Likewise. + (get_class_condition_string): Likewise. + (parser_call_targets_dump): Likewise. + (parser_compile_ecs): Likewise. + (initialize_variable_internal): Likewise. + (move_tree): Likewise. + (combined_name): Likewise. + (assembler_label): Likewise. + (find_procedure): Likewise. + (parser_perform): Likewise. + (parser_perform_times): Likewise. + (internal_perform_through): Likewise. + (internal_perform_through_times): Likewise. + (psa_FldLiteralN): Likewise. + (psa_FldBlob): Likewise. + (parser_accept): Likewise. + (parser_accept_exception): Likewise. + (parser_accept_exception_end): Likewise. + (parser_accept_command_line): Likewise. + (parser_accept_envar): Likewise. + (parser_display_internal): Likewise. + (parser_display): Likewise. + (parser_assign): Likewise. + (parser_initialize_table): Likewise. + (parser_arith_error): Likewise. + (parser_arith_error_end): Likewise. + (parser_division): Likewise. + (label_fetch): Likewise. + (parser_label_label): Likewise. + (parser_label_goto): Likewise. + (parser_perform_start): Likewise. + (parser_perform_conditional): Likewise. + (parser_perform_conditional_end): Likewise. + (parser_perform_until): Likewise. + (parser_file_delete): Likewise. + (parser_intrinsic_subst): Likewise. + (create_lsearch_address_pairs): Likewise. + (parser_bsearch_start): Likewise. + (is_ascending_key): Likewise. + (parser_sort): Likewise. + (parser_file_sort): Likewise. + (parser_return_start): Likewise. + (parser_file_merge): Likewise. + (parser_string_overflow): Likewise. + (parser_unstring): Likewise. + (parser_string): Likewise. + (parser_call_exception): Likewise. + (create_and_call): Likewise. + (mh_identical): Likewise. + (move_helper): Likewise. + (binary_initial_from_float128): Likewise. + (initial_from_initial): Likewise. + (psa_FldLiteralA): Likewise. + (parser_local_add): Likewise. + (parser_symbol_add): Likewise. + * genapi.h (parser_display): Likewise. + * gengen.cc (gg_call_expr): Explict check for NULL_TREE. + (gg_call): Likewise. + * show_parse.h (SHOW_PARSE_LABEL_OK): Likewise. + (TRACE1_FIELD_VALUE): Likewise. + (CHECK_FIELD): Likewise. + (CHECK_FIELD2): Likewise. + (CHECK_LABEL): Likewise. + * util.cc (cbl_internal_error): Apply [[noreturn]] attribute. + * util.h (cbl_internal_error): Likewise. + +2025-07-11 Rainer Orth <ro@CeBiTec.Uni-Bielefeld.DE> + + PR cobol/120621 + * lexio.cc (parse_replace_pairs): Cast mfile.lineno() to fmt_size_t. + * parse.y (intrinsic): Print ptrdiff_t using %ld, cast arg to long. + * scan_ante.h (numstr_of): Print nx using %ld, cast arg to long. + * util.cc (cbl_field_t::report_invalid_initial_value): Print + ptrdiff_t using %ld, cast arg to long. + +2025-07-10 James K. Lowden <jklowden@cobolworx.com> + + PR cobol/120765 + * cdf.y: Extend grammar for new CDF syntax, relocate dictionary. + * cdfval.h (cdf_dictionary): Use new CDF dictionary. + * dts.h: Remove useless assignment, note incorrect behavior. + * except.cc: Remove obsolete EC state. + * gcobol.1: Document CDF in its own section. + * genapi.cc (parser_statement_begin): Use new EC state function. + (parser_file_merge): Same. + (parser_check_fatal_exception): Same. + * genutil.cc (get_and_check_refstart_and_reflen): Same. + (get_depending_on_value_from_odo): Same. + (get_data_offset): Same. + (process_this_exception): Same. + * lexio.cc (check_push_pop_directive): New function. + (check_source_format_directive): Restrict regex search to 1 line. + (cdftext::free_form_reference_format): Use new function. + * parse.y: Define new CDF tokens, use new CDF state. + * parse_ante.h (cdf_tokens): Use new CDF state. + (redefined_token): Same. + (class prog_descr_t): Remove obsolete CDF state. + (class program_stack_t): Same. + (current_call_convention): Same. + * scan.l: Recognize new CDF tokens. + * scan_post.h (is_cdf_token): Same. + * symbols.h (cdf_current_tokens): Change current_call_convention to return void. + * token_names.h: Regenerate. + * udf/stored-char-length.cbl: Use new PUSH/POP CDF functionality. + * util.cc (class cdf_directives_t): Define cdf_directives_t. + (current_call_convention): Same. + (cdf_current_tokens): Same. + (cdf_dictionary): Same. + (cdf_enabled_exceptions): Same. + (cdf_push): Same. + (cdf_push_call_convention): Same. + (cdf_push_current_tokens): Same. + (cdf_push_dictionary): Same. + (cdf_push_enabled_exceptions): Same. + (cdf_push_source_format): Same. + (cdf_pop): Same. + (cdf_pop_call_convention): Same. + (cdf_pop_current_tokens): Same. + (cdf_pop_dictionary): Same. + (cdf_pop_enabled_exceptions): Same. + (cdf_pop_source_format): Same. + * util.h (cdf_push): Declare cdf_directives_t. + (cdf_push_call_convention): Same. + (cdf_push_current_tokens): Same. + (cdf_push_dictionary): Same. + (cdf_push_enabled_exceptions): Same. + (cdf_push_source_format): Same. + (cdf_pop): Same. + (cdf_pop_call_convention): Same. + (cdf_pop_current_tokens): Same. + (cdf_pop_dictionary): Same. + (cdf_pop_source_format): Same. + (cdf_pop_enabled_exceptions): Same. + 2025-07-09 Robert Dubner <rdubner@symas.com> James K. Lowden <jklowden@cobolworx.com> diff --git a/gcc/cobol/Make-lang.in b/gcc/cobol/Make-lang.in index ee494b8..0e2a773 100644 --- a/gcc/cobol/Make-lang.in +++ b/gcc/cobol/Make-lang.in @@ -385,22 +385,3 @@ selftest-cobol: lang_checks += check-cobol -# -# Front-end specific flags: Originally done for the COBOL front end, this -# scripting applies CXXFLAGS_FOR_COBOL only to compilations of source code in the -# gcc/cobol source code tree. Both forms can be used: -# -# CXXFLAGS_FOR_COBOL=xxx ../configure --enable-languages=.... -# and -# make <gcc> CXXFLAGS_FOR_COBOL=yyy -# -# The second form overrides the first. -# -# To apply this feature to other front ends, look for and clone lines -# containing "CXXFLAGS_FOR_COBOL" in configure.ac, Makefile.tbl, and Makefile.def. -# - -cobol/%.o: cobol/%.cc - @echo $(COMPILE) $(CXXFLAGS_FOR_COBOL) $< - $(COMPILE) $(CXXFLAGS_FOR_COBOL) $< - $(POSTCOMPILE) diff --git a/gcc/cobol/cbldiag.h b/gcc/cobol/cbldiag.h index 49dc44b..dd16190 100644 --- a/gcc/cobol/cbldiag.h +++ b/gcc/cobol/cbldiag.h @@ -33,7 +33,7 @@ #else #define _CBLDIAG_H -#if 0 +#if GCOBOL_GETENV #define gcobol_getenv(x) getenv(x) #else #define gcobol_getenv(x) ((char *)nullptr) @@ -78,10 +78,15 @@ struct YDFLTYPE #endif +// Diagnostic format specifiers are documented in gcc/pretty-print.cc // an error at a location, called from the parser for semantic errors void error_msg( const YYLTYPE& loc, const char gmsgid[], ... ) ATTRIBUTE_GCOBOL_DIAG(2, 3); +bool +warn_msg( const YYLTYPE& loc, const char gmsgid[], ... ) + ATTRIBUTE_GCOBOL_DIAG(2, 3); + // an error that uses token_location, not yylloc void error_msg_direct( const char gmsgid[], ... ) ATTRIBUTE_GCOBOL_DIAG(1, 2); @@ -116,11 +121,14 @@ template <typename LOC> static void location_dump( const char func[], int line, const char tag[], const LOC& loc) { extern int yy_flex_debug; // cppcheck-suppress shadowVariable - if( yy_flex_debug && gcobol_getenv("update_location") ) { - fprintf(stderr, "%s:%d: %s location (%d,%d) to (%d,%d)\n", - func, line, tag, - loc.first_line, loc.first_column, loc.last_line, loc.last_column); - gcc_location_dump(); + if( yy_flex_debug ) { + const char *detail = gcobol_getenv("update_location"); // cppcheck-suppress knownConditionTrueFalse + if( detail ) { + fprintf(stderr, "%s:%d: %s location (%d,%d) to (%d,%d)\n", + func, line, tag, + loc.first_line, loc.first_column, loc.last_line, loc.last_column); + if( *detail == '2' ) gcc_location_dump(); + } } } #endif // defined(yy_flex_debug) diff --git a/gcc/cobol/cdf.y b/gcc/cobol/cdf.y index 840eb50..53fea5d 100644 --- a/gcc/cobol/cdf.y +++ b/gcc/cobol/cdf.y @@ -95,7 +95,7 @@ void input_file_status_notify(); } \ location_dump("cdf.c", __LINE__, "current", (Current)); \ input_file_status_notify(); \ - gcc_location_set( location_set(Current) ); \ + location_set(Current); \ } while (0) %} diff --git a/gcc/cobol/cobol1.cc b/gcc/cobol/cobol1.cc index 4bd79f1..3146da5 100644 --- a/gcc/cobol/cobol1.cc +++ b/gcc/cobol/cobol1.cc @@ -357,7 +357,7 @@ cobol_langhook_handle_option (size_t scode, return true; case OPT_M: - cobol_set_pp_option('M'); + cobol_set_pp_option('M'); return true; case OPT_fstatic_call: @@ -368,16 +368,18 @@ cobol_langhook_handle_option (size_t scode, wsclear(cobol_default_byte); return true; - case OPT_fflex_debug: + case OPT_fflex_debug: // cppcheck-suppress syntaxError // The need for this is a mystery yy_flex_debug = 1; cobol_set_debugging( true, yy_debug == 1, cobol_trace_debug == 1 ); return true; + case OPT_fyacc_debug: yy_debug = 1; cobol_set_debugging(yy_flex_debug == 1, true, cobol_trace_debug == 1 ); return true; + case OPT_ftrace_debug: cobol_set_debugging( yy_flex_debug == 1, yy_debug == 1, true ); return true; @@ -406,11 +408,13 @@ cobol_langhook_handle_option (size_t scode, case OPT_fsyntax_only: mode_syntax_only(identification_div_e); break; + case OPT_preprocess: if( ! preprocess_filter_add(arg) ) { cbl_errx( "could not execute preprocessor %s", arg); } return true; + case OPT_include: if( ! include_file_add(arg) ) { cbl_errx( "could not include %s", arg); diff --git a/gcc/cobol/dts.h b/gcc/cobol/dts.h index e12b979..c900c45 100644 --- a/gcc/cobol/dts.h +++ b/gcc/cobol/dts.h @@ -110,6 +110,6 @@ namespace dts { } ); return true; } -}; +} diff --git a/gcc/cobol/except.cc b/gcc/cobol/except.cc index e42aea2..df1c7df 100644 --- a/gcc/cobol/except.cc +++ b/gcc/cobol/except.cc @@ -96,7 +96,7 @@ cbl_enabled_exceptions_t::dump() const { return; } int i = 1; - for( auto& elem : *this ) { + for( auto& elem : *this ) { // cppcheck-suppress constVariableReference dbgmsg("cbl_enabled_exceptions_t: %2d {%s, %s, %lu}", i++, elem.location? "with location" : " no location", diff --git a/gcc/cobol/gcobolspec.cc b/gcc/cobol/gcobolspec.cc index 70784d7..1f1b463 100644 --- a/gcc/cobol/gcobolspec.cc +++ b/gcc/cobol/gcobolspec.cc @@ -142,9 +142,6 @@ lang_specific_driver (struct cl_decoded_option **in_decoded_options, int n_infiles = 0; int n_outfiles = 0; - // The number of input files when the language is "none" or "cobol" - int n_cobol_files = 0; - // saw_OPT_no_main means "don't expect -main" bool saw_OPT_no_main = false; @@ -234,11 +231,6 @@ lang_specific_driver (struct cl_decoded_option **in_decoded_options, case OPT_SPECIAL_input_file: no_files_error = false; n_infiles += 1; - if( strcmp(language, "none") == 0 - || strcmp(language, "cobol") == 0 ) - { - n_cobol_files += 1; - } if( strstr(decoded_options[i].orig_option_with_args_text, "libgcobol.a") ) { // We have been given an explicit libgcobol.a. We need to note that. @@ -478,7 +470,10 @@ lang_specific_driver (struct cl_decoded_option **in_decoded_options, //// break; ////#endif case OPT_static: +#if defined (HAVE_LD_STATIC_DYNAMIC) + append_arg(decoded_options[i]); static_in_general = true; +#endif break; default: @@ -506,17 +501,23 @@ lang_specific_driver (struct cl_decoded_option **in_decoded_options, need_libgcobol = false; } + if( static_in_general ) + { + // These two options interfere with each other. + static_libgcobol = false; + } + if( need_libgcobol ) { add_arg_lib(COBOL_LIBRARY, static_libgcobol); } if( need_libdl ) { - add_arg_lib(DL_LIBRARY, static_in_general); + add_arg_lib(DL_LIBRARY, false); } if( need_libstdc ) { - add_arg_lib(STDCPP_LIBRARY, static_in_general); + add_arg_lib(STDCPP_LIBRARY, false); } if( prior_main ) @@ -529,7 +530,8 @@ lang_specific_driver (struct cl_decoded_option **in_decoded_options, // cl_decoded_option size_t new_option_count = new_opt.size(); - struct cl_decoded_option *new_options = XNEWVEC (struct cl_decoded_option, new_option_count); + struct cl_decoded_option *new_options = XNEWVEC (struct cl_decoded_option, + new_option_count); for(size_t i=0; i<new_option_count; i++) { @@ -539,7 +541,7 @@ lang_specific_driver (struct cl_decoded_option **in_decoded_options, #ifdef NOISY verbose = true; #endif - if( verbose && new_options != original_options ) + if( verbose && new_options != original_options ) // cppcheck-suppress knownConditionTrueFalse { fprintf(stderr, _("Driving: (" HOST_SIZE_T_PRINT_DEC ")\n"), (fmt_size_t)new_option_count); diff --git a/gcc/cobol/genapi.cc b/gcc/cobol/genapi.cc index 3c4e9a9..c9d2da4 100644 --- a/gcc/cobol/genapi.cc +++ b/gcc/cobol/genapi.cc @@ -27,6 +27,7 @@ * (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE * OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. */ + #include "cobol-system.h" #include "coretypes.h" @@ -117,7 +118,7 @@ typedef struct TREEPLET static void -treeplet_fill_source(TREEPLET &treeplet, cbl_refer_t &refer) +treeplet_fill_source(TREEPLET &treeplet, const cbl_refer_t &refer) { treeplet.pfield = gg_get_address_of(refer.field->var_decl_node); treeplet.offset = refer_offset(refer); @@ -190,6 +191,9 @@ const char *gv_trace_switch = NULL; char const *bTRACE1 = NULL; tree trace_handle; tree trace_indent; + +// This variable is set to true when the output cursor is known to be at the +// start-of-line. bool cursor_at_sol = true; static void @@ -229,6 +233,13 @@ trace1_init() } } +static +void +insert_nop(int n) + { + gg_assign(var_decl_nop, build_int_cst_type(INT, n)); + } + static void create_cblc_string_variable(const char *var_name, const char *var_contents) { @@ -266,8 +277,6 @@ build_main_that_calls_something(const char *something) SHOW_PARSE_END } - gg_set_current_line_number(DEFAULT_LINE_NUMBER); - tree function_decl = gg_define_function( INT, "main", "main", @@ -321,7 +330,6 @@ build_main_that_calls_something(const char *something) argc, argv, NULL_TREE))); - strncpy(ach_cobol_entry_point, psz, sizeof(ach_cobol_entry_point)-1); free(psz); gg_finalize_function(); } @@ -361,8 +369,11 @@ level_88_helper(size_t parent_capacity, size_t &returned_size) { // We return a MALLOCed return value, which the caller must free. - char *retval = (char *)xmalloc(parent_capacity + 64); - char *builder = (char *)xmalloc(parent_capacity + 64); + char *retval = static_cast<char *>(xmalloc(parent_capacity + 64)); + gcc_assert(retval); + char *builder = static_cast<char *>(xmalloc(parent_capacity + 64)); + gcc_assert(builder); + size_t nbuild = 0; cbl_figconst_t figconst = cbl_figconst_of( elem.name()); @@ -403,7 +414,8 @@ level_88_helper(size_t parent_capacity, // Pick up the string size_t first_name_length = elem.size(); - char *first_name = (char *)xmalloc(first_name_length + 1); + char *first_name = static_cast<char *>(xmalloc(first_name_length + 1)); + gcc_assert(first_name); memcpy(first_name, elem.name(), first_name_length); first_name[first_name_length] = '\0'; @@ -480,7 +492,7 @@ get_level_88_domain(size_t parent_capacity, cbl_field_t *var, size_t &returned_s // Numerics are converted to strings, and handled as above size_t retval_capacity = 64; - char *retval = (char *)xmalloc(retval_capacity); + char *retval = static_cast<char *>(xmalloc(retval_capacity)); size_t output_index = 0; // Loop through the provided domains: @@ -497,8 +509,9 @@ get_level_88_domain(size_t parent_capacity, cbl_field_t *var, size_t &returned_s if( output_index + stream_len > retval_capacity ) { retval_capacity *= 2; - retval = (char *)xrealloc(retval, retval_capacity); + retval = static_cast<char *>(xrealloc(retval, retval_capacity)); } + gcc_assert(retval); memcpy(retval + output_index, stream, stream_len); output_index += stream_len; returned_size += stream_len; @@ -509,14 +522,23 @@ get_level_88_domain(size_t parent_capacity, cbl_field_t *var, size_t &returned_s if( output_index + stream_len > retval_capacity ) { retval_capacity *= 2; - retval = (char *)xrealloc(retval, retval_capacity); + retval = static_cast<char *>(xrealloc(retval, retval_capacity)); } + gcc_assert(retval); memcpy(retval + output_index, stream, stream_len); output_index += stream_len; returned_size += stream_len; free(stream); domain += 1; } + + if( returned_size >= retval_capacity) + { + retval_capacity *= 2; + retval = static_cast<char *>(xrealloc(retval, retval_capacity)); + } + + gcc_assert(returned_size < retval_capacity); retval[returned_size++] = '\0'; return retval; } @@ -608,13 +630,8 @@ get_class_condition_string(cbl_field_t *var) // Since the first.name is a single character, we can do this as // a single-character pair. - // Keep in mind that the single character might be a two-byte UTF-8 - // codepoint - uint8_t ch1 = domain->first.name()[0]; - uint8_t ch2 = domain->last.name()[0]; - - gcc_assert(first_name_length <= 2); - gcc_assert(last_name_length <= 2); + uint8_t ch1; + uint8_t ch2; char *p2; size_t one; @@ -768,7 +785,8 @@ parser_call_targets_dump() { dbgmsg( "call targets for #" HOST_SIZE_T_PRINT_UNSIGNED " NOT dumping", (fmt_size_t)current_program_index() ); - return; // not currently working +#if 0 // A change to call_targets rendered this routine useless. Until we get + // around to repairing it, this code is left for reference. for( const auto& elem : call_targets ) { const auto& k = elem.first; const auto& v = elem.second; @@ -782,6 +800,7 @@ parser_call_targets_dump() } fprintf(stderr, " ]\n"); } +#endif } size_t @@ -809,8 +828,8 @@ parser_call_target_update( size_t caller, } static tree -function_pointer_from_name(cbl_refer_t &name, - tree function_return_type) +function_pointer_from_name(const cbl_refer_t &name, + tree function_return_type) { Analyze(); @@ -886,7 +905,8 @@ function_pointer_from_name(cbl_refer_t &name, } void -parser_initialize_programs(size_t nprogs, struct cbl_refer_t *progs) +parser_initialize_programs( size_t nprogs, + const struct cbl_refer_t *progs) { Analyze(); SHOW_PARSE @@ -986,14 +1006,13 @@ parser_compile_ecs( const std::vector<uint64_t>& ecs ) return NULL_TREE; } - char ach[32]; + char ach[64]; static int counter = 1; sprintf(ach, "_ecs_table_%d", counter++); tree retval = array_of_long_long(ach, ecs); SHOW_IF_PARSE(nullptr) { SHOW_PARSE_HEADER - char ach[64]; snprintf(ach, sizeof(ach), " Size is %lu; retval is %p", gb4(ecs.size()), as_voidp(retval)); SHOW_PARSE_TEXT(ach) @@ -1002,7 +1021,6 @@ parser_compile_ecs( const std::vector<uint64_t>& ecs ) TRACE1 { TRACE1_HEADER - char ach[64]; snprintf(ach, sizeof(ach), " Size is %lu; retval is %p", gb4(ecs.size()), as_voidp(retval)); TRACE1_TEXT_ABC("", ach, ""); @@ -1173,14 +1191,6 @@ parser_statement_begin( const cbl_name_t statement_name, exception_processing = file_ops.find(statement_name) != file_ops.end(); } - if( gg_get_current_line_number() == DEFAULT_LINE_NUMBER ) - { - // This code is intended to prevert GDB anomalies when the first line of a - // program is a PERFORM <proc> ... TEST AFTER ... UNTIL ... - gg_set_current_line_number(CURRENT_LINE_NUMBER-1); - gg_assign(var_decl_nop, build_int_cst_type(INT, 106)); - } - // At this point, if any exception is enabled, we store the location stuff. // Each file I-O routine calls store_location_stuff explicitly, because // those exceptions can't be defeated. @@ -1188,14 +1198,9 @@ parser_statement_begin( const cbl_name_t statement_name, if( exception_processing ) { store_location_stuff(statement_name); - } - - gg_set_current_line_number(CURRENT_LINE_NUMBER); - - if( exception_processing ) - { set_exception_environment(ecs, dcls); } + sv_is_i_o = false; } @@ -1209,10 +1214,9 @@ initialize_variable_internal( cbl_refer_t refer, // gg_string_literal(refer.field->name), // NULL_TREE); cbl_field_t *parsed_var = refer.field; - - if( parsed_var->type == FldLiteralA ) + if( !parsed_var ) { - return; + cbl_internal_error("%s should not be null", "parsed_var"); } if( parsed_var->is_key_name() ) @@ -1228,7 +1232,7 @@ initialize_variable_internal( cbl_refer_t refer, return; } - if( parsed_var && parsed_var->type == FldBlob ) + if( parsed_var->type == FldBlob ) { return; } @@ -1346,8 +1350,6 @@ initialize_variable_internal( cbl_refer_t refer, SHOW_PARSE_END } - CHECK_FIELD(parsed_var); - // When initializing a variable, we have to ignore any DEPENDING ON clause // that might otherwise apply suppress_dest_depends = true; @@ -2374,6 +2376,8 @@ move_tree( cbl_field_t *dest, SHOW_PARSE_END } + CHECK_FIELD(dest); + bool moved = true; tree source_length = gg_define_size_t(); @@ -2457,7 +2461,7 @@ move_tree( cbl_field_t *dest, psz_source, min_length, member(dest->var_decl_node, "picture"), - NULL); + NULL_TREE); break; } @@ -2585,7 +2589,7 @@ combined_name(const cbl_label_t *label) } static size_t retval_size = 256; - static char *retval= (char *)xmalloc(retval_size); + static char *retval= static_cast<char *>(xmalloc(retval_size)); char *paragraph = cobol_name_mangler(para_name); char *section = cobol_name_mangler(sect_name); @@ -2597,8 +2601,9 @@ combined_name(const cbl_label_t *label) + 24 ) { retval_size *= 2; - retval = (char *)xrealloc(retval, retval_size); + retval = static_cast<char *>(xrealloc(retval, retval_size)); } + gcc_assert(retval); *retval = '\0'; char ach[24]; @@ -2645,8 +2650,9 @@ assembler_label(const char *label) { length = strlen(label) + strlen(local_text) + 1; free(build); - build = (char *)xmalloc(length); + build = static_cast<char *>(xmalloc(length)); } + gcc_assert(build); strcpy(build, label); strcat(build, local_text); @@ -2660,8 +2666,6 @@ section_label(struct cbl_proc_t *procedure) // With nested programs, you can have multiple program/section pairs with the // the same names; we use a deconflictor to avoid collisions - gg_set_current_line_number(CURRENT_LINE_NUMBER); - size_t deconflictor = symbol_label_id(procedure->label); cbl_label_t *label = procedure->label; @@ -2686,7 +2690,7 @@ section_label(struct cbl_proc_t *procedure) } assembler_label(psz2); free(psz2); - gg_assign(var_decl_nop, build_int_cst_type(INT, 108)); + insert_nop(108); } static void @@ -2701,8 +2705,6 @@ paragraph_label(struct cbl_proc_t *procedure) // are not referenced by the program. We provide a deconflictor to // separate such labels. - gg_set_current_line_number(CURRENT_LINE_NUMBER); - cbl_label_t *paragraph = procedure->label; cbl_label_t *section = nullptr; @@ -2724,6 +2726,9 @@ paragraph_label(struct cbl_proc_t *procedure) section_name ? section_name: "(null)" , current_function->our_unmangled_name ? current_function->our_unmangled_name: "" , (fmt_size_t)deconflictor ); + + // (0) is wrong, so back up one + gg_insert_into_assembler(psz1); SHOW_PARSE @@ -2740,7 +2745,25 @@ paragraph_label(struct cbl_proc_t *procedure) combined_name(procedure->label)); assembler_label(psz2); free(psz2); - gg_assign(var_decl_nop, build_int_cst_type(INT, 109)); + + // We are inserting a NOP after having created a label for the procedure. + // This means that when using GDC_COBOL to step into a procedure, the + // execution will stop there and show "123 para-name." at the stopped point. + // + // Note that because there is no user-specified executable code at that point + // the user can't set a working breakpoint with "break 123". But because + // GDB will pick up the psz2 text and set a breakpoint there (which is the + // location of the NOP) "break para-name" will actually stop and show line + // 123. + // + // This really only makes sense when you look at the assembly language. Keep + // in mind as you read it that issuing a "break 123" causes GDB to set a + // breakpoint at the first executable machine language code following the + // first ".loc 123" directive. + // + // Yes, trying to understand this causes headaches for many people who read + // this. Take an aspirin. + insert_nop(109); } static void @@ -2784,6 +2807,7 @@ pseudo_return_pop(cbl_proc_t *procedure) NULL_TREE); } + token_location_override(current_location_minus_one()); IF( var_decl_exit_address, eq_op, procedure->exit.addr ) { TRACE1 @@ -2793,11 +2817,13 @@ pseudo_return_pop(cbl_proc_t *procedure) // The top of the stack is us! // Pick up the return address from the pseudo_return stack: + token_location_override(current_location_minus_one()); gg_assign(current_function->void_star_temp, gg_call_expr( VOID_P, "__gg__pseudo_return_pop", NULL_TREE)); // And do the return: + token_location_override(current_location_minus_one()); gg_goto(current_function->void_star_temp); } ELSE @@ -2831,11 +2857,13 @@ leave_procedure(struct cbl_proc_t *procedure, bool /*section*/) // procedure->bottom.label); // Procedure can be null, for example at the beginning of a // new program, or after somebody else has cleared it out. + gg_append_statement(procedure->exit.label); char *psz; psz = xasprintf("_procret." HOST_SIZE_T_PRINT_DEC ":", (fmt_size_t)symbol_label_id(procedure->label)); + token_location_override(current_location_minus_one()); gg_insert_into_assembler(psz); free(psz); pseudo_return_pop(procedure); @@ -2948,7 +2976,9 @@ find_procedure(cbl_label_t *label) static int counter=1; // This is a new section or paragraph; we need to create its values: - retval = (struct cbl_proc_t *)xmalloc(sizeof(struct cbl_proc_t)); + retval = static_cast<struct cbl_proc_t *> + (xmalloc(sizeof(struct cbl_proc_t))); + gcc_assert(retval); retval->label = label; gg_create_goto_pair(&retval->top.go_to, @@ -3004,6 +3034,8 @@ parser_enter_section(cbl_label_t *label) { SHOW_PARSE_HEADER SHOW_PARSE_LABEL(" ", label) + SHOW_PARSE_INDENT + linemap_dump_location( line_table, current_token_location(), stderr ); SHOW_PARSE_END } @@ -3011,8 +3043,7 @@ parser_enter_section(cbl_label_t *label) // This NOP is needed to give GDB a line number for the entry point of // paragraphs - gg_set_current_line_number(CURRENT_LINE_NUMBER); - gg_assign(var_decl_nop, build_int_cst_type(INT, 101)); + insert_nop(101); struct cbl_proc_t *procedure = find_procedure(label); gg_append_statement(procedure->top.label); @@ -3039,6 +3070,8 @@ parser_enter_paragraph(cbl_label_t *label) { SHOW_PARSE_HEADER SHOW_PARSE_LABEL(" ", label) + SHOW_PARSE_INDENT + linemap_dump_location( line_table, current_token_location(), stderr ); SHOW_PARSE_END } @@ -3254,16 +3287,20 @@ parser_goto( cbl_refer_t value_ref, size_t narg, cbl_label_t * const labels[] ) void parser_perform(cbl_label_t *label, bool suppress_nexting) { - label->used = yylineno; Analyze(); SHOW_PARSE { SHOW_PARSE_HEADER SHOW_PARSE_LABEL(" ", label) char ach[32]; - sprintf(ach, " label is at %p", (void*)label); + sprintf(ach, " label is at %p", static_cast<void*>(label)); SHOW_PARSE_TEXT(ach) - sprintf(ach, " label->proc is %p", (void*)label->structs.proc); + if( label ) + { + sprintf(ach, + " label->proc is %p", + static_cast<void*>(label->structs.proc)); + } SHOW_PARSE_TEXT(ach) SHOW_PARSE_END } @@ -3276,6 +3313,7 @@ parser_perform(cbl_label_t *label, bool suppress_nexting) } CHECK_LABEL(label); + label->used = yylineno; struct cbl_proc_t *procedure = find_procedure(label); @@ -3312,9 +3350,9 @@ parser_perform(cbl_label_t *label, bool suppress_nexting) char ach[256]; if( label->type == LblParagraph ) { - const cbl_label_t *section_label = cbl_label_of(symbol_at(label->parent)); + const cbl_label_t *sec_label = cbl_label_of(symbol_at(label->parent)); para_name = label->name; - sect_name = section_label->name; + sect_name = sec_label->name; sprintf(ach, "%s PERFORM %s of %s of %s (" HOST_SIZE_T_PRINT_DEC ")", ASM_COMMENT_START, @@ -3374,9 +3412,9 @@ parser_perform_times( cbl_label_t *proc_1, cbl_refer_t count ) SHOW_PARSE_REF(" ", count) SHOW_PARSE_TEXT(" TIMES") char ach[32]; - sprintf(ach, " proc_1 is at %p", (void*)proc_1); + sprintf(ach, " proc_1 is at %p", static_cast<void*>(proc_1)); SHOW_PARSE_TEXT(ach) - sprintf(ach, " proc_1->proc is %p", (void*)proc_1->structs.proc); + sprintf(ach, " proc_1->proc is %p", static_cast<void*>(proc_1->structs.proc)); SHOW_PARSE_TEXT(ach) SHOW_PARSE_END } @@ -3413,6 +3451,7 @@ parser_perform_times( cbl_label_t *proc_1, cbl_refer_t count ) sprintf(ach, "_procretb." HOST_SIZE_T_PRINT_DEC ":", (fmt_size_t)our_pseudo_label); + token_location_override(current_location_minus_one()); gg_insert_into_assembler(ach); } @@ -3427,17 +3466,22 @@ internal_perform_through( cbl_label_t *proc_1, SHOW_PARSE_HEADER SHOW_PARSE_LABEL(" ", proc_1); char ach[32]; - sprintf(ach, " proc_1 is at %p", (void*)proc_1); + sprintf(ach, " proc_1 is at %p", static_cast<void*>(proc_1)); SHOW_PARSE_TEXT(ach) - sprintf(ach, " proc_1->proc is %p", (void*)proc_1->structs.proc); + if( proc_1 ) + { + sprintf(ach, + " proc_1->proc is %p", + static_cast<void*>(proc_1->structs.proc)); + } SHOW_PARSE_TEXT(ach) if( proc_2 ) { SHOW_PARSE_INDENT - SHOW_PARSE_LABEL("", proc_2); - sprintf(ach, " proc_2 is at %p", (void*)proc_2); + SHOW_PARSE_LABEL_OK("", proc_2); + sprintf(ach, " proc_2 is at %p", static_cast<void*>(proc_2)); SHOW_PARSE_TEXT(ach) - sprintf(ach, " proc_2->proc is %p", (void*)proc_2->structs.proc); + sprintf(ach, " proc_2->proc is %p", static_cast<void*>(proc_2->structs.proc)); SHOW_PARSE_TEXT(ach) } SHOW_PARSE_END @@ -3450,14 +3494,12 @@ internal_perform_through( cbl_label_t *proc_1, CHECK_LABEL(proc_1); - if(!proc_2) + if( !proc_2 ) { parser_perform(proc_1, suppress_nexting); return; } - CHECK_LABEL(proc_2); - struct cbl_proc_t *proc1 = find_procedure(proc_1); struct cbl_proc_t *proc2 = find_procedure(proc_2); @@ -3512,17 +3554,22 @@ internal_perform_through_times( cbl_label_t *proc_1, SHOW_PARSE_HEADER SHOW_PARSE_LABEL(" ", proc_1); char ach[32]; - sprintf(ach, " proc_1 is at %p", (void*)proc_1); + sprintf(ach, " proc_1 is at %p", static_cast<void*>(proc_1)); SHOW_PARSE_TEXT(ach) - sprintf(ach, " proc_1->proc is %p", (void*)proc_1->structs.proc); + if( proc_1 ) + { + sprintf(ach, + " proc_1->proc is %p", + static_cast<void*>(proc_1->structs.proc)); + } SHOW_PARSE_TEXT(ach) if( proc_2 ) { SHOW_PARSE_INDENT - SHOW_PARSE_LABEL("", proc_2); - sprintf(ach, " proc_2 is at %p", (void*)proc_2); + SHOW_PARSE_LABEL_OK("", proc_2); + sprintf(ach, " proc_2 is at %p", static_cast<void*>(proc_2)); SHOW_PARSE_TEXT(ach) - sprintf(ach, " proc_2->proc is %p", (void*)proc_2->structs.proc); + sprintf(ach, " proc_2->proc is %p", static_cast<void*>(proc_2->structs.proc)); SHOW_PARSE_TEXT(ach) } SHOW_PARSE_REF(" ", count); @@ -3558,6 +3605,7 @@ internal_perform_through_times( cbl_label_t *proc_1, sprintf(ach, "_procretb." HOST_SIZE_T_PRINT_DEC ":", (fmt_size_t)our_pseudo_label); + token_location_override(current_location_minus_one()); gg_insert_into_assembler( ach ); } @@ -3749,6 +3797,22 @@ parser_leave_file() { // We are leaving the top-level file, which means this compilation is // done, done, done. + + // There is, however, one thing left to do. If the command line says + // that this module needs a main entry point, then this is where + // we create a main() function. We build it at the end, so that all of + // the .loc directives associated with it appear at the end of the + // source code. We used to create the main() entry point at the beginning, + // but that created confusion for GDB when trying to debug the generated + // executable. + if( main_entry_point ) + { + next_program_is_main = false; + build_main_that_calls_something(main_entry_point); + free(main_entry_point); + main_entry_point = NULL; + } + gg_leaving_the_source_code_file(); } } @@ -3858,17 +3922,8 @@ parser_enter_program( const char *funcname_, // The first thing we have to do is mangle this name. This is safe even // though the end result will be mangled again, because the mangler doesn't // change a mangled name. - - char *mangled_name; - - if( current_call_convention() == cbl_call_cobol_e ) - { - mangled_name = cobol_name_mangler(funcname_); - } - else - { - mangled_name = xstrdup(funcname_); - } + + char *mangled_name = cobol_name_mangler(funcname_); size_t parent_index = current_program_index(); char *funcname; @@ -3896,28 +3951,25 @@ parser_enter_program( const char *funcname_, if( !is_function && !parent_index ) { - // This is a top_level program, and not a function + // This is a top_level program-id, and not a function if( next_program_is_main ) { + // This is the first top-level program-id. next_program_is_main = false; - if(main_entry_point) - { - build_main_that_calls_something(main_entry_point); - free(main_entry_point); - main_entry_point = NULL; - } - else + if( !main_entry_point ) { - build_main_that_calls_something(funcname); + // Because no explicit main_entry_point was specified, this program-id, + // the first in the file, becomes the target of the main() function + // that will be created at parser_leave_file time. + main_entry_point = xstrdup(funcname); + + char *psz = cobol_name_mangler(main_entry_point); + strncpy(ach_cobol_entry_point, psz, sizeof(ach_cobol_entry_point)-1); + free(psz); } } } - // Call this after build_main_that_calls_something, because it manipulates - // the current line number to DEFAULT_LINE_NUMBER. We have to manipulate it - // back afterward. - gg_set_current_line_number(CURRENT_LINE_NUMBER); - if( strcmp(funcname_, "main") == 0 && this_module_has_main ) { // setting 'retval' to 1 let's the caller know that we are being told @@ -4107,6 +4159,8 @@ psa_FldLiteralN(struct cbl_field_t *field ) // We are constructing a completely static constant structure, based on the // text string in .initial + CHECK_FIELD(field); + FIXED_WIDE_INT(128) value = 0; do @@ -4299,6 +4353,8 @@ psa_FldBlob(struct cbl_field_t *var ) SHOW_PARSE_END } + CHECK_FIELD(var); + // We are constructing a completely static constant structure. We know the // capacity. We'll create it from the data.initial. The var_decl_node will // be a pointer to the data @@ -4336,7 +4392,7 @@ psa_FldBlob(struct cbl_field_t *var ) } void -parser_accept(struct cbl_refer_t tgt, +parser_accept(const struct cbl_refer_t &tgt, special_name_t special_e, cbl_label_t *error, cbl_label_t *not_error ) @@ -4439,7 +4495,7 @@ parser_accept(struct cbl_refer_t tgt, case ARG_VALUE_e: // We are fetching the variable whose index was established by a prior - // DISPLAY UPON ARGUMENT-NUMBER. After the fetch, the value will be + // DISPLAY UPON ARGUMENT-NUMBER. After the fetch, the value will be // incremented by one. function_to_call = "__gg__accept_arg_value"; break; @@ -4463,7 +4519,7 @@ parser_accept(struct cbl_refer_t tgt, { SHOW_PARSE_INDENT SHOW_PARSE_TEXT("Laying down GOTO error->INTO for_argv") - SHOW_PARSE_LABEL(" ", error) + SHOW_PARSE_LABEL_OK(" ", error) } gg_append_statement( error->structs.arith_error->into.go_to ); } @@ -4481,7 +4537,7 @@ parser_accept(struct cbl_refer_t tgt, { SHOW_PARSE_INDENT SHOW_PARSE_TEXT("Laying down GOTO not_error->INTO for_argv") - SHOW_PARSE_LABEL(" ", not_error) + SHOW_PARSE_LABEL_OK(" ", not_error) } gg_append_statement( not_error->structs.arith_error->into.go_to ); } @@ -4496,7 +4552,7 @@ parser_accept(struct cbl_refer_t tgt, { SHOW_PARSE_INDENT SHOW_PARSE_TEXT("Laying down LABEL error->bottom") - SHOW_PARSE_LABEL(" ", error) + SHOW_PARSE_LABEL_OK(" ", error) } gg_append_statement( error->structs.arith_error->bottom.label ); } @@ -4506,7 +4562,7 @@ parser_accept(struct cbl_refer_t tgt, { SHOW_PARSE_INDENT SHOW_PARSE_TEXT("Laying down LABEL not_error->bottom") - SHOW_PARSE_LABEL(" ", not_error) + SHOW_PARSE_LABEL_OK(" ", not_error) SHOW_PARSE_END } gg_append_statement( not_error->structs.arith_error->bottom.label ); @@ -4523,7 +4579,6 @@ parser_accept_exception( cbl_label_t *accept_label ) // We are entering either SIZE ERROR or NOT SIZE ERROR code RETURN_IF_PARSE_ONLY; - set_up_on_exception_label(accept_label); SHOW_PARSE { @@ -4536,6 +4591,9 @@ parser_accept_exception( cbl_label_t *accept_label ) SHOW_PARSE_END } + CHECK_LABEL(accept_label); + set_up_on_exception_label(accept_label); + // Jump over the [NOT] ON EXCEPTION code that is about to be laid down gg_append_statement( accept_label->structs.arith_error->over.go_to ); // Create the label that allows the following code to be executed at @@ -4562,6 +4620,8 @@ parser_accept_exception_end( cbl_label_t *accept_label ) SHOW_PARSE_END } + CHECK_LABEL(accept_label); + // Jump to the end of the arithmetic code: gg_append_statement( accept_label->structs.arith_error->bottom.go_to ); // Lay down the label that allows the ERROR/NOT ERROR instructions @@ -4571,8 +4631,8 @@ parser_accept_exception_end( cbl_label_t *accept_label ) } void -parser_accept_command_line( cbl_refer_t tgt, - cbl_refer_t source, +parser_accept_command_line( const cbl_refer_t &tgt, + const cbl_refer_t &source, cbl_label_t *error, cbl_label_t *not_error ) { @@ -4612,7 +4672,7 @@ parser_accept_command_line( cbl_refer_t tgt, { SHOW_PARSE_INDENT SHOW_PARSE_TEXT("Laying down GOTO error->INTO for_command_line") - SHOW_PARSE_LABEL(" ", error) + SHOW_PARSE_LABEL_OK(" ", error) } gg_append_statement( error->structs.arith_error->into.go_to ); } @@ -4630,7 +4690,7 @@ parser_accept_command_line( cbl_refer_t tgt, { SHOW_PARSE_INDENT SHOW_PARSE_TEXT("Laying down GOTO not_error->INTO for command_line") - SHOW_PARSE_LABEL(" ", not_error) + SHOW_PARSE_LABEL_OK(" ", not_error) } gg_append_statement( not_error->structs.arith_error->into.go_to ); } @@ -4662,7 +4722,7 @@ parser_accept_command_line( cbl_refer_t tgt, { SHOW_PARSE_INDENT SHOW_PARSE_TEXT("Laying down GOTO error->INTO for_argv") - SHOW_PARSE_LABEL(" ", error) + SHOW_PARSE_LABEL_OK(" ", error) } gg_append_statement( error->structs.arith_error->into.go_to ); } @@ -4680,7 +4740,7 @@ parser_accept_command_line( cbl_refer_t tgt, { SHOW_PARSE_INDENT SHOW_PARSE_TEXT("Laying down GOTO not_error->INTO for_argv") - SHOW_PARSE_LABEL(" ", not_error) + SHOW_PARSE_LABEL_OK(" ", not_error) } gg_append_statement( not_error->structs.arith_error->into.go_to ); } @@ -4696,7 +4756,7 @@ parser_accept_command_line( cbl_refer_t tgt, { SHOW_PARSE_INDENT SHOW_PARSE_TEXT("Laying down LABEL error->bottom") - SHOW_PARSE_LABEL(" ", error) + SHOW_PARSE_LABEL_OK(" ", error) } gg_append_statement( error->structs.arith_error->bottom.label ); } @@ -4706,7 +4766,7 @@ parser_accept_command_line( cbl_refer_t tgt, { SHOW_PARSE_INDENT SHOW_PARSE_TEXT("Laying down LABEL not_error->bottom") - SHOW_PARSE_LABEL(" ", not_error) + SHOW_PARSE_LABEL_OK(" ", not_error) SHOW_PARSE_END } gg_append_statement( not_error->structs.arith_error->bottom.label ); @@ -4714,7 +4774,7 @@ parser_accept_command_line( cbl_refer_t tgt, } void -parser_accept_command_line_count( cbl_refer_t tgt ) +parser_accept_command_line_count( const cbl_refer_t &tgt ) { Analyze(); SHOW_PARSE @@ -4736,10 +4796,10 @@ parser_accept_command_line_count( cbl_refer_t tgt ) } void -parser_accept_envar(struct cbl_refer_t tgt, - struct cbl_refer_t envar, - cbl_label_t *error, - cbl_label_t *not_error ) +parser_accept_envar(const struct cbl_refer_t &tgt, + const struct cbl_refer_t &envar, + cbl_label_t *error, + cbl_label_t *not_error ) { Analyze(); @@ -4804,7 +4864,7 @@ parser_accept_envar(struct cbl_refer_t tgt, { SHOW_PARSE_INDENT SHOW_PARSE_TEXT("Laying down LABEL error->bottom") - SHOW_PARSE_LABEL(" ", error) + SHOW_PARSE_LABEL_OK(" ", error) } gg_append_statement( error->structs.arith_error->bottom.label ); } @@ -4814,7 +4874,7 @@ parser_accept_envar(struct cbl_refer_t tgt, { SHOW_PARSE_INDENT SHOW_PARSE_TEXT("Laying down LABEL not_error->bottom") - SHOW_PARSE_LABEL(" ", not_error) + SHOW_PARSE_LABEL_OK(" ", not_error) SHOW_PARSE_END } gg_append_statement( not_error->structs.arith_error->bottom.label ); @@ -4822,7 +4882,8 @@ parser_accept_envar(struct cbl_refer_t tgt, } void -parser_set_envar( struct cbl_refer_t name, struct cbl_refer_t value ) +parser_set_envar( const struct cbl_refer_t &name, + const struct cbl_refer_t &value ) { Analyze(); SHOW_PARSE @@ -5224,7 +5285,6 @@ parser_display_internal(tree file_descriptor, build_int_cst_type(SIZE_T, refer.field->data.capacity), advance ? integer_one_node : integer_zero_node, NULL_TREE ); - cursor_at_sol = advance; } else if( refer.field->type == FldLiteralN ) { @@ -5262,50 +5322,50 @@ parser_display_internal(tree file_descriptor, *p = 'E'; if( exp < 0 && exp >= -9 ) { - p[1] = '-'; - p[2] = '0'; - p[3] = '0' - exp; - p[4] = '\0'; + p[1] = '-'; + p[2] = '0'; + p[3] = '0' - exp; + p[4] = '\0'; } else if( exp >= 0 && exp <= 9 ) { - p[1] = '+'; - p[2] = '0'; - p[3] = '0' + exp; - p[4] = '\0'; + p[1] = '+'; + p[2] = '0'; + p[3] = '0' + exp; + p[4] = '\0'; } } else if (exp == 0) { - p[-1] = '\0'; + p[-1] = '\0'; } else if (exp < 0) { - p[-1] = '\0'; - char *q = strchr (ach, '.'); - char dig = q[-1]; - q[-1] = '\0'; - char tem[132]; - snprintf (tem, 132, "%s0.%0*u%c%s", ach, -exp - 1, 0, dig, q + 1); - strcpy (ach, tem); + p[-1] = '\0'; + char *q = strchr (ach, '.'); + char dig = q[-1]; + q[-1] = '\0'; + char tem[132]; + snprintf (tem, 132, "%s0.%0*d%c%s", ach, -exp - 1, 0, dig, q + 1); + strcpy (ach, tem); } - else if (exp > 0) + else // if (exp > 0) { - p[-1] = '\0'; - char *q = strchr (ach, '.'); - for (int i = 0; i != exp; ++i) - q[i] = q[i + 1]; - q[exp] = '.'; + p[-1] = '\0'; + char *q = strchr (ach, '.'); + for (int i = 0; i != exp; ++i) + q[i] = q[i + 1]; + q[exp] = '.'; } __gg__remove_trailing_zeroes(ach); } if( symbol_decimal_point() == ',' ) { - char *p = strchr(ach, '.' ); - if( p ) + char *pdot = strchr(ach, '.' ); + if( pdot ) { - *p = symbol_decimal_point(); + *pdot = symbol_decimal_point(); } } @@ -5364,10 +5424,10 @@ parser_display_field(cbl_field_t *field) void parser_display( const struct cbl_special_name_t *upon, - std::vector<cbl_refer_t> refs, - bool advance, - cbl_label_t *not_error, - cbl_label_t *error ) + const std::vector<cbl_refer_t> &refs, + bool advance, + const cbl_label_t *not_error, + const cbl_label_t *error ) { const size_t n = refs.size(); /* @@ -5541,6 +5601,106 @@ parser_display( const struct cbl_special_name_t *upon, cursor_at_sol = advance; } +static +bool // Returns false for literals; true for named variables +get_exhibit_name(tree file_descriptor, const cbl_refer_t &arg) + { + bool retval; + if( is_literal(arg.field) ) + { + // If something is a literal, we just display the literal value + parser_display_internal(file_descriptor, + arg, + DISPLAY_NO_ADVANCE); + retval = false; + } + else + { + // It's not a literal, so we show its name, and the names or literal + // values) of any qualifier subscripts or refmods + gg_write( file_descriptor, + gg_string_literal(arg.field->name), + build_int_cst_type(SIZE_T, strlen(arg.field->name)) ); + + if( arg.subscripts.size() ) + { + // This refer has subscripts: + gg_write( file_descriptor, + gg_string_literal("("), + integer_one_node ); + for(size_t i=0; i<arg.subscripts.size(); i++) + { + if( i > 0 ) + { + gg_write( file_descriptor, + gg_string_literal(","), + integer_one_node ); + } + get_exhibit_name(file_descriptor, arg.subscripts[i]); + } + gg_write( file_descriptor, + gg_string_literal(")"), + integer_one_node ); + } + if( arg.refmod.from || arg.refmod.len ) + { + gg_write( file_descriptor, + gg_string_literal("("), + integer_one_node ); + if( arg.refmod.from ) + { + get_exhibit_name(file_descriptor, *(arg.refmod.from)); + } + gg_write( file_descriptor, + gg_string_literal(":"), + integer_one_node ); + if( arg.refmod.len ) + { + get_exhibit_name(file_descriptor, *(arg.refmod.len)); + } + gg_write( file_descriptor, + gg_string_literal(")"), + integer_one_node ); + } + retval = true; + } + return retval; + } + +void +parser_exhibit( bool /*changed*/, bool /*named*/, + const std::vector<cbl_refer_t> &args ) + { + tree file_descriptor = gg_define_int(); + gg_assign(file_descriptor, integer_one_node); // stdout is file descriptor 1. + + for(size_t i=0; i<args.size(); i++) + { + CHECK_FIELD(args[i].field); + if(i > 0) + { + // When there more than one argument, the second through Nth get a space + // in front of them. + gg_write( file_descriptor, + gg_string_literal(" "), + integer_one_node); + } + if( get_exhibit_name(file_descriptor, args[i]) ) + { + gg_write( file_descriptor, + gg_string_literal("="), + integer_one_node); + parser_display_internal(file_descriptor, + args[i], + DISPLAY_NO_ADVANCE); + } + } + gg_write( file_descriptor, + gg_string_literal("\n"), + integer_one_node); + cursor_at_sol = true; + } + static tree get_literalN_value(cbl_field_t *var) { @@ -5813,12 +5973,12 @@ parser_assign( size_t nC, cbl_num_result_t *C, { SHOW_PARSE_INDENT SHOW_PARSE_TEXT(" Laying down on_error GOTO into") - SHOW_PARSE_LABEL(" ", on_error) + SHOW_PARSE_LABEL_OK(" ", on_error) } IF( gg_bitwise_or(error_flag, compute_error->structs.compute_error->compute_error_code), - ne_op, - integer_zero_node ) + ne_op, + integer_zero_node ) { gg_append_statement( on_error->structs.arith_error->into.go_to ); } @@ -5844,7 +6004,7 @@ parser_assign( size_t nC, cbl_num_result_t *C, { SHOW_PARSE_INDENT SHOW_PARSE_TEXT(" Laying down not_error GOTO into") - SHOW_PARSE_LABEL(" ", not_error) + SHOW_PARSE_LABEL_OK(" ", not_error) } IF( compute_error->structs.compute_error->compute_error_code, eq_op, integer_zero_node ) { @@ -5860,7 +6020,7 @@ parser_assign( size_t nC, cbl_num_result_t *C, { SHOW_PARSE_INDENT SHOW_PARSE_TEXT(" Laying down on_error LABEL BOTTOM:") - SHOW_PARSE_LABEL(" ", on_error) + SHOW_PARSE_LABEL_OK(" ", on_error) } gg_append_statement( on_error->structs.arith_error->bottom.label ); } @@ -5871,7 +6031,7 @@ parser_assign( size_t nC, cbl_num_result_t *C, { SHOW_PARSE_INDENT SHOW_PARSE_TEXT(" Laying down not_error LABEL BOTTOM:") - SHOW_PARSE_LABEL(" ", not_error) + SHOW_PARSE_LABEL_OK(" ", not_error) } gg_append_statement( not_error->structs.arith_error->bottom.label ); } @@ -6146,10 +6306,18 @@ parser_initialize_table(size_t nelem, } typedef size_t span_t[2]; static_assert(sizeof(spans[0]) == sizeof(span_t), "pair size wrong"); - static tree tspans = gg_define_variable(SIZE_T_P, "..pit_v1", vs_file_static); - static tree ttbls = gg_define_variable(SIZE_T_P, "..pit_v2", vs_file_static); - gg_assign(tspans, build_array_of_size_t(2*nspan, (const size_t *)spans)); - gg_assign(ttbls, build_array_of_size_t(2*ntbl, (const size_t *)tbls)); + static tree tspans = gg_define_variable(SIZE_T_P, + "..pit_v1", + vs_file_static); + static tree ttbls = gg_define_variable(SIZE_T_P, + "..pit_v2", +vs_file_static); + gg_assign(tspans, + build_array_of_size_t(2*nspan, + reinterpret_cast<const size_t *>(spans))); + gg_assign(ttbls, + build_array_of_size_t(2*ntbl, + reinterpret_cast<const size_t *>(tbls))); gg_call(VOID, "__gg__mirror_range", @@ -6308,7 +6476,7 @@ is_valuable( cbl_field_type_t type ) { return false; } -void parser_sleep(cbl_refer_t seconds) +void parser_sleep(const cbl_refer_t &seconds) { if( seconds.field ) { @@ -6328,7 +6496,7 @@ void parser_sleep(cbl_refer_t seconds) // This is a naked place-holding CONTINUE. Generate some do-nothing // code that will stick some .LOC information into the assembly language, // so that GDB-COBOL can display the CONTINUE statement. - gg_assign(var_decl_nop, build_int_cst_type(INT, 103)); + insert_nop(103); } } @@ -6672,7 +6840,6 @@ parser_arith_error(cbl_label_t *arithmetic_label) // We are entering either SIZE ERROR or NOT SIZE ERROR code RETURN_IF_PARSE_ONLY; - set_up_on_exception_label(arithmetic_label); SHOW_PARSE { @@ -6685,6 +6852,10 @@ parser_arith_error(cbl_label_t *arithmetic_label) SHOW_PARSE_END } + CHECK_LABEL(arithmetic_label); + + set_up_on_exception_label(arithmetic_label); + // Jump over the [NOT] ON EXCEPTION code that is about to be laid down gg_append_statement( arithmetic_label->structs.arith_error->over.go_to ); // Create the label that allows the following code to be executed at @@ -6711,6 +6882,8 @@ parser_arith_error_end(cbl_label_t *arithmetic_label) SHOW_PARSE_END } + CHECK_LABEL(arithmetic_label); + // Jump to the end of the arithmetic code: gg_append_statement( arithmetic_label->structs.arith_error->bottom.go_to ); // Lay down the label that allows the ERROR/NOT ERROR instructions @@ -6894,8 +7067,6 @@ parser_division(cbl_division_t division, SHOW_PARSE_END } - gg_set_current_line_number(CURRENT_LINE_NUMBER); - if( division == data_div_e ) { Analyze(); @@ -7066,14 +7237,13 @@ parser_division(cbl_division_t division, chain_parameter_to_function(current_function->function_decl, par_type, ach); } - bool check_for_parameter_count = false; - if( nusing ) { // During the call, we saved the parameter_count and an array of variable // lengths. We need to look at those values if, and only if, one or more // of our USING arguments has an OPTIONAL flag or if one of our targets is // marked as VARYING. + bool check_for_parameter_count = false; for(size_t i=0; i<nusing; i++) { if( args[i].optional ) @@ -7269,7 +7439,6 @@ parser_division(cbl_division_t division, // If so, we have to give var2::data_pointer the same value as // var1::data_pointer // - cbl_field_t *next_var; size_t our_index = symbol_index(symbol_elem_of(new_var)); size_t next_index = our_index + 1; // Look ahead in the symbol table for the next LEVEL01/77 @@ -7280,7 +7449,7 @@ parser_division(cbl_division_t division, { break; } - next_var = cbl_field_of(e); + cbl_field_t *next_var = cbl_field_of(e); if( !next_var ) { break; @@ -7355,6 +7524,11 @@ parser_division(cbl_division_t division, ENDIF } ENDIF + // The first token_location that the parser establishes is caused by the + // parser scanning all of the lines in the source code. This messes up the + // logic for backing up one line, which is needed to correctly step through + // COBOL code with GDB-COBOL. So, we clear it here. + current_location_minus_one_clear(); } } @@ -7799,7 +7973,9 @@ label_fetch(struct cbl_label_t *label) if( !label->structs.goto_trees ) { label->structs.goto_trees - = (cbl_label_addresses_t *)xmalloc(sizeof(struct cbl_label_addresses_t) ); + = static_cast<cbl_label_addresses_t *> + (xmalloc(sizeof(struct cbl_label_addresses_t))); + gcc_assert(label->structs.goto_trees); gg_create_goto_pair(&label->structs.goto_trees->go_to, &label->structs.goto_trees->label); @@ -7817,15 +7993,18 @@ parser_label_label(struct cbl_label_t *label) SHOW_PARSE_HEADER SHOW_PARSE_LABEL("", label) char ach[32]; - sprintf(ach, " label is at %p", (void*)label); + sprintf(ach, " label is at %p", static_cast<void*>(label)); SHOW_PARSE_TEXT(ach) - sprintf(ach, " label->proc is %p", (void*)label->structs.proc); + if( label ) + { + sprintf(ach, + " label->proc is %p", + static_cast<void*>(label->structs.proc)); + } SHOW_PARSE_TEXT(ach) SHOW_PARSE_END } - CHECK_LABEL(label); - TRACE1 { TRACE1_HEADER @@ -7833,6 +8012,8 @@ parser_label_label(struct cbl_label_t *label) TRACE1_END } + CHECK_LABEL(label); + if(strcmp(label->name, "_end_declaratives") == 0 ) { suppress_cobol_entry_point = false; @@ -7844,21 +8025,25 @@ void parser_label_goto(struct cbl_label_t *label) { label->used = yylineno; + Analyze(); SHOW_PARSE { SHOW_PARSE_HEADER SHOW_PARSE_LABEL(" ", label) char ach[32]; - sprintf(ach, " label is at %p", (void*)label); + sprintf(ach, " label is at %p", static_cast<void*>(label)); SHOW_PARSE_TEXT(ach) - sprintf(ach, " label->proc is %p", (void*)label->structs.proc); + if( label ) + { + sprintf(ach, + " label->proc is %p", + static_cast<void*>(label->structs.proc)); + } SHOW_PARSE_TEXT(ach) SHOW_PARSE_END } - CHECK_LABEL(label); - TRACE1 { TRACE1_HEADER @@ -7866,7 +8051,9 @@ parser_label_goto(struct cbl_label_t *label) TRACE1_END } - if(strcmp(label->name, "_end_declaratives") == 0 ) + CHECK_LABEL(label); + + if( strcmp(label->name, "_end_declaratives") == 0 ) { suppress_cobol_entry_point = true; } @@ -7950,7 +8137,7 @@ parser_setop( struct cbl_field_t *tgt, void parser_classify( cbl_field_t *tgt, - cbl_refer_t candidate, + const cbl_refer_t &candidate, enum classify_t type ) { Analyze(); @@ -8047,14 +8234,6 @@ create_iline_address_pairs(struct cbl_perform_tgt_t *tgt) gg_create_goto_pair(&tgt->addresses.setup.go_to, &tgt->addresses.setup.label); - - // Even in -O0 compilations, the compiler does some elementary optimizations - // around JMP instructions. We have the SETUP code for in-line performats - // in an island at the end of the loop code. With this intervention, NEXTing - // through the code shows you the final statement of the loop before the - // loop actually starts. - - tgt->addresses.line_number_of_setup_code = gg_get_current_line_number(); } void @@ -8068,7 +8247,7 @@ parser_perform_start( struct cbl_perform_tgt_t *tgt ) { SHOW_PARSE_TEXT(" cbl_perform_tgt_t is at") char ach[32]; - sprintf(ach, " %p", (void*)tgt); + sprintf(ach, " %p", static_cast<void*>(tgt)); SHOW_PARSE_TEXT(ach); SHOW_PARSE_LABEL(" ", tgt->from()) if( tgt->to() ) @@ -8117,7 +8296,7 @@ parser_perform_start( struct cbl_perform_tgt_t *tgt ) // Give GDB-COBOL something to chew on when NEXTing. This instruction will // get the line number of the PERFORM N TIMES code. gg_append_statement(tgt->addresses.top.label); - gg_assign(var_decl_nop, build_int_cst_type(INT, 104)); + insert_nop(104); } void @@ -8129,7 +8308,7 @@ parser_perform_conditional( struct cbl_perform_tgt_t *tgt ) SHOW_PARSE_HEADER SHOW_PARSE_TEXT(" cbl_perform_tgt_t is at") char ach[32]; - sprintf(ach, " %p", (void*)tgt); + sprintf(ach, " %p", static_cast<void*>(tgt)); SHOW_PARSE_TEXT(ach); SHOW_PARSE_END } @@ -8179,7 +8358,7 @@ parser_perform_conditional_end( struct cbl_perform_tgt_t *tgt ) SHOW_PARSE_HEADER SHOW_PARSE_TEXT(" cbl_perform_tgt_t is at") char ach[32]; - sprintf(ach, " %p", (void*)tgt); + sprintf(ach, " %p", static_cast<void*>(tgt)); SHOW_PARSE_TEXT(ach); SHOW_PARSE_END } @@ -8269,6 +8448,7 @@ perform_outofline_before_until(struct cbl_perform_tgt_t *tgt, sprintf(ach, "_procretb." HOST_SIZE_T_PRINT_DEC ":", (fmt_size_t)our_pseudo_label); + token_location_override(current_location_minus_one()); gg_insert_into_assembler( ach ); } @@ -8332,6 +8512,7 @@ perform_outofline_after_until(struct cbl_perform_tgt_t *tgt, sprintf(ach, "_procretb." HOST_SIZE_T_PRINT_DEC ":", (fmt_size_t)our_pseudo_label); + token_location_override(current_location_minus_one()); gg_insert_into_assembler( ach ); } @@ -8452,6 +8633,7 @@ perform_outofline_testafter_varying(struct cbl_perform_tgt_t *tgt, sprintf(ach, "_procretb." HOST_SIZE_T_PRINT_DEC ":", (fmt_size_t)our_pseudo_label); + token_location_override(current_location_minus_one()); gg_insert_into_assembler( ach ); } @@ -8595,6 +8777,7 @@ perform_outofline_before_varying( struct cbl_perform_tgt_t *tgt, sprintf(ach, "_procretb." HOST_SIZE_T_PRINT_DEC ":", (fmt_size_t)our_pseudo_label); + token_location_override(current_location_minus_one()); gg_insert_into_assembler( ach ); } @@ -8674,8 +8857,6 @@ perform_inline_until( struct cbl_perform_tgt_t *tgt, GOTO TOP EXIT: */ - gg_set_current_line_number(cobol_location().last_line); - gg_append_statement(tgt->addresses.test.label); // Go to where the conditional is recalculated.... @@ -8790,8 +8971,6 @@ perform_inline_testbefore_varying( struct cbl_perform_tgt_t *tgt, parser_move(varys[i].varying, varys[i].from); } - gg_set_current_line_number(cobol_location().last_line); - // Lay down the testing cycle: for(size_t i=0; i<N; i++) { @@ -9103,7 +9282,7 @@ parser_perform_until( struct cbl_perform_tgt_t *tgt, SHOW_PARSE_HEADER SHOW_PARSE_TEXT(" cbl_perform_tgt_t is at") char ach[32]; - sprintf(ach, " %p", (void*)tgt); + sprintf(ach, " %p", static_cast<void*>(tgt)); SHOW_PARSE_TEXT(ach); SHOW_PARSE_LABEL(" ", tgt->from()) if( tgt->to() ) @@ -9113,9 +9292,6 @@ parser_perform_until( struct cbl_perform_tgt_t *tgt, SHOW_PARSE_END } - gg_set_current_line_number(cobol_location().last_line); - gg_assign(var_decl_nop, build_int_cst_type(INT, 105)); - if( tgt->from()->type != LblLoop ) { perform_outofline( tgt, test_before, N, varys); @@ -9182,10 +9358,6 @@ parser_perform_inline_times(struct cbl_perform_tgt_t *tgt, gg_append_statement( tgt->addresses.testA.label ); gg_append_statement( tgt->addresses.test.label ); - // AT this point, we want to set the line_number to the location of the - // END-PERFORM statement. - gg_set_current_line_number(cobol_location().last_line); - gg_decrement(counter); // Do the test: IF( counter, gt_op, gg_cast(LONG, integer_zero_node) ) @@ -9216,8 +9388,6 @@ parser_perform_inline_times(struct cbl_perform_tgt_t *tgt, SHOW_PARSE_END } - int stash = gg_get_current_line_number(); - gg_set_current_line_number(tgt->addresses.line_number_of_setup_code); gg_append_statement( tgt->addresses.setup.label ); // Get the count: @@ -9248,8 +9418,6 @@ parser_perform_inline_times(struct cbl_perform_tgt_t *tgt, gg_append_statement( tgt->addresses.exit.go_to ); ENDIF - gg_set_current_line_number(stash); - SHOW_PARSE { SHOW_PARSE_INDENT @@ -9938,13 +10106,19 @@ void parser_file_delete( struct cbl_file_t *file, bool /*sequentially*/ ) { Analyze(); + + if( !file ) + { + cbl_internal_error("The file pointer should not be null"); + abort(); // Because cppcheck doesn't recognize [[noerror]] + } + bool sequentially = file->access == file_access_seq_e || file->org == file_sequential_e || file->org == file_line_sequential_e; SHOW_PARSE { SHOW_PARSE_HEADER - if(file) { SHOW_PARSE_TEXT(" "); SHOW_PARSE_TEXT(file->name); @@ -9957,10 +10131,6 @@ parser_file_delete( struct cbl_file_t *file, bool /*sequentially*/ ) SHOW_PARSE_TEXT(" sequentially") } } - else - { - SHOW_PARSE_TEXT(" *file is NULL") - } SHOW_PARSE_END } @@ -10686,7 +10856,7 @@ parser_intrinsic_numval_c( cbl_field_t *f, void parser_intrinsic_subst( cbl_field_t *f, - cbl_refer_t& ref1, + const cbl_refer_t& ref1, size_t argc, cbl_substitute_t * argv ) { @@ -10711,7 +10881,9 @@ parser_intrinsic_subst( cbl_field_t *f, sv_is_i_o = true; store_location_stuff("SUBSTITUTE"); - unsigned char *control_bytes = (unsigned char *)xmalloc(argc * sizeof(unsigned char)); + unsigned char *control_bytes = + static_cast<unsigned char *>(xmalloc(argc * sizeof(unsigned char))); + gcc_assert(control_bytes); std::vector<cbl_refer_t> arg1(argc); std::vector<cbl_refer_t> arg2(argc); @@ -11148,7 +11320,9 @@ static void create_lsearch_address_pairs(struct cbl_label_t *name) { // Create the lsearch structure - name->structs.lsearch = (cbl_lsearch_t *)xmalloc(sizeof(cbl_lsearch_t)); + name->structs.lsearch = + static_cast<cbl_lsearch_t *>(xmalloc(sizeof(cbl_lsearch_t))); + gcc_assert(name->structs.lsearch); cbl_lsearch_t *lsearch = name->structs.lsearch; gg_create_goto_pair(&lsearch->addresses.at_exit.go_to, @@ -11398,7 +11572,9 @@ parser_bsearch_start( cbl_label_t* name, } // We need a cbl_bsearch_t structure: - name->structs.bsearch = (cbl_bsearch_t *)xmalloc(sizeof(cbl_bsearch_t)); + name->structs.bsearch = + static_cast<cbl_bsearch_t *>(xmalloc(sizeof(cbl_bsearch_t))); + gcc_assert(name->structs.bsearch); cbl_bsearch_t *bsearch = name->structs.bsearch; // Create the address/label pairs we need @@ -11431,6 +11607,8 @@ parser_bsearch_start( cbl_label_t* name, current = parent_of(current); } + CHECK_FIELD(current); + // There are a number of things we learn from the field "current" // We get the index: @@ -11543,7 +11721,6 @@ is_ascending_key(const cbl_refer_t& key) bool retval = true; cbl_field_t *family_tree = key.field; - gcc_assert(family_tree); while( family_tree ) { if( family_tree->occurs.nkey ) @@ -11552,7 +11729,10 @@ is_ascending_key(const cbl_refer_t& key) } family_tree = parent_of(family_tree); } + + CHECK_FIELD(family_tree); gcc_assert(family_tree->occurs.nkey); + for(size_t i=0; i<family_tree->occurs.nkey; i++) { for(size_t j=0; j<family_tree->occurs.keys[i].field_list.nfield; j++) @@ -11712,8 +11892,12 @@ parser_sort(cbl_refer_t tableref, return n + key.fields.size(); } ); typedef const cbl_field_t * const_field_t; - const_field_t *flattened_fields = (const_field_t *)xmalloc(total_keys * sizeof(cbl_field_t *)); - size_t *flattened_ascending = (size_t *)xmalloc(total_keys * sizeof(size_t)); + const_field_t *flattened_fields = + static_cast<const_field_t *>(xmalloc(total_keys * sizeof(cbl_field_t *))); + gcc_assert(flattened_fields); + size_t *flattened_ascending = + static_cast<size_t *>(xmalloc(total_keys * sizeof(size_t))); + gcc_assert(flattened_ascending); size_t key_index = 0; for( size_t i=0; i<keys.size(); i++ ) @@ -11849,8 +12033,12 @@ parser_file_sort( cbl_file_t *workfile, return n + key.fields.size(); } ); typedef const cbl_field_t * const_field_t; - auto flattened_fields = (const_field_t *)xmalloc(total_keys * sizeof(cbl_field_t *)); - size_t *flattened_ascending = (size_t *) xmalloc(total_keys * sizeof(size_t)); + auto flattened_fields + = static_cast<const_field_t *>(xmalloc(total_keys * sizeof(cbl_field_t *))); + gcc_assert(flattened_fields); + size_t *flattened_ascending = + static_cast<size_t *>(xmalloc(total_keys * sizeof(size_t))); + gcc_assert(flattened_ascending); size_t key_index = 0; for( size_t i=0; i<keys.size(); i++ ) @@ -12009,7 +12197,9 @@ parser_return_start( cbl_file_t *workfile, cbl_refer_t into ) // We assume that workfile is open. - workfile->addresses = (cbl_sortreturn_t *)xmalloc(sizeof(cbl_sortreturn_t)); + workfile->addresses = static_cast<cbl_sortreturn_t *> + (xmalloc(sizeof(cbl_sortreturn_t))); + gcc_assert(workfile->addresses); gg_create_goto_pair(&workfile->addresses->at_end.go_to, &workfile->addresses->at_end.label); gg_create_goto_pair(&workfile->addresses->not_at_end.go_to, @@ -12195,9 +12385,13 @@ parser_file_merge( cbl_file_t *workfile, return i + key.fields.size(); } ); typedef const cbl_field_t * const_field_t; - const_field_t *flattened_fields = (const_field_t *)xmalloc(total_keys * sizeof(cbl_field_t *)); + const_field_t *flattened_fields + = static_cast<const_field_t *> + (xmalloc(total_keys * sizeof(cbl_field_t *))); + gcc_assert(flattened_fields); size_t *flattened_ascending - = (size_t *)xmalloc(total_keys * sizeof(size_t)); + = static_cast<size_t *>(xmalloc(total_keys * sizeof(size_t))); + gcc_assert(flattened_ascending); size_t key_index = 0; for( size_t i=0; i<keys.size(); i++ ) @@ -12211,8 +12405,9 @@ parser_file_merge( cbl_file_t *workfile, } // Create the array of cbl_field_t pointers for the keys - tree all_keys = gg_array_of_field_pointers(total_keys, - const_cast<cbl_field_t**>(flattened_fields)); + tree all_keys = gg_array_of_field_pointers( + total_keys, + const_cast<cbl_field_t**>(flattened_fields)); // Create the array of integers that are the flags for ASCENDING: tree ascending = gg_array_of_size_t(total_keys, flattened_ascending); @@ -12236,8 +12431,9 @@ parser_file_merge( cbl_file_t *workfile, ELSE ENDIF - cbl_enabled_exceptions_t& enabled_exceptions( cdf_enabled_exceptions() ); - + const cbl_enabled_exceptions_t& + enabled_exceptions( cdf_enabled_exceptions() ); + for(size_t i=0; i<ninputs; i++) { if( process_this_exception(ec_sort_merge_file_open_e) ) @@ -12395,7 +12591,8 @@ parser_string_overflow( cbl_label_t *name ) */ name->structs.unstring - = (cbl_unstring_t *)xmalloc(sizeof(struct cbl_unstring_t) ); + = static_cast<cbl_unstring_t *>(xmalloc(sizeof(struct cbl_unstring_t))); + gcc_assert(name->structs.unstring); // Set up the address pairs for this clause gg_create_goto_pair(&name->structs.unstring->over.go_to, @@ -12454,8 +12651,8 @@ parser_unstring(cbl_refer_t src, } std::vector<cbl_refer_t> delims(ndelimited); - char *alls = (char *)xmalloc(ndelimited+1); - + char *alls = static_cast<char *>(xmalloc(ndelimited+1)); + gcc_assert(alls); for(size_t i=0; i<ndelimited; i++) { delims[i] = delimiteds[i]; @@ -12546,7 +12743,8 @@ parser_string(const cbl_refer_t& tgt, } // We need an array of nsource+1 integers: - size_t *integers = (size_t *)xmalloc((nsource+1)*sizeof(size_t)); + size_t *integers = static_cast<size_t *>(xmalloc((nsource+1)*sizeof(size_t))); + gcc_assert(integers); // Count up how many treeplets we are going to need: size_t cblc_count = 2; // tgt and pointer @@ -12637,8 +12835,9 @@ parser_call_exception( cbl_label_t *name ) } name->structs.call_exception - = (cbl_call_exception_t *)xmalloc(sizeof(struct cbl_call_exception_t) ); - + = static_cast<cbl_call_exception_t *> + (xmalloc(sizeof(struct cbl_call_exception_t))); + gcc_assert(name->structs.call_exception); // Set up the address pairs for this clause gg_create_goto_pair(&name->structs.call_exception->over.go_to, &name->structs.call_exception->over.label); @@ -12698,8 +12897,10 @@ create_and_call(size_t narg, if(narg) { - arguments = (tree *)xmalloc(2*narg * sizeof(tree)); - allocated = (int * )xmalloc(narg * sizeof(int)); + arguments = static_cast<tree *>(xmalloc(2*narg * sizeof(tree))); + gcc_assert(arguments); + allocated = static_cast<int *>(xmalloc(narg * sizeof(int))); + gcc_assert(allocated); } // Put the arguments onto the "stack" of calling parameters: @@ -12931,7 +13132,7 @@ create_and_call(size_t narg, // Fetch the FUNCTION_DECL for that FUNCTION_TYPE tree function_decl = gg_build_fn_decl(funcname, fndecl_type); set_call_convention(function_decl, current_call_convention()); - + // Take the address of the function decl: tree address_of_function = gg_get_address_of(function_decl); @@ -12943,7 +13144,7 @@ create_and_call(size_t narg, parser_call_target( funcname, assigment ); // Create the call_expr from that address - call_expr = build_call_array_loc( location_from_lineno(), + call_expr = build_call_array_loc( gg_token_location(), returned_value_type, address_of_function, narg, @@ -14055,9 +14256,9 @@ conditional_abs(tree source, const cbl_field_t *field) } static bool -mh_identical(cbl_refer_t &destref, - const cbl_refer_t &sourceref, - const TREEPLET &tsource) +mh_identical(const cbl_refer_t &destref, + const cbl_refer_t &sourceref, + const TREEPLET &tsource) { // Check to see if the two variables are identical types, thus allowing // for a simple byte-for-byte copy of the data areas: @@ -14079,7 +14280,7 @@ mh_identical(cbl_refer_t &destref, ) { // The source and destination are identical in type - if( (sourceref.field->attr & intermediate_e) || !symbol_find_odo(sourceref.field) ) + if( !symbol_find_odo(sourceref.field) ) { Analyze(); // Source doesn't have a depending_on clause @@ -14648,10 +14849,10 @@ picky_memcpy(tree &dest_p, const tree &source_p, size_t length) } static bool -mh_numeric_display( cbl_refer_t &destref, - const cbl_refer_t &sourceref, - const TREEPLET &tsource, - tree size_error) +mh_numeric_display( const cbl_refer_t &destref, + const cbl_refer_t &sourceref, + const TREEPLET &tsource, + tree size_error) { bool moved = false; @@ -15137,11 +15338,11 @@ mh_numeric_display( cbl_refer_t &destref, } static bool -mh_little_endian( cbl_refer_t &destref, - const cbl_refer_t &sourceref, - const TREEPLET &tsource, - bool check_for_error, - tree size_error) +mh_little_endian( const cbl_refer_t &destref, + const cbl_refer_t &sourceref, + const TREEPLET &tsource, + bool check_for_error, + tree size_error) { bool moved = false; @@ -15209,9 +15410,9 @@ mh_little_endian( cbl_refer_t &destref, } static bool -mh_source_is_group( cbl_refer_t &destref, - const cbl_refer_t &sourceref, - const TREEPLET &tsrc) +mh_source_is_group( const cbl_refer_t &destref, + const cbl_refer_t &sourceref, + const TREEPLET &tsrc) { bool retval = false; if( sourceref.field->type == FldGroup && !(destref.field->attr & rjust_e) ) @@ -15301,7 +15502,7 @@ move_helper(tree size_error, // This is an INT //goto dont_be_clever; this will go through to the default. } - if( !moved ) + // if( !moved ) // commented out to quiet cppcheck { moved = mh_source_is_group(destref, sourceref, tsource); } @@ -15370,8 +15571,9 @@ move_helper(tree size_error, // This is an INT if( buffer_size < source_length ) { buffer_size = source_length; - buffer = (char *)xrealloc(buffer, buffer_size); + buffer = static_cast<char *>(xrealloc(buffer, buffer_size)); } + gcc_assert(buffer); if( figconst ) { @@ -15645,7 +15847,8 @@ binary_initial_from_float128(cbl_field_t *field, int rdigits, FIXED_WIDE_INT(128) i = FIXED_WIDE_INT(128)::from (real_to_integer (&value, &fail, 128), SIGNED); - retval = (char *)xmalloc(field->data.capacity); + retval = static_cast<char *>(xmalloc(field->data.capacity)); + gcc_assert(retval); switch(field->data.capacity) { tree type; @@ -15656,7 +15859,7 @@ binary_initial_from_float128(cbl_field_t *field, int rdigits, case 16: type = build_nonstandard_integer_type ( field->data.capacity * BITS_PER_UNIT, 0); - native_encode_wide_int (type, i, (unsigned char *)retval, + native_encode_wide_int (type, i, PTRCAST(unsigned char, retval), field->data.capacity); break; default: @@ -15786,7 +15989,8 @@ initial_from_initial(cbl_field_t *field) } if( set_return ) { - retval = (char *)xmalloc(field->data.capacity+1); + retval = static_cast<char *>(xmalloc(field->data.capacity+1)); + gcc_assert(retval); memset(retval, const_char, field->data.capacity); retval[field->data.capacity] = '\0'; return retval; @@ -15856,7 +16060,8 @@ initial_from_initial(cbl_field_t *field) case FldNumericDisplay: { - retval = (char *)xmalloc(field->data.capacity); + retval = static_cast<char *>(xmalloc(field->data.capacity)); + gcc_assert(retval); char *pretval = retval; char ach[128]; @@ -15936,7 +16141,8 @@ initial_from_initial(cbl_field_t *field) case FldPacked: { - retval = (char *)xmalloc(field->data.capacity); + retval = static_cast<char *>(xmalloc(field->data.capacity)); + gcc_assert(retval); char *pretval = retval; char ach[128]; @@ -16003,7 +16209,8 @@ initial_from_initial(cbl_field_t *field) { if( field->data.initial ) { - retval = (char *)xmalloc(field->data.capacity+1); + retval = static_cast<char *>(xmalloc(field->data.capacity+1)); + gcc_assert(retval); if( field->attr & hex_encoded_e) { memcpy(retval, field->data.initial, field->data.capacity); @@ -16011,7 +16218,7 @@ initial_from_initial(cbl_field_t *field) else { size_t buffer_size = 0; - size_t length = (size_t)field->data.capacity; + size_t length = field->data.capacity; memset(retval, internal_space, length); raw_to_internal(&retval, &buffer_size, field->data.initial, length); if( strlen(field->data.initial) < length ) @@ -16027,7 +16234,8 @@ initial_from_initial(cbl_field_t *field) case FldNumericEdited: { - retval = (char *)xmalloc(field->data.capacity+1); + retval = static_cast<char *>(xmalloc(field->data.capacity+1)); + gcc_assert(retval); if( field->data.initial && field->attr & quoted_e ) { // What the programmer says the value is, the value becomes, no @@ -16062,7 +16270,6 @@ initial_from_initial(cbl_field_t *field) char ach[128]; memset(ach, 0, sizeof(ach)); memset(retval, 0, field->data.capacity); - size_t ndigits = field->data.capacity; if( (field->attr & blank_zero_e) && real_iszero (&value) ) { @@ -16070,6 +16277,7 @@ initial_from_initial(cbl_field_t *field) } else { + size_t ndigits = field->data.capacity; digits_from_float128(ach, field, ndigits, rdigits, value); /* ??? This resides in libgcobol valconv.cc. */ __gg__string_to_numeric_edited( retval, @@ -16084,23 +16292,24 @@ initial_from_initial(cbl_field_t *field) case FldFloat: { - retval = (char *)xmalloc(field->data.capacity); + retval = static_cast<char *>(xmalloc(field->data.capacity)); + gcc_assert(retval); switch( field->data.capacity ) { case 4: value = real_value_truncate (TYPE_MODE (FLOAT), value); native_encode_real (SCALAR_FLOAT_TYPE_MODE (FLOAT), &value, - (unsigned char *)retval, 4, 0); + PTRCAST(unsigned char, retval), 4, 0); break; case 8: value = real_value_truncate (TYPE_MODE (DOUBLE), value); native_encode_real (SCALAR_FLOAT_TYPE_MODE (DOUBLE), &value, - (unsigned char *)retval, 8, 0); + PTRCAST(unsigned char, retval), 8, 0); break; case 16: value = real_value_truncate (TYPE_MODE (FLOAT128), value); native_encode_real (SCALAR_FLOAT_TYPE_MODE (FLOAT128), &value, - (unsigned char *)retval, 16, 0); + PTRCAST(unsigned char, retval), 16, 0); break; } break; @@ -16486,12 +16695,13 @@ psa_FldLiteralA(struct cbl_field_t *field ) // First make room static size_t buffer_size = 1024; - static char *buffer = (char *)xmalloc(buffer_size); + static char *buffer = static_cast<char *>(xmalloc(buffer_size)); if( buffer_size < field->data.capacity+1 ) { buffer_size = field->data.capacity+1; - buffer = (char *)xrealloc(buffer, buffer_size); + buffer = static_cast<char *>(xrealloc(buffer, buffer_size)); } + gcc_assert(buffer); cbl_figconst_t figconst = cbl_figconst_of( field->data.initial ); gcc_assert(figconst == normal_value_e); @@ -16546,7 +16756,7 @@ psa_FldLiteralA(struct cbl_field_t *field ) vs_file_static); } else -#endif +#endif { // We have not seen that string before static int nvar = 0; @@ -16560,9 +16770,9 @@ psa_FldLiteralA(struct cbl_field_t *field ) vs_file_static); actually_create_the_static_field( field, - build_string_literal(field->data.capacity+1, + build_string_literal(field->data.capacity, buffer), - field->data.capacity+1, + field->data.capacity, field->data.initial, NULL_TREE, field->var_decl_node); @@ -16590,6 +16800,8 @@ parser_local_add(struct cbl_field_t *new_var ) SHOW_PARSE_END } + CHECK_FIELD(new_var); + IF( member(new_var->var_decl_node, "data"), ne_op, gg_cast(UCHAR_P, null_pointer_node) ) @@ -16646,8 +16858,8 @@ parser_symbol_add(struct cbl_field_t *new_var ) } while(0); - fprintf(stderr, " %2.2d %s<%s> off:" HOST_SIZE_T_PRINT_DEC " " - "msiz:%d cap:%d dig:%d rdig:%d attr:0x" HOST_SIZE_T_PRINT_HEX_PURE " loc:%p", + fprintf(stderr, " %2.2u %s<%s> off:" HOST_SIZE_T_PRINT_UNSIGNED " " + "msiz:%u cap:%u dig:%u rdig:%d attr:0x" HOST_SIZE_T_PRINT_HEX_PURE " loc:%p", new_var->level, new_var->name, cbl_field_type_str(new_var->type), @@ -16657,7 +16869,7 @@ parser_symbol_add(struct cbl_field_t *new_var ) new_var->data.digits, new_var->data.rdigits, (fmt_size_t)new_var->attr, - (void*)new_var); + static_cast<void*>(new_var)); if( is_table(new_var) ) { @@ -16697,7 +16909,7 @@ parser_symbol_add(struct cbl_field_t *new_var ) { fprintf(stderr, " redefines:(%p)%s", - (void*)symbol_redefines(new_var), + static_cast<void*>(symbol_redefines(new_var)), symbol_redefines(new_var)->name); } @@ -16797,10 +17009,12 @@ parser_symbol_add(struct cbl_field_t *new_var ) TRACE1_TEXT_ABC(" (", cbl_field_type_str(new_var->type) ,")") if( new_var->type == FldLiteralN) { + const void *p1 = (new_var->data.initial); + const long *pldata = static_cast<const long *>(p1); + long ldata = *pldata; gg_fprintf( trace_handle, 1, " [%ld]", - build_int_cst_type(LONG, - *(const long *)new_var->data.initial)); + build_int_cst_type(LONG, ldata)); } TRACE1_END } diff --git a/gcc/cobol/genapi.h b/gcc/cobol/genapi.h index ab76856..b41b906 100644 --- a/gcc/cobol/genapi.h +++ b/gcc/cobol/genapi.h @@ -52,20 +52,26 @@ void parser_division( cbl_division_t division, void parser_enter_program(const char *funcname, bool is_function, int *retval); void parser_leave_program(); -void parser_accept( cbl_refer_t refer, special_name_t special_e, - cbl_label_t *error, cbl_label_t *not_error ); +void parser_accept( const cbl_refer_t &refer, + special_name_t special_e, + cbl_label_t *error, + cbl_label_t *not_error ); void parser_accept_exception( cbl_label_t *name ); void parser_accept_exception_end( cbl_label_t *name ); void parser_accept_under_discussion(struct cbl_refer_t tgt, special_name_t special, cbl_label_t *error, cbl_label_t *not_error ); -void parser_accept_envar( cbl_refer_t refer, cbl_refer_t envar, - cbl_label_t *error, cbl_label_t *not_error ); -void parser_set_envar( cbl_refer_t envar, cbl_refer_t refer ); - -void parser_accept_command_line( cbl_refer_t tgt, cbl_refer_t src, - cbl_label_t *error, cbl_label_t *not_error ); -void parser_accept_command_line_count( cbl_refer_t tgt ); +void parser_accept_envar( const cbl_refer_t &refer, + const cbl_refer_t &envar, + cbl_label_t *error, + cbl_label_t *not_error ); +void parser_set_envar( const cbl_refer_t &envar, const cbl_refer_t &refer ); + +void parser_accept_command_line(const cbl_refer_t &tgt, + const cbl_refer_t &src, + cbl_label_t *error, + cbl_label_t *not_error ); +void parser_accept_command_line_count( const cbl_refer_t &tgt ); void parser_accept_date_yymmdd( cbl_field_t *tgt ); void parser_accept_date_yyyymmdd( cbl_field_t *tgt ); @@ -89,8 +95,7 @@ parser_add( size_t nC, cbl_num_result_t *C, size_t nA, cbl_refer_t *A, cbl_arith_format_t format, cbl_label_t *error, - cbl_label_t *not_error, - void *compute_error = NULL); // This has to be cast to a tree pointer to int + cbl_label_t *not_error, void *compute_error = NULL); // This has to be cast to a tree pointer to int void parser_arith_error( cbl_label_t *name ); void parser_arith_error_end( cbl_label_t *name ); @@ -177,7 +182,8 @@ parser_bitwise_op(struct cbl_field_t *tgt, void parser_classify( struct cbl_field_t *tgt, - struct cbl_refer_t srca, enum classify_t type ); + const struct cbl_refer_t &srca, + enum classify_t type ); void parser_op( struct cbl_refer_t cref, @@ -256,7 +262,7 @@ parser_program_hierarchy( const struct cbl_prog_hier_t& hier ); void parser_end_program(const char *name=NULL); -void parser_sleep(cbl_refer_t seconds); +void parser_sleep(const cbl_refer_t &seconds); void parser_exit( const cbl_refer_t& refer, ec_type_t = ec_none_e ); void parser_exit_section(void); @@ -265,11 +271,14 @@ void parser_exit_perform( struct cbl_perform_tgt_t *tgt, bool cycle ); void parser_exit_program(void); // exits back to COBOL only, else continue void +parser_exhibit( bool changed, bool named, + const std::vector<cbl_refer_t> &args ); +void parser_display( const struct cbl_special_name_t *upon, - std::vector<cbl_refer_t> args, - bool advance = DISPLAY_ADVANCE, - cbl_label_t *not_error = nullptr, - cbl_label_t *compute_error = nullptr ); + const std::vector<cbl_refer_t> &args, + bool advance = DISPLAY_ADVANCE, + const cbl_label_t *not_error = nullptr, + const cbl_label_t *compute_error = nullptr ); void parser_display_field(cbl_field_t *fld); @@ -305,7 +314,7 @@ void parser_initialize(const cbl_refer_t& refer, bool like_parser_symbol_add=false); void -parser_initialize_programs(size_t nprog, struct cbl_refer_t *progs); +parser_initialize_programs(size_t nprog, const struct cbl_refer_t *progs); void parser_label_label( struct cbl_label_t *label ); @@ -452,7 +461,7 @@ parser_intrinsic_numval_c( cbl_field_t *f, void parser_intrinsic_subst( cbl_field_t *f, - cbl_refer_t& ref1, + const cbl_refer_t& ref1, size_t argc, cbl_substitute_t * argv ); diff --git a/gcc/cobol/gengen.cc b/gcc/cobol/gengen.cc index e42747b..3ad3344 100644 --- a/gcc/cobol/gengen.cc +++ b/gcc/cobol/gengen.cc @@ -107,8 +107,6 @@ // Don't like it? Cry me a river. static const int ARG_LIMIT = 512; -static int sv_current_line_number; - // These are globally useful constants tree char_nodes[256]; @@ -140,7 +138,7 @@ struct cbl_translation_unit_t gg_trans_unit; // the compiler when a source code module makes that mistake. static std::unordered_set<std::string> names_we_have_seen; -// This vector is used to process the function_decls at the point we leave +// This vector is used to process the function_decls at the point we leave // the file. static std::vector<tree> finalized_function_decls; @@ -452,7 +450,7 @@ gg_assign(tree dest, const tree source) if( okay ) { - stmt = build2_loc(location_from_lineno(), + stmt = build2_loc(gg_token_location(), MODIFY_EXPR, TREE_TYPE(dest), dest, @@ -616,7 +614,7 @@ gg_add_field_to_structure(const tree type_of_field, const char *name_of_field, t tree id_of_field = get_identifier (name_of_field); // Create the new field: - tree new_field_decl = build_decl( location_from_lineno(), + tree new_field_decl = build_decl( gg_token_location(), FIELD_DECL, id_of_field, type_of_field); @@ -893,7 +891,7 @@ gg_create_assembler_name(const char *cobol_name) static char * gg_unique_in_function(const char *var_name, gg_variable_scope_t vs_scope) { - char *retval = (char *)xmalloc(strlen(var_name)+32); + char *retval = static_cast<char *>(xmalloc(strlen(var_name)+32)); if( (vs_scope == vs_stack || vs_scope == vs_static) ) { sprintf(retval, "%s." HOST_SIZE_T_PRINT_DEC, var_name, @@ -1028,10 +1026,7 @@ gg_declare_variable(tree type_decl, break; } DECL_INITIAL(var_decl) = initial_value; - if( unique_name ) - { - free(unique_name); - } + free(unique_name); return var_decl; } @@ -1046,7 +1041,7 @@ gg_define_from_declaration(tree var_decl) { // Having made sure the chain of variable declarations is nicely started, // it's time to actually define the storage with a decl_expression: - tree stmt = build1_loc (location_from_lineno(), + tree stmt = build1_loc (gg_token_location(), DECL_EXPR, TREE_TYPE(var_decl), var_decl); @@ -1777,7 +1772,7 @@ gg_build_relational_expression(tree operand_a, compare = LE_EXPR; break; } - tree relational_expression = build2_loc(location_from_lineno(), + tree relational_expression = build2_loc(gg_token_location(), compare, boolean_type_node, operand_a, @@ -1894,7 +1889,7 @@ gg_create_goto_pair(tree *goto_expr, void gg_goto_label_decl(tree label_decl) { - tree goto_expr = build1_loc( location_from_lineno(), + tree goto_expr = build1_loc( gg_token_location(), GOTO_EXPR, void_type_node, label_decl); @@ -1941,7 +1936,7 @@ gg_create_goto_pair(tree *goto_expr, tree *label_expr, const char *name) void gg_goto(tree var_decl_pointer) { - tree go_to = build1_loc(location_from_lineno(), + tree go_to = build1_loc(gg_token_location(), GOTO_EXPR, void_type_node, var_decl_pointer); @@ -2189,7 +2184,7 @@ gg_printf(const char *format_string, ...) function = gg_get_function_address(INT, "__gg__fprintf_stderr"); } - tree stmt = build_call_array_loc (location_from_lineno(), + tree stmt = build_call_array_loc (gg_token_location(), INT, function, nargs, @@ -2236,7 +2231,7 @@ gg_fprintf(tree fd, int nargs, const char *format_string, ...) function = gg_get_function_address(INT, "sprintf"); } - tree stmt = build_call_array_loc (location_from_lineno(), + tree stmt = build_call_array_loc (gg_token_location(), INT, function, argc, @@ -2283,7 +2278,7 @@ void gg_memset(tree dest, const tree value, tree size) { tree the_call = - build_call_expr_loc(location_from_lineno(), + build_call_expr_loc(gg_token_location(), builtin_decl_explicit (BUILT_IN_MEMSET), 3, dest, @@ -2297,7 +2292,7 @@ gg_memchr(tree buf, tree ch, tree length) { tree the_call = fold_convert( pvoid_type_node, - build_call_expr_loc(location_from_lineno(), + build_call_expr_loc(gg_token_location(), builtin_decl_explicit (BUILT_IN_MEMCHR), 3, buf, @@ -2312,7 +2307,7 @@ void gg_memcpy(tree dest, const tree src, tree size) { tree the_call = build_call_expr_loc( - location_from_lineno(), + gg_token_location(), builtin_decl_explicit (BUILT_IN_MEMCPY), 3, dest, @@ -2327,7 +2322,7 @@ void gg_memmove(tree dest, const tree src, tree size) { tree the_call = build_call_expr_loc( - location_from_lineno(), + gg_token_location(), builtin_decl_explicit (BUILT_IN_MEMMOVE), 3, dest, @@ -2360,7 +2355,7 @@ void gg_strcpy(tree dest, tree src) { tree the_call = - build_call_expr_loc(location_from_lineno(), + build_call_expr_loc(gg_token_location(), builtin_decl_explicit (BUILT_IN_STRCPY), 2, dest, @@ -2373,7 +2368,7 @@ gg_strcmp(tree A, tree B) { tree the_call = fold_convert( integer_type_node, - build_call_expr_loc(location_from_lineno(), + build_call_expr_loc(gg_token_location(), builtin_decl_explicit (BUILT_IN_STRCMP), 2, A, @@ -2405,7 +2400,7 @@ gg_strncmp(tree char_star_A, tree char_star_B, tree size_t_N) { tree the_call = fold_convert( integer_type_node, - build_call_expr_loc(location_from_lineno(), + build_call_expr_loc(gg_token_location(), builtin_decl_explicit (BUILT_IN_STRNCMP), 3, char_star_A, @@ -2436,7 +2431,7 @@ gg_return(tree operand) { // When there is no operand, or if the function result is void, then // we just generate a return_expr. - stmt = build1_loc(location_from_lineno(), RETURN_EXPR, void_type_node, NULL_TREE); + stmt = build1_loc(gg_token_location(), RETURN_EXPR, void_type_node, NULL_TREE); } else { @@ -2446,7 +2441,7 @@ gg_return(tree operand) function_type, DECL_RESULT(current_function->function_decl), gg_cast(function_type, operand)); - stmt = build1_loc(location_from_lineno(), RETURN_EXPR, void_type_node, modify); + stmt = build1_loc(gg_token_location(), RETURN_EXPR, void_type_node, modify); } gg_append_statement(stmt); } @@ -2454,7 +2449,7 @@ gg_return(tree operand) void chain_parameter_to_function(tree function_decl, const tree param_type, const char *name) { - tree parm = build_decl (location_from_lineno(), + tree parm = build_decl (gg_token_location(), PARM_DECL, get_identifier (name), param_type); @@ -2521,12 +2516,12 @@ gg_peek_fn_decl(const char *funcname, tree fndecl_type) } return retval; } - + tree gg_build_fn_decl(const char *funcname, tree fndecl_type) { tree function_decl; - + std::string key = function_decl_key(funcname, fndecl_type); std::unordered_map<std::string, tree>::const_iterator it = map_of_function_decls.find(key); @@ -2617,13 +2612,13 @@ gg_define_function( tree return_type, } va_end(params); + char ach[32]; std::unordered_set<std::string>::const_iterator it = names_we_have_seen.find(funcname); if( it != names_we_have_seen.end() ) { static int bum_counter = 1; // We have seen this name before. Replace it with something unique: - char ach[32]; sprintf(ach, "..no_dupes.%d", bum_counter++); funcname = ach; } @@ -2689,7 +2684,7 @@ gg_define_function( tree return_type, } // Establish the RESULT_DECL for the function: - tree resdecl = build_decl (location_from_lineno(), RESULT_DECL, NULL_TREE, return_type); + tree resdecl = build_decl (gg_token_location(), RESULT_DECL, NULL_TREE, return_type); DECL_CONTEXT (resdecl) = function_decl; DECL_RESULT (function_decl) = resdecl; @@ -2821,7 +2816,7 @@ gg_get_function_decl(tree return_type, const char *funcname, ...) } // Establish the RESULT_DECL for the function: - tree resdecl = build_decl (location_from_lineno(), RESULT_DECL, NULL_TREE, return_type); + tree resdecl = build_decl (gg_token_location(), RESULT_DECL, NULL_TREE, return_type); DECL_CONTEXT (resdecl) = function_decl; DECL_RESULT (function_decl) = resdecl; @@ -3058,7 +3053,7 @@ gg_call_expr(tree return_type, const char *function_name, ...) tree arg = va_arg(ap, tree); - if( !arg ) + if( arg == NULL_TREE ) { break; } @@ -3079,7 +3074,7 @@ gg_call_expr(tree return_type, const char *function_name, ...) tree the_func_addr = build1(ADDR_EXPR, build_pointer_type (TREE_TYPE(function_decl)), function_decl); - tree the_call = build_call_array_loc(location_from_lineno(), + tree the_call = build_call_array_loc(gg_token_location(), return_type, the_func_addr, nargs, @@ -3114,7 +3109,7 @@ gg_call(tree return_type, const char *function_name, ...) tree arg = va_arg(ap, tree); - if( !arg ) + if( arg == NULL_TREE ) { break; } @@ -3135,7 +3130,7 @@ gg_call(tree return_type, const char *function_name, ...) tree the_func_addr = build1(ADDR_EXPR, build_pointer_type (TREE_TYPE(function_decl)), function_decl); - tree the_call = build_call_array_loc(location_from_lineno(), + tree the_call = build_call_array_loc(gg_token_location(), return_type, the_func_addr, nargs, @@ -3160,7 +3155,7 @@ gg_call_expr_list(tree return_type, tree function_pointer, int param_count, tree // Avoid that with something like // gg_assign( dest, gg_call_expr_list(...) ); - tree the_call = build_call_array_loc(location_from_lineno(), + tree the_call = build_call_array_loc(gg_token_location(), return_type, function_pointer, param_count, @@ -3195,7 +3190,7 @@ void gg_exit(tree exit_code) { tree the_call = - build_call_expr_loc(location_from_lineno(), + build_call_expr_loc(gg_token_location(), builtin_decl_explicit (BUILT_IN_EXIT), 1, exit_code); @@ -3206,7 +3201,7 @@ void gg_abort() { tree the_call = - build_call_expr_loc(location_from_lineno(), + build_call_expr_loc(gg_token_location(), builtin_decl_explicit (BUILT_IN_ABORT), 0); gg_append_statement(the_call); @@ -3217,7 +3212,7 @@ gg_strlen(tree psz) { tree the_call = fold_convert( size_type_node, - build_call_expr_loc(location_from_lineno(), + build_call_expr_loc(gg_token_location(), builtin_decl_explicit (BUILT_IN_STRLEN), 1, psz)); @@ -3229,7 +3224,7 @@ gg_strdup(tree psz) { tree the_call = fold_convert( build_pointer_type(char_type_node), - build_call_expr_loc(location_from_lineno(), + build_call_expr_loc(gg_token_location(), builtin_decl_explicit (BUILT_IN_STRDUP), 1, psz)); @@ -3243,7 +3238,7 @@ gg_malloc(tree size) { tree the_call = fold_convert( pvoid_type_node, - build_call_expr_loc(location_from_lineno(), + build_call_expr_loc(gg_token_location(), builtin_decl_explicit (BUILT_IN_MALLOC), 1, size)); @@ -3255,7 +3250,7 @@ gg_realloc(tree base, tree size) { tree the_call = fold_convert( pvoid_type_node, - build_call_expr_loc(location_from_lineno(), + build_call_expr_loc(gg_token_location(), builtin_decl_explicit (BUILT_IN_REALLOC), 2, base, @@ -3279,7 +3274,7 @@ void gg_free(tree pointer) { tree the_call = - build_call_expr_loc(location_from_lineno(), + build_call_expr_loc(gg_token_location(), builtin_decl_explicit (BUILT_IN_FREE), 1, pointer); @@ -3380,18 +3375,6 @@ gg_string_literal(const char *string) return build_string_literal(strlen(string)+1, string); } -void -gg_set_current_line_number(int line_number) - { - sv_current_line_number = line_number; - } - -int -gg_get_current_line_number() - { - return sv_current_line_number; - } - tree gg_trans_unit_var_decl(const char *var_name) { @@ -3413,7 +3396,7 @@ gg_insert_into_assembler(const char ach[]) if( !optimize ) { // Create the required generic tag - tree asm_expr = build5_loc( location_from_lineno(), + tree asm_expr = build5_loc( gg_token_location(), ASM_EXPR, VOID, build_string(strlen(ach), ach), @@ -3450,5 +3433,28 @@ gg_insert_into_assemblerf(const char *format, ...) gg_insert_into_assembler(ach); } } +#pragma GCC diagnostic pop + +static location_t sv_token_location_override = 0; -#pragma GCC diagnostic pop
\ No newline at end of file +void +token_location_override(location_t loc) + { + sv_token_location_override = loc; + } + +location_t +gg_token_location() + { + location_t retval; + if( sv_token_location_override ) + { + retval = sv_token_location_override; + sv_token_location_override = 0; + } + else + { + retval = current_token_location(); + } + return retval; + } diff --git a/gcc/cobol/gengen.h b/gcc/cobol/gengen.h index 06b28e06..96e69dd 100644 --- a/gcc/cobol/gengen.h +++ b/gcc/cobol/gengen.h @@ -525,11 +525,11 @@ extern tree gg_indirect(tree pointer, tree byte_offset = NULL_TREE); extern tree gg_string_literal(const char *string); #define CURRENT_LINE_NUMBER (cobol_location().first_line) -extern location_t location_from_lineno(); - -// When set to true, use UNKNOWN_LOCATION instead of CURRENT_LINE_NUMBER -extern void gg_set_current_line_number(int line_number); -extern int gg_get_current_line_number(); +extern location_t gg_token_location(); +extern location_t current_token_location(); +extern location_t current_location_minus_one(); +extern void current_location_minus_one_clear(); +extern void token_location_override(location_t loc); extern tree gg_trans_unit_var_decl(const char *var_name); diff --git a/gcc/cobol/genmath.cc b/gcc/cobol/genmath.cc index 0a1c12d..e7eb971 100644 --- a/gcc/cobol/genmath.cc +++ b/gcc/cobol/genmath.cc @@ -52,7 +52,8 @@ set_up_on_exception_label(cbl_label_t *arithmetic_label) if( !arithmetic_label->structs.arith_error ) { arithmetic_label->structs.arith_error - = (cbl_arith_error_t *)xmalloc(sizeof(struct cbl_arith_error_t) ); + = static_cast<cbl_arith_error_t *> + (xmalloc(sizeof(struct cbl_arith_error_t))); // Set up the address pairs for this clause gg_create_goto_pair(&arithmetic_label->structs.arith_error->over.go_to, &arithmetic_label->structs.arith_error->over.label); @@ -72,8 +73,8 @@ set_up_compute_error_label(cbl_label_t *compute_label) if( !compute_label->structs.compute_error ) { compute_label->structs.compute_error - = (cbl_compute_error_t *) - xmalloc(sizeof(struct cbl_compute_error_t) ); + = static_cast<cbl_compute_error_t *> + (xmalloc(sizeof(struct cbl_compute_error_t))); compute_label->structs.compute_error->compute_error_code = gg_define_int(0); } @@ -112,7 +113,6 @@ arithmetic_operation(size_t nC, cbl_num_result_t *C, { TRACE1_HEADER TRACE1_TEXT_ABC("calling ", operation, "") - TRACE1_END for(size_t ii=0; ii<nA; ii++) { TRACE1_INDENT @@ -129,7 +129,6 @@ arithmetic_operation(size_t nC, cbl_num_result_t *C, build_int_cst_type(SIZE_T, ii)); TRACE1_REFER("", B[ii], ""); } - TRACE1_END } // We need to split up cbl_num_result_t into two arrays, one for the refer_t @@ -223,7 +222,6 @@ arithmetic_operation(size_t nC, cbl_num_result_t *C, { for(size_t ii=0; ii<nC; ii++) { - break; // Breaks on ADD 1 SUB2 GIVING SUB4 both PIC S9(3) COMP TRACE1_INDENT gg_fprintf( trace_handle, 1, "result: C[%ld]: ", @@ -612,7 +610,7 @@ static bool fast_divide(size_t nC, cbl_num_result_t *C, size_t nA, cbl_refer_t *A, size_t nB, cbl_refer_t *B, - cbl_refer_t remainder) + const cbl_refer_t &remainder) { bool retval = false; if( all_results_binary(nC, C) ) @@ -663,8 +661,10 @@ fast_divide(size_t nC, cbl_num_result_t *C, // We now either divide into C[n] or assign dividend/divisor to C[n]: for(size_t i=0; i<nC; i++ ) { - tree dest_type = tree_type_from_size(C[i].refer.field->data.capacity, 0); - tree dest_addr = gg_add(member(C[i].refer.field->var_decl_node, "data"), + tree dest_type = + tree_type_from_size(C[i].refer.field->data.capacity, 0); + tree dest_addr = gg_add(member( C[i].refer.field->var_decl_node, + "data"), refer_offset(C[i].refer)); tree ptr = gg_cast(build_pointer_type(dest_type), dest_addr); if( nB ) @@ -680,16 +680,15 @@ fast_divide(size_t nC, cbl_num_result_t *C, } // This is where we handle any remainder, keeping in mind that for - // nB != 0, the actual dividend is in the value we have named "divisor". - // - // And, yes, I hate comments like that, too. + // nB != 0, the actual dividend is in the value we have named + // "divisor". // We calculate the remainder by calculating // dividend minus quotient * divisor if( remainder.field ) { - tree dest_addr = gg_add(member(remainder.field->var_decl_node, "data"), - refer_offset(remainder)); + dest_addr = gg_add( member(remainder.field->var_decl_node, "data"), + refer_offset(remainder)); dest_type = tree_type_from_size(remainder.field->data.capacity, 0); ptr = gg_cast(build_pointer_type(dest_type), dest_addr); diff --git a/gcc/cobol/genutil.cc b/gcc/cobol/genutil.cc index e09b1bf..a5f69a0 100644 --- a/gcc/cobol/genutil.cc +++ b/gcc/cobol/genutil.cc @@ -27,6 +27,9 @@ * (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE * OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. */ + +// cppcheck-suppress-file duplicateBreak + #include "cobol-system.h" #include "coretypes.h" #include "tree.h" @@ -305,9 +308,10 @@ static void get_and_check_refstart_and_reflen( tree refstart,// LONG returned value tree reflen, // LONG returned value - cbl_refer_t &refer) + const cbl_refer_t &refer) { - cbl_enabled_exceptions_t& enabled_exceptions( cdf_enabled_exceptions() ); + const cbl_enabled_exceptions_t& + enabled_exceptions( cdf_enabled_exceptions() ); if( !enabled_exceptions.match(ec_bound_ref_mod_e) ) { @@ -460,7 +464,8 @@ get_depending_on_value_from_odo(tree retval, cbl_field_t *odo) declarative with a RESUME NEXT STATEMENT, or before the default_condition processing can do a controlled exit. */ - cbl_enabled_exceptions_t& enabled_exceptions( cdf_enabled_exceptions() ); + const cbl_enabled_exceptions_t& + enabled_exceptions( cdf_enabled_exceptions() ); cbl_field_t *depending_on; depending_on = cbl_field_of(symbol_at(odo->occurs.depending_on)); @@ -474,8 +479,8 @@ get_depending_on_value_from_odo(tree retval, cbl_field_t *odo) return; } - // Bounds checking is enabled, so we test the DEPENDING ON value to be between - // the lower and upper OCCURS limits: + // Bounds checking is enabled, so we test the DEPENDING ON value to be + // between the lower and upper OCCURS limits: get_integer_value(retval, depending_on, NULL, @@ -485,23 +490,28 @@ get_depending_on_value_from_odo(tree retval, cbl_field_t *odo) { // This needs to evaluate to an integer set_exception_code(ec_bound_odo_e); - gg_assign(retval, build_int_cst_type(TREE_TYPE(retval), odo->occurs.bounds.lower)); + gg_assign(retval, build_int_cst_type( TREE_TYPE(retval), + odo->occurs.bounds.lower)); gg_assign(var_decl_rdigits, integer_zero_node); } ELSE ENDIF - IF( retval, gt_op, build_int_cst_type(TREE_TYPE(retval), odo->occurs.bounds.upper) ) + IF( retval, gt_op, build_int_cst_type(TREE_TYPE(retval), + odo->occurs.bounds.upper) ) { set_exception_code(ec_bound_odo_e); - gg_assign(retval, build_int_cst_type(TREE_TYPE(retval), odo->occurs.bounds.lower)); + gg_assign(retval, build_int_cst_type( TREE_TYPE(retval), + odo->occurs.bounds.lower)); } ELSE { - IF( retval, lt_op, build_int_cst_type(TREE_TYPE(retval), odo->occurs.bounds.lower) ) + IF( retval, lt_op, build_int_cst_type(TREE_TYPE(retval), + odo->occurs.bounds.lower) ) { set_exception_code(ec_bound_odo_e); - gg_assign(retval, build_int_cst_type(TREE_TYPE(retval), odo->occurs.bounds.lower)); + gg_assign(retval, build_int_cst_type( TREE_TYPE(retval), + odo->occurs.bounds.lower)); } ELSE ENDIF @@ -535,8 +545,8 @@ get_depending_on_value(tree retval, const cbl_refer_t &refer) static tree -get_data_offset(cbl_refer_t &refer, - int *pflags = NULL) +get_data_offset(const cbl_refer_t &refer, + int *pflags = NULL) { Analyze(); // This routine returns a tree which is the size_t offset to the data in the @@ -551,7 +561,6 @@ get_data_offset(cbl_refer_t &refer, // We have a refer. // At the very least, we have an constant offset int all_flags = 0; - int all_flag_bit = 1; if( refer.nsubscript() ) { @@ -571,6 +580,7 @@ get_data_offset(cbl_refer_t &refer, // Establish the field_t pointer for walking up through our ancestors: cbl_field_t *parent = refer.field; + int all_flag_bit = 1; // Note the backwards test, because refer->nsubscript is an unsigned value for(size_t i=refer.nsubscript()-1; i<refer.nsubscript(); i-- ) { @@ -604,7 +614,8 @@ get_data_offset(cbl_refer_t &refer, } else { - cbl_enabled_exceptions_t& enabled_exceptions( cdf_enabled_exceptions() ); + const cbl_enabled_exceptions_t& + enabled_exceptions( cdf_enabled_exceptions() ); if( !enabled_exceptions.match(ec_bound_subscript_e) ) { // With no exception testing, just pick up the value @@ -629,21 +640,25 @@ get_data_offset(cbl_refer_t &refer, } ELSE { - IF( subscript, lt_op, gg_cast(TREE_TYPE(subscript), integer_one_node) ) + IF( subscript, lt_op, gg_cast(TREE_TYPE(subscript), + integer_one_node) ) { // The subscript is too small set_exception_code(ec_bound_subscript_e); - gg_assign(subscript, build_int_cst_type(TREE_TYPE(subscript), 1)); + gg_assign(subscript, build_int_cst_type(TREE_TYPE(subscript), + 1)); } ELSE { IF( subscript, ge_op, - build_int_cst_type(TREE_TYPE(subscript), parent->occurs.ntimes()) ) + build_int_cst_type( TREE_TYPE(subscript), + parent->occurs.ntimes()) ) { // The subscript is too large set_exception_code(ec_bound_subscript_e); - gg_assign(subscript, build_int_cst_type(TREE_TYPE(subscript), 1)); + gg_assign(subscript, build_int_cst_type(TREE_TYPE(subscript), + 1)); } ELSE { @@ -658,16 +673,19 @@ get_data_offset(cbl_refer_t &refer, all_flag_bit <<= 1; - // Although we strictly don't need to look at the ODO value at this point, - // we do want it checked for the purposes of ec-bound-odo + // Although we strictly don't need to look at the ODO value at this + // point, we do want it checked for the purposes of ec-bound-odo - cbl_enabled_exceptions_t& enabled_exceptions( cdf_enabled_exceptions() ); + const cbl_enabled_exceptions_t& + enabled_exceptions( cdf_enabled_exceptions() ); if( enabled_exceptions.match(ec_bound_odo_e) ) { if( parent->occurs.depending_on ) { - static tree value64 = gg_define_variable(LONG, ".._gdos_value64", vs_file_static); + static tree value64 = gg_define_variable( LONG, + ".._gdos_value64", + vs_file_static); cbl_field_t *odo = symbol_find_odo(parent); get_depending_on_value_from_odo(value64, odo); } @@ -1244,18 +1262,13 @@ get_binary_value( tree value, break; } - case FldAlphanumeric: - { - - } - - default: { - fprintf(stderr, "%s(): We know not how to" - " get a binary value from %s\n", - __func__, - cbl_field_type_str(field->type) ); + char *err = xasprintf("%s(): We know not how to" + " get a binary value from %s\n", + __func__, + cbl_field_type_str(field->type) ); + cbl_internal_error("%s", err); abort(); break; } @@ -1673,9 +1686,9 @@ set_exception_code_func(ec_type_t ec, int /*line*/, int from_raise_statement) } bool -process_this_exception(ec_type_t ec) +process_this_exception(const ec_type_t ec) { - cbl_enabled_exceptions_t& enabled_exceptions( cdf_enabled_exceptions() ); + const cbl_enabled_exceptions_t& enabled_exceptions( cdf_enabled_exceptions() ); bool retval; if( enabled_exceptions.match(ec) || !skip_exception_processing ) { @@ -1707,7 +1720,7 @@ copy_little_endian_into_place(cbl_field_t *dest, tree value, int rhs_rdigits, bool check_for_error, - tree &size_error) + const tree &size_error) { if( check_for_error ) { @@ -1933,7 +1946,7 @@ get_literal_string(cbl_field_t *field) } bool -refer_is_clean(cbl_refer_t &refer) +refer_is_clean(const cbl_refer_t &refer) { if( !refer.field || refer.field->type == FldLiteralN ) { @@ -1964,7 +1977,7 @@ refer_is_clean(cbl_refer_t &refer) */ static tree // size_t -refer_refmod_length(cbl_refer_t &refer) +refer_refmod_length(const cbl_refer_t &refer) { Analyze(); REFER("refstart and reflen"); @@ -1980,7 +1993,7 @@ refer_refmod_length(cbl_refer_t &refer) static tree // size_t -refer_fill_depends(cbl_refer_t &refer) +refer_fill_depends(const cbl_refer_t &refer) { REFER(""); // This returns a positive number which is the amount a depends-limited @@ -2007,8 +2020,8 @@ refer_fill_depends(cbl_refer_t &refer) } tree // size_t -refer_offset(cbl_refer_t &refer, - int *pflags) +refer_offset(const cbl_refer_t &refer, + int *pflags) { // This routine calculates the effect of a refer offset on the // refer.field->data location. When there are subscripts, the data location @@ -2035,7 +2048,7 @@ refer_offset(cbl_refer_t &refer, static tree // size_t -refer_size(cbl_refer_t &refer, refer_type_t refer_type) +refer_size(const cbl_refer_t &refer, refer_type_t refer_type) { Analyze(); static tree retval = gg_define_variable(SIZE_T, "..rs_retval", vs_file_static); @@ -2076,13 +2089,13 @@ refer_size(cbl_refer_t &refer, refer_type_t refer_type) } tree // size_t -refer_size_dest(cbl_refer_t &refer) +refer_size_dest(const cbl_refer_t &refer) { return refer_size(refer, refer_dest); } tree // size_t -refer_size_source(cbl_refer_t &refer) +refer_size_source(const cbl_refer_t &refer) { /* There are oddities involved with refer_size_source and refer_size_dest. See the comments in refer_has_depends for some explanation. There are @@ -2119,7 +2132,7 @@ refer_size_source(cbl_refer_t &refer) } tree -qualified_data_location(cbl_refer_t &refer) +qualified_data_location(const cbl_refer_t &refer) { return gg_add(member(refer.field->var_decl_node, "data"), refer_offset(refer)); diff --git a/gcc/cobol/genutil.h b/gcc/cobol/genutil.h index 0d9028e..f12124e 100644 --- a/gcc/cobol/genutil.h +++ b/gcc/cobol/genutil.h @@ -118,7 +118,7 @@ void set_exception_code_func(ec_type_t ec, int line, int from_raise_statement=0); #define set_exception_code(ec) set_exception_code_func(ec, __LINE__) -bool process_this_exception(ec_type_t ec); +bool process_this_exception(const ec_type_t ec); #define CHECK_FOR_FRACTIONAL_DIGITS true void get_integer_value(tree value, // This is always a LONG cbl_field_t *field, @@ -130,7 +130,7 @@ void copy_little_endian_into_place(cbl_field_t *dest, tree value, int rhs_rdigits, bool check_for_error, - tree &size_error); + const tree &size_error); tree build_array_of_size_t( size_t N, const size_t *values); void parser_display_internal_field(tree file_descriptor, @@ -138,14 +138,14 @@ void parser_display_internal_field(tree file_descriptor, bool advance=DISPLAY_NO_ADVANCE); char *get_literal_string(cbl_field_t *field); -bool refer_is_clean(cbl_refer_t &refer); +bool refer_is_clean(const cbl_refer_t &refer); -tree refer_offset(cbl_refer_t &refer, +tree refer_offset(const cbl_refer_t &refer, int *pflags=NULL); -tree refer_size_source(cbl_refer_t &refer); -tree refer_size_dest(cbl_refer_t &refer); +tree refer_size_source(const cbl_refer_t &refer); +tree refer_size_dest(const cbl_refer_t &refer); -tree qualified_data_location(cbl_refer_t &refer); +tree qualified_data_location(const cbl_refer_t &refer); void build_array_of_treeplets( int ngroup, size_t N, diff --git a/gcc/cobol/lexio.cc b/gcc/cobol/lexio.cc index 0aebe52..52d1aff 100644 --- a/gcc/cobol/lexio.cc +++ b/gcc/cobol/lexio.cc @@ -344,7 +344,7 @@ check_push_pop_directive( filespan_t& mfile ) { std::swap(*mfile.eol, eol); // see implementation for excuses bool ok = regex_search(p, const_cast<const char *>(mfile.eol), cm, re); std::swap(*mfile.eol, eol); - + if( ok ) { gcc_assert(cm.size() > 1); bool push = TOUPPER(cm[1].first[1]) == 'U'; @@ -400,7 +400,7 @@ check_source_format_directive( filespan_t& mfile ) { std::swap(*mfile.eol, eol); // see implementation for excuses bool ok = regex_search(p, const_cast<const char *>(mfile.eol), cm, re); std::swap(*mfile.eol, eol); - + if( ok ) { gcc_assert(cm.size() > 1); switch( cm[3].length() ) { @@ -417,7 +417,7 @@ check_source_format_directive( filespan_t& mfile ) { dbgmsg( "%s:%d: %s format set, on line " HOST_SIZE_T_PRINT_UNSIGNED, __func__, __LINE__, - cdf_source_format().description(), + cdf_source_format().description(), (fmt_size_t)mfile.lineno() ); char *bol = cdf_source_format().is_fixed()? mfile.cur : const_cast<char*>(cm[0].first); gcc_assert(cm[0].second <= mfile.eol); @@ -941,7 +941,7 @@ location_in( const filespan_t& mfile, const csub_match& cm ) { gcc_assert(mfile.cur <= cm.first && cm.second <= mfile.eodata); auto nline = std::count(cm.first, cm.second, '\n'); if( nline ) { - gcc_assert(loc.first_line < nline); + gcc_assert(nline < loc.first_line); loc.first_line -= nline; auto p = static_cast<const char*>(memrchr(cm.first, '\n', cm.length())); loc.last_column = (cm.second) - p; @@ -1379,13 +1379,13 @@ lexer_input( char buf[], int max_size, FILE *input ) { for( auto p = mfile.cur; p < next; *output.pos++ = *p++ ) { static bool at_bol = false; if( at_bol ) { - auto nonblank = std::find_if( p, next, + auto nonblank_l = std::find_if( p, next, []( char ch ) { return !isblank(ch); } ); - if( nonblank + 1 < next ) { - if( *nonblank == '\r' ) nonblank++; // Windows - if( *nonblank == '\n' ) { - p = nonblank; + if( nonblank_l + 1 < next ) { + if( *nonblank_l == '\r' ) nonblank_l++; // Windows + if( *nonblank_l == '\n' ) { + p = nonblank_l; continue; } } @@ -1513,7 +1513,6 @@ cdftext::lex_open( const char filename[] ) { // Process any files supplied by the -include command-line option. for( auto name : included_files ) { - int input; if( -1 == (input = open(name, O_RDONLY)) ) { yyerrorvl(1, "", "cannot open -include file %s", name); continue; @@ -1686,7 +1685,7 @@ bool lexio_dialect_mf(); */ static const char * valid_sequence_area( const char *data, const char *eodata ) { - + for( const char *p = data; (p = std::find_if(p, eodata, is_p)) != eodata; p++ ) @@ -1709,7 +1708,7 @@ valid_sequence_area( const char *data, const char *eodata ) { } } } - return nullptr; + return nullptr; } /* @@ -1745,7 +1744,7 @@ cdftext::free_form_reference_format( int input ) { } current( mfile.data ); /* - * Infer source code format. + * Infer source code format. */ if( cdf_source_format().inference_pending() ) { const char *bol = valid_sequence_area(mfile.data, mfile.eodata); @@ -1904,7 +1903,7 @@ cdftext::process_file( filespan_t mfile, int output, bool second_pass ) { []( char ch ) { return ch == '\n'; } ); struct { int in, out; filespan_t mfile; } copy; dbgmsg("%s:%d: line " HOST_SIZE_T_PRINT_UNSIGNED ", opening %s on fd %d", - __func__, __LINE__,mfile.lineno(), + __func__, __LINE__, (fmt_size_t)mfile.lineno(), copybook.source(), copybook.current()->fd); copy.in = copybook.current()->fd; copy.mfile = free_form_reference_format( copy.in ); @@ -1983,15 +1982,15 @@ cdftext::segment_line( filespan_t& mfile ) { struct { unsigned long ante, post; } lineno = { gb4(mfile.lineno()), gb4(mfile.lineno() + segment.after.nlines()) }; - char *directive = lineno.ante == lineno.post? + const char *directive = lineno.ante == lineno.post? nullptr : xasprintf("\n#line %lu \"%s\"\n", lineno.ante, cobol_filename()); - if( directive ) + if( directive ) output.push_back( span_t(strlen(directive), directive) ); output.push_back( span_t(mfile.cur, segment.before.p) ); output.push_back( span_t(segment.after.p, segment.after.pend ) ); - if( directive ) + if( directive ) output.push_back( span_t(strlen(directive), directive) ); mfile.cur = const_cast<char*>(segment.before.pend); diff --git a/gcc/cobol/lexio.h b/gcc/cobol/lexio.h index eb41068..ba4ef0a 100644 --- a/gcc/cobol/lexio.h +++ b/gcc/cobol/lexio.h @@ -244,8 +244,8 @@ struct span_t { return span_t(output, eout); } const char * has_nul() const { - auto p = std::find(this->p, pend, '\0'); - return p != pend? p : NULL; + auto p_l = std::find(this->p, pend, '\0'); + return p_l != pend? p_l : NULL; } bool at_eol() const { diff --git a/gcc/cobol/parse.y b/gcc/cobol/parse.y index 83bffdf..fae96ed 100644 --- a/gcc/cobol/parse.y +++ b/gcc/cobol/parse.y @@ -801,6 +801,7 @@ %type <boolean> io_invalid read_eof write_eop global is_global anycase backward end_display + exh_changed exh_named %type <number> mistake globally first_last %type <io_mode> io_mode @@ -1012,7 +1013,9 @@ %right IF THEN ELSE SENTENCE ACCEPT ADD ALTER CALL CANCEL CLOSE COMPUTE CONTINUE - DELETE DISPLAY DIVIDE EVALUATE END EOP EXIT FILLER_kw + DELETE DISPLAY DIVIDE + EVALUATE END EOP EXIT + FILLER_kw GOBACK GOTO INITIALIZE INSPECT MERGE MOVE MULTIPLY OPEN OVERFLOW_kw PARAGRAPH PERFORM @@ -5052,6 +5055,7 @@ statement: error { | divide { $$ = DIVIDE; } | entry { $$ = ENTRY; } | evaluate { $$ = EVALUATE; } + | exhibit_stmt { $$ = EXHIBIT; } | exit { $$ = EXIT; } | free { $$ = FREE; } | go_to { $$ = GOTO; } @@ -5687,6 +5691,20 @@ disp_upon: device_name { } ; +exhibit_stmt: EXHIBIT exh_changed exh_named vargs { + statement_begin(@1, EXHIBIT); + std::vector<cbl_refer_t> args( $vargs->args.begin(), + $vargs->args.end() ); + parser_exhibit( $exh_changed, $exh_named, args ); + } + ; +exh_changed: %empty { $$ = false; } + | CHANGED { $$ = true; } + ; +exh_named: %empty { $$ = false; } + | NAMED { $$ = true; } + ; + divide: divide_impl end_divide { ast_divide($1); } | divide_cond end_divide { ast_divide($1); } ; @@ -7636,6 +7654,7 @@ perform_cond: UNTIL { parser_perform_conditional( &perform_current()->tgt); } perform_inline: perform_start statements END_PERFORM { location_set(@END_PERFORM); + parser_sleep(*cbl_refer_t::empty()); $$ = perform_current(); if( $perform_start == LOCATION ) { error_msg(@1, "LOCATION not valid with PERFORM Format 2"); @@ -7644,6 +7663,7 @@ perform_inline: perform_start statements END_PERFORM | perform_start END_PERFORM { location_set(@END_PERFORM); + parser_sleep(*cbl_refer_t::empty()); $$ = perform_current(); if( $perform_start == LOCATION ) { error_msg(@1, "LOCATION not valid with PERFORM Format 2"); @@ -10316,7 +10336,7 @@ intrinsic: function_udf if( p != NULL ) { auto loc = symbol_field_location(field_index(p->field)); error_msg(loc, "FUNCTION %qs has " - "inconsistent parameter type %zu (%qs)", + "inconsistent parameter type %td (%qs)", keyword_str($1), p - args.data(), name_of(p->field) ); YYERROR; } @@ -11788,7 +11808,7 @@ label_add( const YYLTYPE& loc, name, cbl_label_of(p)->name, cbl_label_of(p)->line); } } - struct cbl_label_t label = { type, parent, loc.last_line }; + struct cbl_label_t label = { type, parent, loc.first_line }; if( !namcpy(loc, label.name, name) ) return NULL; auto p = symbol_label_add(PROGRAM, &label); diff --git a/gcc/cobol/parse_ante.h b/gcc/cobol/parse_ante.h index fa06e6c..03cb0a0 100644 --- a/gcc/cobol/parse_ante.h +++ b/gcc/cobol/parse_ante.h @@ -103,7 +103,7 @@ void input_file_status_notify(); } \ location_dump("parse.c", __LINE__, "current", (Current)); \ input_file_status_notify(); \ - gcc_location_set( location_set(Current) ); \ + location_set(Current); \ } while (0) int yylex(void); @@ -3493,18 +3493,18 @@ goodnight_gracie() { // false after USE statement, to enter Declarative with EC intact. static bool statement_cleanup = true; +static YYLTYPE current_location; static void statement_epilog( int token ); const char * keyword_str( int token ); -static YYLTYPE current_location; - const YYLTYPE& cobol_location() { return current_location; } -static inline YYLTYPE +static inline void location_set( const YYLTYPE& loc ) { - return current_location = loc; + current_location = loc; + gcc_location_set(loc); } static void statement_begin( const YYLTYPE& loc, int token ); diff --git a/gcc/cobol/scan.l b/gcc/cobol/scan.l index 8b5dc25..ba4c044 100644 --- a/gcc/cobol/scan.l +++ b/gcc/cobol/scan.l @@ -89,6 +89,7 @@ EOL \r?\n BLANK_EOL [[:blank:]]*{EOL} BLANK_OEOL [[:blank:]]*{EOL}? +PICTURE [^[:space:]]+ DOTSEP [.]+[[:space:]] DOTEOL [[:blank:]]*[.]{BLANK_EOL} @@ -176,7 +177,7 @@ SIZE_ERROR (ON[[[:space:]]+)?SIZE[[:space:]]+ERROR VARTYPE NUMERIC|ALPHABETIC|ALPHABETIC_LOWER|ALPHABETIC_UPPER|DBCS|KANJI NAMTYP {NAME}|{VARTYPE} -NL [[:blank:]]*\r?\n[[:blank:]]* +NL [[:blank:]]*{EOL}[[:blank:]]* PUSH_FILE \f?[#]FILE{SPC}PUSH{SPC}[^\f]+\f POP_FILE \f?[#]FILE{SPC}POP\f @@ -965,7 +966,9 @@ USE({SPC}FOR)? { return USE; } return NUMSTR; } - PIC(TURE)?({SPC}IS)?[[:space:]]{BLANK_OEOL} { + PIC(TURE)?({SPC}IS)?{SPC}{PICTURE} { + auto pos = validate_picture(); + myless(pos); yy_push_state(picture); return PIC; } ANY { return ANY; } @@ -1147,7 +1150,7 @@ USE({SPC}FOR)? { return USE; } yy_push_state(hex_state); } N?X{nonseq} { dbgmsg("invalid hexadecimal value: %s", yytext); return NO_CONDITION; } - [[:blank:]]*\r?\n {} + [[:blank:]]*{EOL} {} WORKING-STORAGE{SPC}SECTION { return WORKING_STORAGE_SECT; } LOCAL-STORAGE{SPC}SECTION { return LOCAL_STORAGE_SECT; } @@ -1217,7 +1220,7 @@ USE({SPC}FOR)? { return USE; } {NP}V?/[,.]? { yylval.number = ndigit(yyleng); return picset(PIC_P); } {N9}*V/{N9}* { yylval.number = ndigit(yyleng - 1); return picset(NINEV); } {N9}/{N9}*[,.]? { yylval.number = ndigit(yyleng); return picset(NINES); } - P+/[,.]?\r?\n { yylval.number = yyleng; return picset(PIC_P); } + P+/[,.]?{EOL} { yylval.number = yyleng; return picset(PIC_P); } 1{1,31}/({COUNT}|[(]{NAME}[)]) { yy_push_state(picture_count); @@ -1316,7 +1319,7 @@ USE({SPC}FOR)? { return USE; } [""]{SPC}[&]{SPC}[""''] { if( yytext[yyleng - 1] == '\'' ) BEGIN(quoted1); } - [""]-{OSPC}(\r?\n{OSPC})+[""] /* continue ... */ + [""]-{OSPC}({EOL}{OSPC})+[""] /* continue ... */ [""] { char *s = xstrdup(tmpstring? tmpstring : "\0"); yylval.literal.set_data(strlen(s), s); @@ -1333,7 +1336,7 @@ USE({SPC}FOR)? { return USE; } ['']{SPC}[&]{SPC}[""''] { if( yytext[yyleng - 1] == '"' ) BEGIN(quoted2); } - ['']-{OSPC}(\r?\n{OSPC})+[''] /* continue ... */ + ['']-{OSPC}({EOL}{OSPC})+[''] /* continue ... */ [''] { char *s = xstrdup(tmpstring? tmpstring : "\0"); yylval.literal.set_data(strlen(s), s); @@ -1670,16 +1673,17 @@ B-SHIFT-RC p += 2; while( ISSPACE(*p) ) p++; cbl_name_t name2; - std::transform( p, p + sizeof(name2), name2, - []( char ch ) { - switch(ch) { - case '-': - case '_': return ch; - default: - if( ISALNUM(ch) ) return ch; - } - return '\0'; - } ); + const char *pend = p + sizeof(name2); + char *pout = name2; + while( p < pend ) { + char ch = *p++; + if( ISALNUM(ch) || ch == '-' || ch == '_' ) { + *pout++ = ch; + } else { + *pout++ = '\0'; + break; + } + } symbol_elem_t *e = symbol_file(PROGRAM, name2); /* * For NAME IN FILENAME, we want the parser to handle it. @@ -2040,7 +2044,7 @@ BASIS { yy_push_state(basis); return BASIS; } return symbol_file(PROGRAM, yytext)? FILENAME : NAME; } [[:blank:]]+ - \r?\n { yy_pop_state(); } + {EOL} { yy_pop_state(); } } <raising>{ @@ -2169,7 +2173,7 @@ BASIS { yy_push_state(basis); return BASIS; } <*>{DOTSEP} { return '.'; } <*>[().=*/+&-] { return *yytext; } <*>[[:blank:]]+ -<*>\r?\n +<*>{EOL} <*>{ {COMMA} diff --git a/gcc/cobol/scan_ante.h b/gcc/cobol/scan_ante.h index 6960739..31093a6 100644 --- a/gcc/cobol/scan_ante.h +++ b/gcc/cobol/scan_ante.h @@ -149,7 +149,7 @@ numstr_of( const char string[], radix_t radix = decimal_e ) { } auto nx = std::count_if(input, p, fisdigit); if( 36 < nx ) { - error_msg(yylloc, "significand of %s has more than 36 digits (%zu)", input, nx); + error_msg(yylloc, "significand of %s has more than 36 digits (%td)", input, nx); return NO_CONDITION; } @@ -490,7 +490,8 @@ trim_location( int nkeep) { (fmt_size_t)nline, (fmt_size_t)rescan.size()); if( nline ) { gcc_assert( yylloc.first_line + nline <= yylloc.last_line ); - yylloc.last_line =- int(nline); + yylloc.last_line -= int(nline); + gcc_assert( yylloc.first_line <= yylloc.last_line ); char *p = static_cast<char*>(memrchr(rescan.p, '\n', rescan.size())); yylloc.last_column = rescan.pend - ++p; return; @@ -608,7 +609,9 @@ static const std::map <std::string, bint_t > binary_integers { static int binary_integer_usage( const char name[]) { - cbl_name_t uname = {}; + // uname can't be cbl_name_t, because at this point name[] might have more + // than sizeof(cbl_name_t) characters. The length check comes later. + char *uname = xstrdup(name); std::transform(name, name + strlen(name), uname, ftoupper); dbgmsg("%s:%d: checking %s in %zu keyword_aliases", @@ -627,6 +630,7 @@ binary_integer_usage( const char name[]) { yylval.computational.signable = p->second.signable; dbgmsg("%s:%d: %s has type %d", __func__, __LINE__, uname, p->second.type ); + free(uname); return p->second.token; } @@ -693,6 +697,387 @@ picset( int token ) { return token; } +/** +## Script and data to produce picture_t::followers. +## Based on ISO Table 10. +#! /usr/bin/awk -f + +BEGIN { + str = "B0/ , . + +- +- CR/DB cs cs Z* Z* + + cs cs 9 AX S V P P 1 N E" + split(str, cols) +} + +$1 ~ /CR|DB|cs/ { next } + +0 && !nlines++ { + for( i=0; i < length(cols); i++ ) { + print i, cols[i], "'" $i "'" + } +} + +$field == "x" { + if( ! nout++ ) { + printf "%2d: %5s: \"", field, cols[field - 1] + } + + gsub(/^ +| +$/, "", $1) + printf "%s", $1 +} + +END { + if( ! nout++ ) { + printf "%2d: %5s: \"", field, cols[field - 1] + } + print "\"" +} + +B x x x - x - - x - x x x x x x x x - x - x - x +0 x x x - x - - x - x x x x x x x x - x - x - x +/ x x x - x - - x - x x x x x x x x - x - x - x +, x x x - x - - x - x x x x x x x - - x - x +. x x - - x - - x - x - x - x - x ++ - - - - - - - - - - - - - - - - - - - - - - - x ++ +– ++ x x x - - - - x x x x - - x x x - - x x x +CR x x x - - - - x x x x - - x x x - - x x x +DB x x x - - - - x x x x - - x x x - - x x x +cs - - - - x +cs x x x - x - - - - x x - - - - x - - x x x + +Z x x - - x - - x - x +* x x - - x - - x - x +Z x x x - x - - x - x x - - - - - - - x - x +* x x x - x - - x - x x - - - - - - - x - x ++ x x - - - - - x - - - x +– x x - - - - - x - - - x ++ x x x - - - - x - - - x x - - - - - x +– x x x - - - - x - - - x x - - - - - x +cs x x - - x - - - - - - - - x +cs x x x - x - - - - - - - - x x - - - x + +9 x x x x x - - x - x - x - x - x x x x - x - - x +A x - - - - - - - - - - - - - - x x +X x - - - - - - - - - - - - - - x x +S +V x x - - x - - x - x - x - x - x - x - x +P x x - - x - - x - x - x - x - x - x - x +P - - - - x - - x - - - - - - - - - x x - x +1 - - - - - - - - - - - - - - - - - - - - - x +N x - - - - - - - - - - - - - - - - - - - - - x +E x x x - x - - - - - - - - - - x +**/ + +class picture_t { + static const char dot = '.', comma = ','; + + typedef std::vector<std::string> followings_t; + static const std::map <char, followings_t> followers; + + const char * const begin; + const char *p, *pend; + size_t pos; + struct exclusions_t { // Nonzero if set, > 1 is false. + // crdb means CR/DB or +/-. + // pluses means 2 or more consecutive '+'. + // minuses means 2 or more consecutive '-'. + // "21) The symbol 'Z' and the symbol '*' are mutually exclusive " + // stars means '*' or Z. + unsigned short int crdb, currency, dot, pluses, minuses, stars, zzz; + exclusions_t() + : crdb(0), currency(0), dot(0), pluses(0), minuses(0), stars(0) + {} + } exclusions; + YYLTYPE loc; + + bool is_crdb() const { // input must be uppercase for CR/DB + if( p[0] == 'C' || p[0] == 'D' ) { + char input[3] = { p[0], p[1] }; + return ( 0 == strcmp(input, "CR") || 0 == strcmp(input, "DB") ); + } + return false; + } + + const char * match_paren( const char *paren ) const { + gcc_assert(paren[0] == '('); // start with opening paren + paren = std::find_if( paren, pend, + []( char ch ) { + return ch == '(' || ch == ')'; + } ); + if( *paren == '(' ) return nullptr; // no nesting + if( paren == pend ) return nullptr; + return ++paren; + } + + const char * next_not( char ch ) const { + return std::find_if( p, pend, + [ch = TOUPPER(ch)]( char next ) { + return ch != next; + } ); + } + + const char * valid_next( const char *p, const std::string& valid ) const { + if( p == pend || p + 1 == pend ) return pend; + if( p[1] == '(' ) { + return match_paren(++p); + } + auto pv = std::find(valid.begin(), valid.end(), TOUPPER(p[1])); + return pv != valid.end()? ++p : nullptr; + } + const char * valid_next( const char *p, + bool first = true, char ch = '\0' ) const { + if( p == pend || p + 1 == pend ) return pend; + if( p[0] == '(' ) { + if( (p = match_paren(p)) == nullptr ) return nullptr; + } + if( p[0] == '(' ) return nullptr; // consecutive parentheses + + int index = first? 0 : 1; + if( !ch ) ch = *p; // use current character unless overridden + auto valid = followers.find(TOUPPER(ch)); + if( valid == followers.end() ) { + YYLTYPE loc(yylloc); + loc.first_column += int(p - begin); + error_msg( loc, "PICTURE: strange character %qc, giving up", ch ); + return nullptr; + } + return valid_next(p, valid->second[index]); + } + + const char * start() { // start modifies exclusions, but not p + auto pnext = p; + + switch(TOUPPER(p[0])) { + case comma: case dot: + // use decimal_is_comma() + // 4: .: "B0/,+Z*+-9E" + exclusions.dot++; + pnext = valid_next(p, "B0/,+Z*+-9E"); + break; + case '+': case '-': + // 6: +-: "B0/,.Z*Z*9VPPE" + exclusions.crdb++; + pnext = next_not(p[0]); + if( p + 1 < pnext ) { + exclusions.pluses++; + } + pnext = valid_next(--pnext, "B0/,.Z*Z*9VPPE"); + break; + case 'Z': case '*': + exclusions.stars++; + pnext = next_not(p[0]); + break; + case 'S': + // 19: S: "9VP" + pnext = valid_next(p, "9VP"); + break; + } + + /* + * "For fixed editing sign control, the currency symbol, when used, shall + * be either the leftmost symbol in character-string-1, optionally preceded + * by one of the symbols '+' or '-' " + */ + if( pnext ) { + if( p == pnext || p[0] == '+' || p[0] == '-' ) { + if( symbol_currency(*pnext) ) { + exclusions.currency++; + pnext = next_not(*pnext); + pnext = valid_next(--pnext, true, '$'); + } + } + } + + return pnext; + } + + const char * next() { // modify state; do not modify position + auto pnext = p; + auto loc(picture_t::loc); + loc.first_column += int(p - begin); + + if( is_crdb() ) { + if( exclusions.crdb++ ) { + error_msg( loc, "PICTURE: CR/DB and %c/%c may appear only once", '+', '-' ); + return nullptr; + } + if( p + 2 != pend ) { + error_msg( loc, "PICTURE: CR/DB must appear at the end" ); + return nullptr; + } + return pend; + } + + if( symbol_currency(p[0]) ) { + if( false && exclusions.currency++ ) { // not enforced + error_msg( loc, "PICTURE: CURRENCY SYMBOL sequence may appear at most once" ); + return nullptr; + } + return valid_next(p, ! exclusions.dot, '$'); + } + + switch(TOUPPER(p[0])) { + case '(': + return match_paren(p); + break; + case 'B': case '0': case '/': + pnext = valid_next(p); + break; + case comma: + if( decimal_is_comma() ) { + if( exclusions.dot++ ) { + error_msg( loc, "PICTURE: %qc: may appear at most once", p[0] ); + return nullptr; + } + pnext = valid_next(p, true, dot); + } else { + pnext = valid_next(p); + } + break; + case dot: + if( p + 1 == pend ) { + pnext = pend; + } else { + if( decimal_is_comma() ) { + pnext = valid_next(p, true, comma ); + } else { + if( exclusions.dot++ ) { + error_msg( loc, "PICTURE: %qc: may appear at most once", p[0] ); + return nullptr; + } + pnext = valid_next(p); + } + } + break; + + case '+': case '-': + // 7 is trailing sign; 13 & 14 are numeric. Leading sign handled by start(). + if( p + 1 == pend ) { + if( exclusions.crdb++ ) { + error_msg( loc, "PICTURE: %c/%c may appear at most once as a sign", '+', '-' ); + return nullptr; + } + pnext = pend; + } else { + pnext = next_not(p[0]); + if( p + 1 < pnext ) { + if( false && exclusions.pluses++ ) { // not enforced + error_msg( loc, "PICTURE: %qc: sequence may appear at most once", p[0] ); + return nullptr; + } + } + pnext = valid_next(pnext, ! exclusions.dot); + } + break; + + case 'Z': case '*': + if( false && exclusions.stars++ ) { // not enforced + error_msg( loc, "PICTURE: %qc: sequence may appear at most once", p[0] ); + return nullptr; + } + if( (pnext = next_not(p[0])) == nullptr ) return pnext; + pnext = valid_next(pnext, ! exclusions.dot); + break; + case 'P': + pnext = valid_next(pnext, ! exclusions.dot); + break; + case '9': + case 'A': case 'X': + case 'V': + case '1': + case 'N': + pnext = valid_next(p); + break; + case 'E': + pnext = valid_next(p, "+9"); + if( pnext && *pnext == '+' ) { + pnext = valid_next(p, "9"); + } + break; + default: + error_msg( loc, "PICTURE: %qc: invalid character", p[0] ); + return nullptr; + } + return pnext; + } + + public: + picture_t( const char *p, int len ) + : begin(p) + , p(p), pend(p + len) + , loc(yylloc) + { + assert(TOUPPER(*p) == 'P'); // as in PICTURE (or PICTURE IS) + // move p to start of picture string + while( (p = std::find_if(p, pend, fisspace)) != pend ) { + this->p = p = std::find_if(p, pend, + []( char ch ) { return ! fisspace(ch); } ); + } + assert(this->p != pend); + pos = this->p - begin; + } + + bool is_valid() { + if( !p ) return false; + if( (p = start()) == nullptr ) { + return false; + } + + while( p && p < pend) { + p = next(); + } + return p == pend; + } + + int starts_at() const { return pos; } +}; + +/* + * The Followers map gives 1 or 2 lists of valid characters following a + * character, the one in the key. If there are two lists, the correct one is + * determined by the caller based on the state of the picture string, i.e., + * what has been seen before. + */ +const std::map <char, picture_t::followings_t> picture_t::followers { + /* B0/ */ { 'B', {"B0/,.Z*+-9AXVPNE" } }, + /* B0/ */ { '0', {"B0/,.Z*+-9AXVPNE" } }, + /* B0/ */ { '/', {"B0/,.Z*+-9AXVPNE" } }, + /* , */ { ',', {"B0/,.Z*+-9VPE"} }, + /* . */ { '.', {"B0/,Z*+-9E"} }, + /* + { '+', "9" }, */ + /* +- */ { '+', {"B0/,.Z*9VPE", "" } }, + /* +- */ { '-', {"B0/,.Z*9VPE", "" } }, + /* CR/DB { 'C', "" }, */ + /* cs { 'c', "B0/,.Z*+-9VP" }, */ + /* cs { 'c', "+" }, */ + /* Z* */ { 'Z', {"B0/,.+Z*9VP", "B0/,+Z*"} }, + /* Z* */ { '*', {"B0/,.+Z*9VP", "B0/,+Z*"} }, + /* + */ { '+', {"B0/,.+-9VP", "B0/,+-"} }, + /* cs */ { '$', {"B0/,.+9VP", "B0/,+"} }, + /* 9 */ { '9', {"B0/,.+9AXVPE"} }, + /* AX */ { 'A', {"B0/9AX"} }, + /* AX */ { 'X', {"B0/9AX"} }, + /* S */ { 'S', {"9VP"} }, + /* V */ { 'V', {"B0/,+Z*+-9P"} }, + /* P */ { 'P', {"+VP", "B0/,+Z*9P"} }, + /* 1 */ { '1', {"1"} }, + /* N */ { 'N', {"B0/N"} }, + /* E */ { 'E', {"+9"} }, +}; + +/* + * Although picture_t::is_valid return a bool, it's not used. The validation + * routines emit messages where the error is detected. The entire string is + * subsequently parsed by the parser, which might otherwise accept an invalid + * string, but will usually emit a message of its own. + */ +static int +validate_picture() { + picture_t picture(yytext, yyleng); + picture.is_valid(); + return picture.starts_at(); +} + static inline bool is_integer_token( int *pvalue = NULL ) { int v, n = 0; diff --git a/gcc/cobol/show_parse.h b/gcc/cobol/show_parse.h index db24807..bd0e16f 100644 --- a/gcc/cobol/show_parse.h +++ b/gcc/cobol/show_parse.h @@ -176,11 +176,21 @@ extern bool cursor_at_sol; } \ else \ { \ - fprintf(stderr, " %p:%s (%s)", (void*)b, b->name, b->type_str()); \ + fprintf(stderr, " %p:%s (%s)", static_cast<void*>(b), b->name, b->type_str()); \ } \ show_parse_sol = false; \ } while(0); +// Use this version when b is known to be valid. This is necessary to quiet +// cppcheck nullPointerRedundantCheck warnings +#define SHOW_PARSE_LABEL_OK(a, b) \ + do \ + { \ + fprintf(stderr, "%s", a); \ + fprintf(stderr, " %p:%s (%s)", static_cast<void*>(b), b->name, b->type_str()); \ + show_parse_sol = false; \ + } while(0); + #define TRACE1 if(bTRACE1) #define TRACE1_HEADER do \ { \ @@ -211,6 +221,7 @@ extern bool cursor_at_sol; #define TRACE1_FIELD_VALUE(a, field, b) \ do \ { \ + gcc_assert(field); \ cursor_at_sol=false; \ if ( field->type == FldConditional ) \ { \ @@ -423,13 +434,39 @@ extern bool cursor_at_sol; } while(0); // Use CHECK_FIELD when a should be non-null, and a->var_decl_node also should -// by non-null: +// by non-null. (The useless calls to abort() are because cppcheck doesn't +// understand that gcc_unreachable doesn't return); + +// Use this after doing any SHOW_PARSE stuff, to avoid cppcheck complaints +// about nullPointerRedundantCheck #define CHECK_FIELD(a) \ - do { \ + do { \ if(!a) \ { \ - yywarn("%s: parameter %<" #a "%> is NULL", __func__); \ + yywarn("%s: parameter %<" #a "%> is NULL", __func__); \ gcc_unreachable(); \ + abort(); \ + } \ + if( !a->var_decl_node ) \ + { \ + yywarn("%s: parameter %<" #a "%> is variable " \ + "%s<%s> with NULL %<var_decl_node%>", \ + __func__, \ + a->name, \ + cbl_field_type_str(a->type) ); \ + gcc_unreachable(); \ + abort(); \ + } \ + } while(0); + +// This version is a bit more lax, for special cases +#define CHECK_FIELD2(a) \ + do { \ + if(!a) \ + { \ + yywarn("%s: parameter %<" #a "%> is NULL", __func__); \ + gcc_unreachable(); \ + abort(); \ } \ if( !a->var_decl_node && a->type != FldConditional && a->type != FldLiteralA) \ { \ @@ -439,15 +476,18 @@ extern bool cursor_at_sol; a->name, \ cbl_field_type_str(a->type) ); \ gcc_unreachable(); \ + abort(); \ } \ } while(0); + #define CHECK_LABEL(a) \ do{ \ if(!a) \ { \ yywarn("%s: parameter %<" #a "%> is NULL", __func__); \ gcc_unreachable(); \ + abort(); \ } \ }while(0); @@ -504,6 +544,7 @@ class ANALYZE } }; #else +// cppcheck-suppress ctuOneDefinitionRuleViolation class ANALYZE { public: diff --git a/gcc/cobol/symbols.cc b/gcc/cobol/symbols.cc index 4b34729..f2cd1b5 100644 --- a/gcc/cobol/symbols.cc +++ b/gcc/cobol/symbols.cc @@ -28,6 +28,8 @@ * OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. */ +// cppcheck-suppress-file duplicateBreak + #include "config.h" #include <fstream> // Before cobol-system because it uses poisoned functions #include "cobol-system.h" @@ -672,7 +674,7 @@ symbol_special( size_t program, const char name[] ) struct symbol_elem_t * symbol_alphabet( size_t program, const char name[] ) { - cbl_alphabet_t alphabet(YYLTYPE(), custom_encoding_e); + cbl_alphabet_t alphabet(YYLTYPE(), custom_encoding_e); // cppcheck-suppress syntaxError assert(strlen(name) < sizeof alphabet.name); strcpy(alphabet.name, name); @@ -931,7 +933,7 @@ end_of_group( size_t igroup ) { if( e->program != group->program ) return isym; if( e->type == SymLabel ) return isym; // end of data division if( e->type == SymField ) { - const auto f = cbl_field_of(e); + const cbl_field_t * f = cbl_field_of(e); if( f->level == LEVEL77 || f->level == 66 ) return isym; if( f->level == 1 && f->parent != igroup ) { return isym; @@ -1174,7 +1176,7 @@ static struct symbol_elem_t * // If an 01 record exists for the FD/SD, use its capacity as the // default_record capacity. if( p != symbols_end() ) { - const auto record = cbl_field_of(p); + const cbl_field_t * record = cbl_field_of(p); assert(record->level == 1); e = calculate_capacity(p); auto record_size = std::max(record->data.memsize, @@ -1262,7 +1264,7 @@ static struct symbol_elem_t * // If group has a parent that is a record area, expand it, too. if( 0 < group->parent ) { - auto redefined = symbol_redefines(group); + redefined = symbol_redefines(group); if( redefined && is_record_area(redefined) ) { if( redefined->data.capacity < group->data.memsize ) { redefined->data.capacity = group->data.memsize; @@ -1434,11 +1436,11 @@ cbl_field_t::attr_str( const std::vector<cbl_field_attr_t>& attrs ) const const char *sep = ""; char *out = NULL; - for( auto attr : attrs ) { + for( auto attr_l : attrs ) { char *part = out; - if( has_attr(attr) ) { + if( has_attr(attr_l) ) { int erc = asprintf(&out, "%s%s%s", - part? part : "", sep, cbl_field_attr_str(attr)); + part? part : "", sep, cbl_field_attr_str(attr_l)); if( -1 == erc ) return part; free(part); sep = ", "; @@ -1745,7 +1747,7 @@ symbols_update( size_t first, bool parsed_ok ) { bool size_invalid = field->data.memsize > 0 && symbol_redefines(field); if( size_invalid ) { // redefine of record area is ok - const auto redefined = symbol_redefines(field); + const cbl_field_t * redefined = symbol_redefines(field); size_invalid = ! is_record_area(redefined); } if( !field->is_valid() || size_invalid ) @@ -1828,7 +1830,7 @@ symbols_update( size_t first, bool parsed_ok ) { } // Verify REDEFINing field has no ODO components - const auto parent = symbol_redefines(field); + const cbl_field_t * parent = symbol_redefines(field); if( parent && !is_record_area(parent) && is_variable_length(field) ) { ERROR_FIELD(field, "line %d: REDEFINES field %s cannot be variable length", field->line, field->name); @@ -2470,7 +2472,7 @@ symbol_typedef_add( size_t program, struct cbl_field_t *field ) { auto e = symbols_end() - 1; assert( symbols_begin() < e ); if( e->type == SymField ) { - const auto f = cbl_field_of(e); + const cbl_field_t * f = cbl_field_of(e); if( f == field ) return e; } @@ -2520,7 +2522,8 @@ symbol_field_add( size_t program, struct cbl_field_t *field ) if( is_numeric(parent->usage) && parent->data.capacity > 0 ) { field->type = parent->usage; field->data = parent->data; - field->data = 0; + field->data = 0; // cppcheck-suppress redundantAssignment + // // cppcheck doesn't understand multiple overloaded operator= field->data.initial = NULL; } } @@ -3144,7 +3147,6 @@ static cbl_field_t * new_temporary_impl( enum cbl_field_type_t type, const cbl_name_t name = nullptr ) { extern int yylineno; - static int nstack, nliteral; static const struct cbl_field_t empty_alpha = { 0, FldAlphanumeric, FldInvalid, intermediate_e, 0, 0, 0, nonarray, 0, "", @@ -3213,8 +3215,10 @@ new_temporary_impl( enum cbl_field_type_t type, const cbl_name_t name = nullptr f->line = yylineno; if( is_literal(type) ) { + static int nliteral = 0; snprintf(f->name, sizeof(f->name), "_literal%d",++nliteral); } else { + static int nstack = 0; snprintf(f->name, sizeof(f->name), "_stack%d",++nstack); } @@ -3728,6 +3732,12 @@ symbol_label_add( size_t program, cbl_label_t *input ) bool symbol_label_section_exists( size_t eval_label_index ) { auto eval = symbols_begin(eval_label_index); + /* cppcheck warns that the following statement depends on the order of + evaluation of side effects. Since this isn't my code, and since I don't + think the warning can be eliminated without rewriting it, I am just + supprressing it. + -- Bob Dubner, 2025-07-14 */ + // cppcheck-suppress unknownEvaluationOrder bool has_section = std::any_of( ++eval, symbols_end(), [program = eval->program]( const auto& sym ) { if( program == sym.program && sym.type == SymLabel ) { @@ -4187,7 +4197,7 @@ symbol_program_callables( size_t program ) { if( e->type != SymLabel ) continue; if( e->elem.label.type != LblProgram ) continue; - const auto prog = cbl_label_of(e); + const cbl_label_t * prog = cbl_label_of(e); if( program == symbol_index(e) && !prog->recursive ) continue; if( (self->parent == prog->parent && prog->common) || @@ -4241,6 +4251,11 @@ symbol_currency( char sign ) { if( currencies.size() == 0 ) { currencies['$'] = "$"; } + if( sign == '\0' ) { // default + auto result = currencies.begin(); + gcc_assert(result != currencies.end()); + return result->second; + } auto result = currencies.find(sign); return result == currencies.end()? NULL : result->second; } @@ -4658,9 +4673,11 @@ file_status_status_of( file_status_t status ) { size_t n = COUNT_OF(file_status_fields); const file_status_field_t *fs, key { status }; - fs = (file_status_field_t*)lfind( &key, file_status_fields, - &n, sizeof(*fs), cbl_file_status_cmp ); - + fs = static_cast<file_status_field_t*>(lfind( &key, + file_status_fields, + &n, + sizeof(*fs), + cbl_file_status_cmp )); return fs? (long)fs->status : -1; } diff --git a/gcc/cobol/symbols.h b/gcc/cobol/symbols.h index c3de0aa..c8ae32f 100644 --- a/gcc/cobol/symbols.h +++ b/gcc/cobol/symbols.h @@ -2613,7 +2613,7 @@ symbol_field_same_as( cbl_field_t *tgt, const cbl_field_t *src ); size_t symbol_file_same_record_area( std::list<cbl_file_t*>& files ); bool symbol_currency_add( const char symbol[], const char sign[] = NULL ); -const char * symbol_currency( char symbol ); +const char * symbol_currency( char symbol = '\0' ); const char * symbol_type_str( enum symbol_type_t type ); const char * cbl_field_type_str( enum cbl_field_type_t type ); diff --git a/gcc/cobol/symfind.cc b/gcc/cobol/symfind.cc index c04bb0f..8141b22 100644 --- a/gcc/cobol/symfind.cc +++ b/gcc/cobol/symfind.cc @@ -48,7 +48,7 @@ extern int yydebug; static bool is_data_field( symbol_elem_t& e ) { if( e.type != SymField ) return false; - const auto f = cbl_field_of(&e); + const cbl_field_t *f = cbl_field_of(&e); if( f->name[0] == '\0' ) return false; if( is_filler(f) ) return false; @@ -129,7 +129,7 @@ finalize_symbol_map2() { for( auto& elem : symbol_map2 ) { auto& fields( elem.second ); fields.remove_if( []( auto isym ) { - const auto f = cbl_field_of(symbol_at(isym)); + const cbl_field_t *f = cbl_field_of(symbol_at(isym)); return f->type == FldInvalid; } ); if( fields.empty() ) empties.insert(elem.first); @@ -316,9 +316,9 @@ public: if( p != item.second.end() ) { // Preserve symbol's index at front of ancestor list. symbol_map_t::mapped_type shorter(1 + ancestors->size()); - auto p = shorter.begin(); - *p = item.second.front(); - shorter.insert( ++p, ancestors->begin(), ancestors->end() ); + auto p_l = shorter.begin(); + *p_l = item.second.front(); + shorter.insert( ++p_l, ancestors->begin(), ancestors->end() ); return make_pair(item.first, shorter); } } @@ -341,7 +341,7 @@ class in_scope { size_t program; static size_t prog_of( size_t program ) { - const auto L = cbl_label_of(symbol_at(program)); + const cbl_label_t *L = cbl_label_of(symbol_at(program)); return L->parent; } @@ -430,7 +430,7 @@ symbol_match2( size_t program, auto plist = symbol_map2.find(key); if( plist != symbol_map2.end() ) { for( auto candidate : plist->second ) { - const auto e = symbol_at(candidate); + const symbol_elem_t *e = symbol_at(candidate); if( name_has_names( e, names, local ) ) { fields.push_back( symbol_index(e) ); } diff --git a/gcc/cobol/util.cc b/gcc/cobol/util.cc index c85b4cb..aed9483 100644 --- a/gcc/cobol/util.cc +++ b/gcc/cobol/util.cc @@ -47,15 +47,7 @@ #include <intl.h> #include <backtrace.h> #include <diagnostic.h> -#include <diagnostic-color.h> -#include <diagnostic-url.h> -#include <diagnostic-metadata.h> -#include <diagnostic-path.h> -#include <edit-context.h> -#include <selftest.h> -#include <selftest-diagnostic.h> #include <opts.h> - #include "util.h" #include "cbldiag.h" @@ -93,7 +85,7 @@ static inline char * get_current_dir_name () { /* Use libiberty's allocator here. */ - char *buf = (char *) xmalloc (PATH_MAX); + char *buf = static_cast<char *>(xmalloc (PATH_MAX)); return getcwd (buf, PATH_MAX); } #endif @@ -101,7 +93,7 @@ get_current_dir_name () /* * For printing messages, usually the size of the thing is some kind of string * length, and doesn't really need a size_t. For message formatting, use a - * simple unsigned long, and warn if that's no good. "gb4" here stands for + * simple unsigned long, and warn if that's no good. "gb4" here stands for * "4 Gigabytes". */ unsigned long @@ -113,7 +105,7 @@ gb4( size_t input ) { } return input; } - + /* * Most CDF Directives -- those that have state -- can be pushed and popped. * This class maintains stacks of them, with each stack having a "default @@ -140,20 +132,20 @@ gb4( size_t input ) { * PAGE * PROPAGATE * REF-MOD-ZERO-LENGTH - * - * >>PUSH ALL calls the class's push() method. - * >>POP ALL calls the class's pop() method. + * + * >>PUSH ALL calls the class's push() method. + * >>POP ALL calls the class's pop() method. */ class cdf_directives_t { template <typename T> - class cdf_stack_t : private std::stack<T> { + class cdf_stack_t : private std::stack<T> { // cppcheck-suppress noConstructor T default_value; const T& top() const { return std::stack<T>::top(); } bool empty() const { return std::stack<T>::empty(); } public: void value( const T& value ) { - T& output( empty()? default_value : std::stack<T>::top() ); + T& output( empty()? default_value : std::stack<T>::top() ); // cppcheck-suppress constVariableReference output = value; dbgmsg("cdf_directives_t::%s: %s", __func__, str(output).c_str()); } @@ -166,7 +158,7 @@ class cdf_directives_t } void pop() { if( empty() ) { - error_msg(YYLTYPE(), "CDF stack empty"); + error_msg(YYLTYPE(), "CDF stack empty"); // cppcheck-suppress syntaxError return; } default_value = top(); @@ -190,7 +182,6 @@ class cdf_directives_t static std::string str(cbl_enabled_exceptions_t) { return "<enabled_exceptions>"; } - }; public: @@ -203,7 +194,7 @@ class cdf_directives_t cdf_directives_t() { call_convention.value() = cbl_call_cobol_e; } - + void push() { call_convention.push(); cobol_words.push(); @@ -995,7 +986,7 @@ cbl_field_t::report_invalid_initial_value(const YYLTYPE& loc) const { // 8 or more, we need do no further testing because we assume // everything fits. if( data.capacity < 8 ) { - const auto p = strchr(data.initial, symbol_decimal_point()); + const char *p = strchr(data.initial, symbol_decimal_point()); if( p && atoll(p+1) != 0 ) { error_msg(loc, "integer type %s VALUE '%s' " "requires integer VALUE", @@ -1058,7 +1049,7 @@ cbl_field_t::report_invalid_initial_value(const YYLTYPE& loc) const { return TOUPPER(ch) == 'E'; } ); if( !has_exponent && data.precision() < pend - p ) { - error_msg(loc, "%s cannot represent VALUE %qs exactly (max %c%zu)", + error_msg(loc, "%s cannot represent VALUE %qs exactly (max %c%td)", name, data.initial, '.', pend - p); } } @@ -1141,7 +1132,7 @@ literal_subscript_oob( const cbl_refer_t& r, size_t& isub /* output */) { pdim++; return ! occurs.subscript_ok(r.field); } ); - isub = psub - r.subscripts.begin(); + isub = psub - r.subscripts.begin(); return psub == r.subscripts.end()? NULL : dims[isub]; } @@ -1154,12 +1145,12 @@ cbl_refer_t::subscripts_set( const std::list<cbl_refer_t>& subs ) { const char * cbl_refer_t::str() const { - static char subscripts[64]; - sprintf(subscripts, "(%u of " HOST_SIZE_T_PRINT_UNSIGNED " dimensions)", + static char subscripts_l[64]; + sprintf(subscripts_l, "(%u of " HOST_SIZE_T_PRINT_UNSIGNED " dimensions)", nsubscript(), (fmt_size_t)dimensions(field)); char *output = xasprintf("%s %s %s", field? field_str(field) : "(none)", - 0 < dimensions(field)? subscripts : "", + 0 < dimensions(field)? subscripts_l : "", is_refmod_reference()? "(refmod)" : "" ); return output; } @@ -1861,12 +1852,13 @@ date_time_fmt( const char input[] ) { { regex_t(), 'd', "^(" DATE_FMT_B "|" DATE_FMT_E ")$" }, { regex_t(), 't', "^(" TIME_FMT_B "|" TIME_FMT_E ")$" }, }; - int erc, cflags = REG_EXTENDED | REG_ICASE, eflags=0; + int cflags = REG_EXTENDED | REG_ICASE, eflags=0; regmatch_t m[5]; char result = 0; if( ! compiled ) { for( auto& fmt : fmts ) { + int erc; if( (erc = regcomp(&fmt.reg, fmt.pattern, cflags)) != 0 ) { char msg[80]; regerror(erc, &fmt.reg, msg, sizeof(msg)); @@ -1924,7 +1916,7 @@ class unique_stack : public std::stack<input_file_t> friend void cobol_set_pp_option(int opt); bool option_m; std::set<std::string> all_names; - + const char * no_wd( const char *wd, const char *name ) { int i; @@ -1935,7 +1927,7 @@ class unique_stack : public std::stack<input_file_t> public: unique_stack() : option_m(false) {} - + bool push( const value_type& value ) { auto ok = std::none_of( c.cbegin(), c.cend(), [value]( const auto& that ) { @@ -1969,8 +1961,8 @@ class unique_stack : public std::stack<input_file_t> const input_file_t& peek( size_t n ) const { gcc_assert( n < size() ); return c.at(size() - ++n); - } - + } + void option( int opt ) { // capture other preprocessor options eventually assert(opt == 'M'); option_m = true; @@ -1983,7 +1975,7 @@ class unique_stack : public std::stack<input_file_t> std::string input( top().name ); printf( "%s: ", input.c_str() ); for( const auto& name : all_names ) { - if( name != input ) + if( name != input ) printf( "\\\n\t%s ", name.c_str() ); } printf("\n"); @@ -2000,7 +1992,7 @@ void cobol_set_pp_option(int opt) { assert(opt == 'M'); input_filenames.option_m = true; } - + /* * Maintain a stack of input filenames. Ensure the files are unique (by * inode), to prevent copybook cycles. Before pushing a new name, Record the @@ -2011,7 +2003,7 @@ void cobol_set_pp_option(int opt) { * to enforce uniqueness, and the scanner to maintain line numbers. */ bool cobol_filename( const char *name, ino_t inode ) { - const line_map *lines = NULL; + //const line_map *lines = NULL; if( inode == 0 ) { auto p = old_filenames.find(name); if( p == old_filenames.end() ) { @@ -2021,8 +2013,10 @@ bool cobol_filename( const char *name, ino_t inode ) { } cbl_errx( "logic error: missing inode for %s", name); } - inode = p->second; - assert(inode != 0); + else { + inode = p->second; + assert(inode != 0); + } } linemap_add(line_table, LC_ENTER, sysp, name, 1); input_filename_vestige = name; @@ -2071,21 +2065,50 @@ cobol_filename_restore() { input_filenames.pop(); if( input_filenames.empty() ) return; - auto& input = input_filenames.top(); + const auto& input = input_filenames.top(); linemap_add(line_table, LC_LEAVE, sysp, NULL, 0); } -static location_t token_location; +static int first_line_minus_1 = 0; +static location_t token_location_minus_1 = 0; +static location_t token_location = 0; -location_t location_from_lineno() { return token_location; } +location_t current_token_location() { return token_location; } +location_t current_location_minus_one() { return token_location_minus_1; } +void current_location_minus_one_clear() + { + first_line_minus_1 = 0; + } template <typename LOC> static void gcc_location_set_impl( const LOC& loc ) { - // Set the position to the first line & column in the location. + // Set the position to the first line & column in the location. + if( getenv("KILROY") ) + { + fprintf(stderr, "********** KILROY %d\n", loc.first_line); + } + + static location_t loc_m_1 = 0; + token_location = linemap_line_start( line_table, loc.first_line, 80 ); token_location = linemap_position_for_column( line_table, loc.first_column); + + if( loc.first_line > first_line_minus_1 ) + { + // In order for GDB-COBOL to be able to step through COBOL code properly, + // it is sometimes necessary for the code at the beginning of a COBOL + // line to be using the location_t of the previous line. This is true, for + // example, when laying down the infrastructure code between the last + // statement of a paragraph and the code created at the beginning of the + // following paragragh. This code assumes that token_location values of + // interest are monotonic, and stores that prior value. + first_line_minus_1 = loc.first_line; + token_location_minus_1 = loc_m_1; + loc_m_1 = token_location; + } + location_dump(__func__, __LINE__, "parser", loc); } @@ -2126,7 +2149,7 @@ verify_format( const char gmsgid[] ) { } #endif -static const diagnostic_option_id option_zero; +static const diagnostics::option_id option_zero; size_t parse_error_inc(); void gcc_location_dump() { @@ -2144,8 +2167,9 @@ ydferror( const char gmsgid[], ... ) { va_list ap; va_start (ap, gmsgid); rich_location richloc (line_table, token_location); - bool ret = global_dc->diagnostic_impl (&richloc, nullptr, option_zero, - gmsgid, &ap, DK_ERROR); + /*bool ret =*/ global_dc->diagnostic_impl (&richloc, nullptr, option_zero, + gmsgid, &ap, + diagnostics::kind::error); va_end (ap); } @@ -2200,7 +2224,8 @@ class temp_loc_t { va_start (ap, gmsgid); \ rich_location richloc (line_table, token_location); \ bool ret = global_dc->diagnostic_impl (&richloc, nullptr, option_zero, \ - gmsgid, &ap, DK_ERROR); \ + gmsgid, &ap, \ + diagnostics::kind::error); \ va_end (ap); \ global_dc->end_group(); @@ -2216,14 +2241,30 @@ void error_msg( const YDFLTYPE& loc, const char gmsgid[], ... ) { ERROR_MSG_BODY } +bool +warn_msg( const YYLTYPE& loc, const char gmsgid[], ... ) { + temp_loc_t looker(loc); + verify_format(gmsgid); + auto_diagnostic_group d; + va_list ap; + va_start (ap, gmsgid); + rich_location richloc (line_table, token_location); + auto ret = emit_diagnostic_valist( diagnostics::kind::warning, + token_location, + option_zero, gmsgid, &ap ); + va_end (ap); + return ret; +} + void error_msg_direct( const char gmsgid[], ... ) { verify_format(gmsgid); parse_error_inc(); auto_diagnostic_group d; va_list ap; va_start (ap, gmsgid); - auto ret = emit_diagnostic_valist( DK_ERROR, token_location, - option_zero, gmsgid, &ap ); + /*auto ret = */emit_diagnostic_valist( diagnostics::kind::error, + token_location, + option_zero, gmsgid, &ap ); va_end (ap); } @@ -2236,8 +2277,11 @@ yyerror( const char gmsgid[], ... ) { va_list ap; va_start (ap, gmsgid); rich_location richloc (line_table, token_location); - bool ret = global_dc->diagnostic_impl (&richloc, nullptr, option_zero, - gmsgid, &ap, DK_ERROR); + /*bool ret =*/ global_dc->diagnostic_impl ( &richloc, + nullptr, + option_zero, + gmsgid, + &ap, diagnostics::kind::error); va_end (ap); global_dc->end_group(); } @@ -2248,7 +2292,7 @@ yywarn( const char gmsgid[], ... ) { auto_diagnostic_group d; va_list ap; va_start (ap, gmsgid); - auto ret = emit_diagnostic_valist( DK_WARNING, token_location, + auto ret = emit_diagnostic_valist( diagnostics::kind::warning, token_location, option_zero, gmsgid, &ap ); va_end (ap); return ret; @@ -2446,8 +2490,11 @@ cbl_internal_error(const char *gmsgid, ...) { auto_diagnostic_group d; va_list ap; va_start(ap, gmsgid); - emit_diagnostic_valist( DK_ICE, token_location, option_zero, gmsgid, &ap ); + emit_diagnostic_valist( diagnostics::kind::ice, + token_location, option_zero, gmsgid, &ap ); va_end(ap); + abort(); // This unnecessary statement is needed so that [[noreturn]] + // // doesn't cause a warning. } void @@ -2456,7 +2503,8 @@ cbl_unimplementedw(const char *gmsgid, ...) { auto_diagnostic_group d; va_list ap; va_start(ap, gmsgid); - emit_diagnostic_valist( DK_SORRY, token_location, option_zero, gmsgid, &ap ); + emit_diagnostic_valist( diagnostics::kind::sorry, + token_location, option_zero, gmsgid, &ap ); va_end(ap); } @@ -2466,7 +2514,8 @@ cbl_unimplemented(const char *gmsgid, ...) { auto_diagnostic_group d; va_list ap; va_start(ap, gmsgid); - emit_diagnostic_valist( DK_SORRY, token_location, option_zero, gmsgid, &ap ); + emit_diagnostic_valist( diagnostics::kind::sorry, + token_location, option_zero, gmsgid, &ap ); va_end(ap); } @@ -2477,12 +2526,13 @@ cbl_unimplemented_at( const YYLTYPE& loc, const char *gmsgid, ... ) { auto_diagnostic_group d; va_list ap; va_start(ap, gmsgid); - emit_diagnostic_valist( DK_SORRY, token_location, option_zero, gmsgid, &ap ); + emit_diagnostic_valist( diagnostics::kind::sorry, + token_location, option_zero, gmsgid, &ap ); va_end(ap); } -/* - * analogs to err(3) and errx(3). +/* + * analogs to err(3) and errx(3). */ #pragma GCC diagnostic push @@ -2494,7 +2544,8 @@ cbl_err(const char *fmt, ...) { verify_format(gmsgid); va_list ap; va_start(ap, fmt); - emit_diagnostic_valist( DK_FATAL, token_location, option_zero, gmsgid, &ap ); + emit_diagnostic_valist( diagnostics::kind::fatal, + token_location, option_zero, gmsgid, &ap ); va_end(ap); } #pragma GCC diagnostic pop @@ -2505,7 +2556,8 @@ cbl_errx(const char *gmsgid, ...) { auto_diagnostic_group d; va_list ap; va_start(ap, gmsgid); - emit_diagnostic_valist( DK_FATAL, token_location, option_zero, gmsgid, &ap ); + emit_diagnostic_valist( diagnostics::kind::fatal, + token_location, option_zero, gmsgid, &ap ); va_end(ap); } @@ -2617,7 +2669,7 @@ static const std::set<std::string> reserved_words = { "VOLATILE", "XML", "END-START", - + // ISO 2023 keywords "ACCEPT", "ACCESS", diff --git a/gcc/cobol/util.h b/gcc/cobol/util.h index d07b669..d478ea2 100644 --- a/gcc/cobol/util.h +++ b/gcc/cobol/util.h @@ -33,7 +33,7 @@ void cbl_message(int fd, const char *format_string, ...) ATTRIBUTE_PRINTF_2; -void cbl_internal_error(const char *format_string, ...) +[[noreturn]] void cbl_internal_error(const char *format_string, ...) ATTRIBUTE_GCOBOL_DIAG(1, 2); void cbl_err(const char *format_string, ...) ATTRIBUTE_GCOBOL_DIAG(1, 2); @@ -49,7 +49,7 @@ void cobol_set_pp_option(int opt); void cobol_filename_restore(); const char * cobol_lineno( int ); -int cobol_lineno(); +int cobol_lineno(void); unsigned long gb4( size_t input ); |