https://gcc.gnu.org/g:7bb846ed7fde99fa4d423e5dfa3b9560191e98a2
commit r17-1594-g7bb846ed7fde99fa4d423e5dfa3b9560191e98a2 Author: James K. Lowden <[email protected]> Date: Tue Jun 16 11:15:46 2026 -0400 cobol: Use cdf namespace in CDF Bison parser output. Fixes PR 119215 LTO error by removing enumerated types and other names from the global namespace, and by deleting use of YYLTYPE. A single location type cbl_loc_t is used by both parsers. Also fixes PR 122466 using conditional compilation for non-POSIX symbols. Require Bison 3.8.2 for C++ output. The generated C++ uses iostreams to format error messages. The cdf.y file includes the iostream header and does not use any GCC header files. gcc/cobol/ChangeLog: * Make-lang.in: Report Bison version. * cbldiag.h (defined): Define possibly missing macros. (ATTRIBUTE_GCOBOL_DIAG): Define if missing. (ATTRIBUTE_PRINTF_1): Same. (ATTRIBUTE_PRINTF_3): Same. (yyerror): Remove. (struct YYLTYPE): Remove. (enum cbl_gcobol_feature_t): Relocate from symbols.h. (YYLTYPE_IS_DECLARED): Remove. (YYLTYPE_IS_TRIVIAL): Remove. (cobol_location): Relocate. (cobol_gcobol_feature_set): Declare. (struct YDFLTYPE): Remove. (enum cbl_call_convention_t): Relocate from symbols.h. (YDFLTYPE_IS_DECLARED): Remove. (YDFLTYPE_IS_TRIVIAL): Remove. (current_call_convention): Declare. (cdf_push): Declare. (cdf_push_call_convention): Declare. (cdf_push_current_tokens): Declare. (cdf_push_dictionary): Declare. (cdf_push_enabled_exceptions): Declare. (cdf_push_source_format): Declare. (cdf_pop): Declare. (cdf_pop_call_convention): Declare. (cdf_pop_current_tokens): Declare. (cdf_pop_dictionary): Declare. (cdf_pop_source_format): Declare. (cdf_pop_enabled_exceptions): Declare. (current_program_index): Declare. (struct cbl_loc_t): Derive from cbl_loc_base_t. (struct cbl_loc_base_t): Define. (cbl_err): Declare. (cbl_errx): Declare. (error_msg): Use cbl_loc_t. (warn_msg): Same. (cbl_unimplemented_at): Same. (gcc_location_set): Same. * cdf.y: Require Bison 3.8.2 and generate C++ in cdf namespace. * cdfval.h (struct YDFLTYPE): Remove. (struct cbl_loc_t): Forward declaration. (struct cdfval_base_t): User-defined conversion from derived. * copybook.h (gcc_assert): Use assert(3) within cdf.y. (gcc_unreachable): Declare within cdf.y. (class copybook_elem_t): Use cbl_loc_t. (CTOUPPER): Use toupper(3) in uppername_t helper. (TOUPPER): Same. (class copybook_t): Use cbl_loc_t. * exceptg.h (struct cbl_label_t): Declare cbl_label_t. * gcobc: Support -fno-ec. * gcobol.1: Reword -fsyntax-only slightly. * genapi.cc (parser_label_label): Use cobol_location(). * lang.opt: Add comment in re lang.opt.urls. * lexio.cc (struct replacing_term_t): Use cbl_loc_t. (location_in): Same. (parse_copy_directive): Same. * lexio.h (struct filespan_t): Same. * messages.cc (cbl_message): Same. * parse.y: Same, and propagate location variously. * parse_ante.h (current_data_section_set): Use cbl_loc_t. (namcpy): Same. (reject_refmod): Same. (require_pointer): Same. (require_integer): Same. (ast_op): Same. (perform_tgt_set): Same. (label_add): Same. (paragraph_reference): Same. (tee_up_name): Same. (ast_inspect): Same. (ast_enter_section): Same. (ast_enter_paragraph): Same. (prototype_add): Same. (verify_args): Same. (subscript_dimension_error): Same. (literal_subscripts_valid): Same. (literal_refmod_valid): Same. (struct cbl_fieldloc_t): Remove. (intrinsic_call_1): Use cbl_loc_t. (symbol_find): Same. (valid_redefine): Same. (field_add): Same. (field_type_update): Same. (field_capacity_error): Same. (field_alloc): Same. (file_add): Same. (alphabet_add): Same. (set_real_from_capacity): Same. (procedure_division_ready): Same. (file_section_fd_set): Same. (ast_call): Same. (field_binary_usage): Same. (ast_end_program): Same. (cobol_location): Same. (location_set): Same. (statement_begin): Same. (ast_first_statement): Same. * scan.l: Qualify tokens with new cdf namespace. * scan_ante.h (ydfparse): Now static. (cdf_context): Declare. (ydfltype_of): Remove. (update_location): Use cbl_loc_t. (reset_location): Same. (YY_USER_INIT): Same. (class picture_t): Same. * scan_post.h (ydfparse): Wrapper for cdf_parser::parse() method. (ydfchar): Lookahead helper. (ydfdebug): Same. (run_cdf): Clearer debug messages. (struct pending_token_t): Renamed to recent_token_t. (struct recent_token_t): As above. (PENDING): Renames to RECENT. (RECENT): As above. (next_token): Removed. (recent_tokens_t): Capture abandoned lookahead tokens. (prelex): Use recent_tokens queue. (yylex): Drop normal parsing idea. * symbols.cc (symbol_field_location): Use cbl_loc_t. (symbol_alphabet): Same. (cbl_alphabet_t::cbl_alphabet_t): Same. (cbl_alphabet_t::assign): Same. (cbl_alphabet_t::also): Same. (symbol_temporary_location): Same. (cbl_field_t::encode): Same. * symbols.h (enum cbl_gcobol_feature_t): Remove. (cobol_gcobol_feature_set): Remove. (struct cbl_field_t): Use cbl_loc_t. (struct cbl_refer_t): Same. (struct cbl_alphabet_t): Same. (struct cbl_perform_tgt_t): Same. (struct cbl_nameloc_t): Same. (class name_queue_t): Same. (tee_up_name): Same. (symbol_field_location): Same. (enum cbl_call_convention_t): Remove (class current_tokens_t): Use cbl_loc_t. (current_call_convention): Same. (gcc_location_set): Same. * util.cc (class cdf_directives_t): Use cbl_loc_t. (cdf_unreachable): Define as gcc_unreachable. (cdf_literalize): Do not handle location. (cdf_file): New function. (cdf_file_index): Same. (cdf_file_name): Same. (cdf_add_field): Same. (cbl_field_t::encode_numeric): Remove unused parameter. (cbl_field_t::report_invalid_initial_value): Use cbl_loc_t. (match_proc): Namespace for local prototype-verification functions. (DUMP_PROCEDURE_CALLS): Guard macro for debug function. (procedure_calls_dump): New function to show uses of PERFORM. (gcc_location_set_impl): Use cbl_loc_t. (gcc_location_set): Same. (class temp_loc_t): Same. (error_msg): Same. (warn_msg): Same. (ydfdebug): Same. (cobol_set_debugging): Same. (cbl_unimplemented_at): Same. * util.h (cbl_err): Remove declaration. (cbl_errx): 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_source_format): Same. (cdf_pop_enabled_exceptions): Same. libgcobol/ChangeLog: * posix/shim/open.cc (defined): Honor _GNU_SOURCE and _POSIX_C_SOURCE. Diff: --- gcc/cobol/Make-lang.in | 1 + gcc/cobol/cbldiag.h | 130 ++++++++----- gcc/cobol/cdf.y | 338 +++++++++++++++++++++++----------- gcc/cobol/cdfval.h | 8 +- gcc/cobol/copybook.h | 23 ++- gcc/cobol/exceptg.h | 2 + gcc/cobol/gcobc | 4 +- gcc/cobol/gcobol.1 | 6 +- gcc/cobol/genapi.cc | 2 +- gcc/cobol/lang.opt | 7 + gcc/cobol/lexio.cc | 10 +- gcc/cobol/lexio.h | 4 +- gcc/cobol/messages.cc | 7 +- gcc/cobol/parse.y | 106 ++++++----- gcc/cobol/parse_ante.h | 129 +++++++------ gcc/cobol/scan.l | 6 +- gcc/cobol/scan_ante.h | 49 ++--- gcc/cobol/scan_post.h | 183 ++++++++++++++++--- gcc/cobol/symbols.cc | 23 +-- gcc/cobol/symbols.h | 80 ++++---- gcc/cobol/util.cc | 426 ++++++++++++++++++++++++++++++++++++++++--- gcc/cobol/util.h | 31 ++-- libgcobol/posix/shim/open.cc | 42 +++-- 23 files changed, 1149 insertions(+), 468 deletions(-) diff --git a/gcc/cobol/Make-lang.in b/gcc/cobol/Make-lang.in index a43a2244220f..3a760eea056a 100644 --- a/gcc/cobol/Make-lang.in +++ b/gcc/cobol/Make-lang.in @@ -152,6 +152,7 @@ gcobol-cross$(exeext): gcobol$(exeext) # First, files needed for parsing: cobol/parse.cc: cobol/parse.y + $(BISON) --version | grep ^bison $(BISON) -o $@ $(YFLAGS) \ --defines=cobol/parse.h \ --report-file=cobol/parser.out $< diff --git a/gcc/cobol/cbldiag.h b/gcc/cobol/cbldiag.h index 07d92c0b48da..827667bdcbd8 100644 --- a/gcc/cobol/cbldiag.h +++ b/gcc/cobol/cbldiag.h @@ -41,66 +41,95 @@ const char * cobol_filename(); +#if ! defined(ATTRIBUTE_GCOBOL_DIAG) +#define ATTRIBUTE_GCOBOL_DIAG(a, b) +#endif +#if ! defined(ATTRIBUTE_PRINTF_1) +#define ATTRIBUTE_PRINTF_1 +#endif +#if ! defined(ATTRIBUTE_PRINTF_3) +#define ATTRIBUTE_PRINTF_3 +#endif + /* - * These are user-facing messages. They go through the gcc - * diagnostic framework and use text that can be localized. + * Enumerations do not depend on anything else. */ -void yyerror( const char fmt[], ... ) ATTRIBUTE_GCOBOL_DIAG(1, 2); -/* Location type. Borrowed from parse.h as generated by Bison. */ -#if ! defined YYLTYPE && ! defined YYLTYPE_IS_DECLARED -typedef struct YYLTYPE YYLTYPE; -struct YYLTYPE -{ - int first_line; - int first_column; - int last_line; - int last_column; +enum cbl_gcobol_feature_t { + feature_gcc_e = 0x00, + feature_internal_ebcdic_e = 0x01, + feature_embiggen_e = 0x02, // widen numeric that redefine POINTER }; -# define YYLTYPE_IS_DECLARED 1 -# define YYLTYPE_IS_TRIVIAL 1 -const YYLTYPE& cobol_location(); -#endif +bool cobol_gcobol_feature_set( cbl_gcobol_feature_t gcobol_feature, + bool on = true ); -#if ! defined YDFLTYPE && ! defined YDFLTYPE_IS_DECLARED -typedef struct YDFLTYPE YDFLTYPE; -struct YDFLTYPE -{ - int first_line; - int first_column; - int last_line; - int last_column; +enum cbl_call_convention_t { + cbl_call_verbatim_e = 'V', + cbl_call_cobol_e = 'N', // native }; -# define YDFLTYPE_IS_DECLARED 1 -# define YDFLTYPE_IS_TRIVIAL 1 -#endif +void current_call_convention( cbl_call_convention_t convention); +cbl_call_convention_t current_call_convention(); + + +/* + * CDF state does not require types that would be defined in another file. + */ +void cdf_push(); +void cdf_push_call_convention(); +void cdf_push_current_tokens(); +void cdf_push_dictionary(); +void cdf_push_enabled_exceptions(); +void cdf_push_source_format(); + +void cdf_pop(); +void cdf_pop_call_convention(); +void cdf_pop_current_tokens(); +void cdf_pop_dictionary(); +void cdf_pop_source_format(); +void cdf_pop_enabled_exceptions(); + +size_t current_program_index(); + +/* + * These are user-facing messages. They go through the gcc + * diagnostic framework and use text that can be localized. + */ +void yyerror( const char fmt[], ... ) ATTRIBUTE_GCOBOL_DIAG(1, 2); -struct cbl_loc_t { +struct cbl_loc_base_t { int first_line; int first_column; int last_line; int last_column; +}; +struct cbl_loc_t : public cbl_loc_base_t { - cbl_loc_t() - : first_line(0) - , first_column(0) - , last_line(0) - , last_column(0) + cbl_loc_t() : cbl_loc_base_t{} {} - cbl_loc_t( const YYLTYPE& loc ) - : first_line(loc.first_line) - , first_column(loc.first_column) - , last_line(loc.last_line) - , last_column(loc.last_column) + cbl_loc_t( int first_line, int first_column, + int last_line, int last_column ) + : cbl_loc_base_t { + first_line , first_column, + last_line, last_column + } {} - - operator YYLTYPE() const { // cppcheck-suppress syntaxError - return { first_line, first_column, last_line, last_column }; - } + cbl_loc_t( const cbl_loc_base_t& base ) : cbl_loc_base_t(base) + {} +#if 0 + cbl_loc_t( int first_line, int first_column, + int last_line, int last_column ) + : first_line(first_line) + , first_column(first_column) + , last_line(last_line) + , last_column(last_column) + {} +#endif }; +const cbl_loc_t& cobol_location(); + /* * Naming Convention: Names end with a letter that indicates * their kind: @@ -176,12 +205,18 @@ enum cbl_diag_id_t : uint64_t { DiagDiagDiag // always last }; +void cbl_err(const char *format_string, ...) ATTRIBUTE_GCOBOL_DIAG(1, 2); +void cbl_errx(const char *format_string, ...) ATTRIBUTE_GCOBOL_DIAG(1, 2); + bool cbl_message( cbl_diag_id_t id, const char msg[], ... ) ATTRIBUTE_GCOBOL_DIAG(2, 3); bool cbl_message( cbl_loc_t loc, cbl_diag_id_t id, const char msg[], ... ) ATTRIBUTE_GCOBOL_DIAG(3, 4); +[[noreturn]] void cbl_internal_error(const char *format_string, ...) + ATTRIBUTE_GCOBOL_DIAG(1, 2); + bool dialect_ok( const cbl_loc_t& loc, cbl_diag_id_t id, const char term[], bool ok = true ); @@ -192,11 +227,14 @@ dialect_not_ok( const cbl_loc_t& loc, cbl_diag_id_t id, const char term[] ) { // 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[], ... ) +void error_msg( const cbl_loc_t& loc, const char gmsgid[], ... ) + ATTRIBUTE_GCOBOL_DIAG(2, 3); + +void error_msg( const cbl_loc_t& loc, const char gmsgid[], ... ) ATTRIBUTE_GCOBOL_DIAG(2, 3); bool -warn_msg( const YYLTYPE& loc, const char gmsgid[], ... ) +warn_msg( const cbl_loc_t& loc, const char gmsgid[], ... ) ATTRIBUTE_GCOBOL_DIAG(2, 3); // an error that uses token_location, not yylloc @@ -212,7 +250,7 @@ void cbl_unimplementedw(cbl_diag_id_t id, const char *gmsgid, ...) ATTRIBUTE_GCOBOL_DIAG(2, 3); // warning void cbl_unimplemented(const char *gmsgid, ...) ATTRIBUTE_GCOBOL_DIAG(1, 2); // error -void cbl_unimplemented_at( const YYLTYPE& loc, const char *gmsgid, ... ) +void cbl_unimplemented_at( const cbl_loc_t& loc, const char *gmsgid, ... ) ATTRIBUTE_GCOBOL_DIAG(2, 3); /* @@ -222,7 +260,7 @@ void cbl_unimplemented_at( const YYLTYPE& loc, const char *gmsgid, ... ) */ void dbgmsg( const char fmt[], ... ) ATTRIBUTE_PRINTF_1; -void gcc_location_set( const YYLTYPE& loc ); +void gcc_location_set( const cbl_loc_t& loc ); void gcc_location_dump(); diff --git a/gcc/cobol/cdf.y b/gcc/cobol/cdf.y index 967952538d18..83548a2bbb8d 100644 --- a/gcc/cobol/cdf.y +++ b/gcc/cobol/cdf.y @@ -27,30 +27,99 @@ * (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> -#include <tree.h> +#include <cassert> +#include <cctype> +#include <cstdint> +#include <cstdio> +#include <cstdlib> +#include <cstring> -#undef yy_flex_debug +#include <algorithm> +#include <deque> +#include <list> +#include <map> +#include <iostream> +#include <string> +#include <vector> + +#include <unistd.h> + +#define HAVE_DECL_BASENAME 1 +#include <libiberty.h> + +#define CDF_Y -#include "../../libgcobol/ec.h" -#include "../../libgcobol/common-defs.h" -#include "util.h" #include "cbldiag.h" -#include "symbols.h" #include "copybook.h" +#include "../../libgcobol/ec.h" +#include "../../libgcobol/common-defs.h" #include "../../libgcobol/exceptl.h" #include "exceptg.h" +// Quell warning: variable yynerrs_ set but not used +#pragma GCC diagnostic ignored "-Wunused-but-set-variable" + +std::ostream& +operator<<( std::ostream& os, cbl_loc_t const& loc ) { + os << "(" + << loc.first_line + << "," + << loc.first_column + << ") to (" + << loc.last_line + << "," + << loc.last_column + << ")"; + return os; +} + +const char * keyword_str( int token ); + +namespace cdf { +static int current_token; +static int used_token( int token ) { + dbgmsg("%s: %s", __func__, keyword_str(token)); + return current_token = token; +} + +int used_token() { return current_token; } +} +#define USED_TOKEN(T) cdf::used_token(parser::token::YDF_ ##T) + +%} + +%code requires { + namespace cdf + { + class parser; + } +} + +%code { + // https://learnmoderncpp.com/2020/12/17/generating-c-programs-with-flex-and-bison-2/ + namespace cdf + { + int cdflex( parser::semantic_type *value, cbl_loc_t *loc ); + } +} + +%define api.location.type {cbl_loc_t} + +%{ #define COUNT_OF(X) (sizeof(X) / sizeof(X[0])) +int keyword_tok( const char * text, bool include_intrinsics = false ); + copybook_t copybook; +std::ostream& operator<<(std::ostream& os, const cbl_loc_t& loc); + static inline bool is_word( int c ) { - return c == '_' || ISALNUM(c); + return c == '_' || ::isalnum(c); } static std::pair<long long, bool> @@ -66,15 +135,15 @@ integer_literal( const char input[] ) { 'yynerrs', 'yylval', 'yylloc', 'yychar' and 'yydebug'. [...] The renamed macros include 'YYSTYPE', 'YYLTYPE', and 'YYDEBUG'" */ -extern int yylineno, yyleng; +extern int yylineno, yyleng, yydebug; extern char *yytext; -static int ydflex(void); +extern size_t cbl_gcobol_features; #define PROGRAM current_program_index() -const YYLTYPE& cobol_location(); -static YYLTYPE location_set( const YYLTYPE& loc ); +const cbl_loc_t& cobol_location(); +static cbl_loc_t location_set( const cbl_loc_t& loc ); void input_file_status_notify(); #define YYLLOC_DEFAULT(Current, Rhs, N) \ @@ -104,7 +173,7 @@ void input_file_status_notify(); %code requires { #include "cdfval.h" - + struct cbl_file_t; using std::map; #pragma GCC diagnostic push @@ -153,9 +222,11 @@ void input_file_status_notify(); cdfval_t operator/( const cdfval_base_t& lhs, const cdfval_base_t& rhs ); cdfval_t negate( cdfval_base_t lhs ); - cbl_field_t - cdf_literalize( const cbl_loc_t& loc, - const std::string& name, const cdfval_t& value, bool init = true ); + void cdf_unreachable(); + void cdf_field_add( const cbl_loc_t&, const std::string& name, const cdfval_t& value ); + cbl_file_t * cdf_file( size_t program, const cbl_name_t name ); + size_t cdf_file_index( const cbl_file_t *file ); + const char * cdf_file_name(const cbl_file_t*); } %{ @@ -189,15 +260,15 @@ apply_cdf_turn( const exception_turn_t& turn ) { std::set<size_t> *files; } -%printer { fprintf(yyo, "'%s'", $$? "true" : "false" ); } <boolean> -%printer { fprintf(yyo, "'%s'", $$ ); } <string> -%printer { fprintf(yyo, "%s '%s'", +%printer { fprintf(stderr, "'%s'", $$ ); } <string> +%printer { fprintf(stderr, "'%s'", $$? "true" : "false" ); } <boolean> +%printer { fprintf(stderr, "%s '%s'", keyword_str($$.token), $$.string? $$.string : "<nil>" ); } <cdfarg> -/* cppcheck-suppress invalidPrintfArgType_sint */ -%printer { fprintf(yyo, HOST_SIZE_T_PRINT_DEC " '%s'", - (fmt_size_t)$$.number, $$.string? $$.string : "" ); } <cdfval> - +// cppcheck-suppress invalidPrintfArgType_sint +%printer { fprintf(stderr, "%ld '%s'", + (long)$$.number, $$.string? $$.string : "" ); } <cdfval> + %type <string> NAME NUMSTR LITERAL PSEUDOTEXT %type <string> LSUB RSUB SUBSCRIPT %type <cdfarg> namelit name_any name_one @@ -265,7 +336,10 @@ apply_cdf_turn( const exception_turn_t& turn ) { %left '*' '/' %right NEG 958 -%define api.prefix {ydf} +%require "3.8.2" // for C++ output +%language "c++" + +%define api.prefix {cdf} %define api.token.prefix{YDF_} %locations @@ -314,9 +388,11 @@ cdf_display: CDF_DISPLAY strings { } ; strings: LITERAL { + USED_TOKEN(LITERAL); display_msg = xstrdup($1); } | strings LITERAL { + USED_TOKEN(LITERAL); char *p = display_msg; display_msg = xasprintf("%s %s", p, $2); free(p); @@ -333,11 +409,11 @@ partials: partial } ; partial: cdf_if /* text */ - | CDF_ELSE { scanner_parsing_toggle(); } - | CDF_END_IF { scanner_parsing_pop(); } + | CDF_ELSE { USED_TOKEN(CDF_ELSE); scanner_parsing_toggle(); } + | CDF_END_IF { USED_TOKEN(CDF_END_IF); scanner_parsing_pop(); } | cdf_evaluate /* text */ | cdf_eval_when /* text */ - | CDF_END_EVALUATE { scanner_parsing_pop(); } + | CDF_END_EVALUATE { USED_TOKEN(CDF_END_EVALUATE); scanner_parsing_pop(); } ; cdf_define: CDF_DEFINE cdf_constant NAME as cdf_expr[value] override @@ -358,10 +434,7 @@ cdf_define: CDF_DEFINE cdf_constant NAME as cdf_expr[value] override } YYERROR; } - if( symbols_begin() < symbols_end() ) { - cbl_field_t field = cdf_literalize(@NAME, $NAME, $value); - symbol_field_add(current_program_index(), &field); - } + cdf_field_add( @NAME, $NAME, $value ); } | CDF_DEFINE cdf_constant NAME EQ cdf_expr[value] override @@ -372,6 +445,7 @@ cdf_define: CDF_DEFINE cdf_constant NAME as cdf_expr[value] override } | CDF_DEFINE cdf_constant NAME as OFF { + USED_TOKEN(OFF); cdfval_off( $NAME); } | CDF_DEFINE cdf_constant NAME as PARAMETER_kw override @@ -390,6 +464,7 @@ cdf_define: CDF_DEFINE cdf_constant NAME as cdf_expr[value] override } } | CDF_DEFINE FEATURE as ON { + USED_TOKEN(ON); auto feature = cbl_gcobol_feature_t($2); if( ! cobol_gcobol_feature_set(feature, true) ) { error_msg(@FEATURE, @@ -397,6 +472,7 @@ cdf_define: CDF_DEFINE cdf_constant NAME as cdf_expr[value] override } } | CDF_DEFINE FEATURE as OFF { + USED_TOKEN(OFF); auto feature = cbl_gcobol_feature_t($2); if( ! cobol_gcobol_feature_set(feature, false) ) { error_msg(@FEATURE, @@ -405,10 +481,12 @@ cdf_define: CDF_DEFINE cdf_constant NAME as cdf_expr[value] override } ; cdf_constant: %empty - | CONSTANT - ; + | CONSTANT { + USED_TOKEN(CONSTANT); + } + ; override: %empty { $$ = false; } - | OVERRIDE { $$ = true; } + | OVERRIDE { $$ = true; USED_TOKEN(OVERRIDE); } ; cdf_turn: TURN except_names except_check @@ -420,41 +498,43 @@ cdf_turn: TURN except_names except_check cdf_call_convention: CALL_COBOL { + USED_TOKEN(CALL_COBOL); current_call_convention(cbl_call_cobol_e); } | CALL_VERBATIM { + USED_TOKEN(CALL_VERBATIM); current_call_convention(cbl_call_verbatim_e); } ; cdf_push: CDF_PUSH cdf_stackable { switch( $cdf_stackable ) { - case YDF_ALL: cdf_push(); break; - case YDF_CALL_CONVENTION: cdf_push_call_convention(); break; - case YDF_CDF_DEFINE: cdf_push_dictionary(); break; - case YDF_COBOL_WORDS: cdf_push_current_tokens(); break; - case YDF_SOURCE_FORMAT: cdf_push_source_format(); break; - default: gcc_unreachable(); + case parser::token::YDF_ALL: cdf_push(); break; + case parser::token::YDF_CALL_CONVENTION: cdf_push_call_convention(); break; + case parser::token::YDF_CDF_DEFINE: cdf_push_dictionary(); break; + case parser::token::YDF_COBOL_WORDS: cdf_push_current_tokens(); break; + case parser::token::YDF_SOURCE_FORMAT: cdf_push_source_format(); break; + default: cdf_unreachable(); } } ; cdf_pop: CDF_POP cdf_stackable { switch( $cdf_stackable ) { - case YDF_ALL: cdf_pop(); break; - case YDF_CALL_CONVENTION: cdf_pop_call_convention(); break; - case YDF_CDF_DEFINE: cdf_pop_dictionary(); break; - case YDF_COBOL_WORDS: cdf_pop_current_tokens(); break; - case YDF_SOURCE_FORMAT: cdf_pop_source_format(); break; - default: gcc_unreachable(); + case parser::token::YDF_ALL: cdf_pop(); break; + case parser::token::YDF_CALL_CONVENTION: cdf_pop_call_convention(); break; + case parser::token::YDF_CDF_DEFINE: cdf_pop_dictionary(); break; + case parser::token::YDF_COBOL_WORDS: cdf_pop_current_tokens(); break; + case parser::token::YDF_SOURCE_FORMAT: cdf_pop_source_format(); break; + default: cdf_unreachable(); } } ; -cdf_stackable: ALL { $$ = YDF_ALL; } - | CALL_CONVENTION { $$ = YDF_CALL_CONVENTION; } - | COBOL_WORDS { $$ = YDF_COBOL_WORDS; } - | CDF_DEFINE { $$ = YDF_CDF_DEFINE; } - | SOURCE_FORMAT { $$ = YDF_SOURCE_FORMAT; } +cdf_stackable: ALL { $$ = parser::token::YDF_ALL; } + | CALL_CONVENTION { $$ = parser::token::YDF_CALL_CONVENTION; } + | COBOL_WORDS { $$ = parser::token::YDF_COBOL_WORDS; } + | CDF_DEFINE { $$ = parser::token::YDF_CDF_DEFINE; } + | SOURCE_FORMAT { $$ = parser::token::YDF_SOURCE_FORMAT; } ; except_names: except_name @@ -472,48 +552,55 @@ except_name: EXCEPTION_NAME[ec] { ; except_check: CHECKING on { $$ = exception_turn.enable(true); } - | CHECKING OFF { $$ = exception_turn.enable(false); } + | CHECKING OFF { + USED_TOKEN(OFF); + $$ = exception_turn.enable(false); + } | CHECKING on with LOCATION { + USED_TOKEN(LOCATION); $$ = exception_turn.enable(true, true); } ; filenames: filename { $$ = new std::set<size_t>; - $$->insert(symbol_index(symbol_elem_of($1))); + $$->insert(cdf_file_index($1)); } | filenames filename { $$ = $1; - auto inserted = $$->insert(symbol_index(symbol_elem_of($2))); + auto inserted = $$->insert(cdf_file_index($2)); if( ! inserted.second ) { - error_msg(@2, "%s: No file-name shall be specified more than " - "once for one exception condition", $filename->name); + error_msg(@2, "%s: No file-name shall be specified more than once " + "for one exception condition", + cdf_file_name($filename)); } } ; filename: NAME { - struct symbol_elem_t *e = symbol_file(PROGRAM, $1); - if( !(e && e->type == SymFile) ) { + USED_TOKEN(NAME); + if( ($$ = cdf_file(PROGRAM, $1)) == nullptr ) { error_msg(@NAME, "invalid file name '%s'", $NAME); YYERROR; } - $$ = cbl_file_of(e); } ; cdf_if: CDF_IF cdf_cond_expr { - scanner_parsing(YDF_CDF_IF, $2); + scanner_parsing(parser::token::YDF_CDF_IF, $2); } | CDF_IF error { } CDF_END_IF { // not pushed, don't pop + USED_TOKEN(CDF_END_IF); if( ! scanner_parsing() ) YYACCEPT; } ; cdf_evaluate: CDF_EVALUATE cdf_expr - | CDF_EVALUATE TRUE_kw + | CDF_EVALUATE TRUE_kw { + USED_TOKEN(TRUE_kw); + } ; cdf_eval_when: CDF_WHEN cdf_eval_obj @@ -521,20 +608,26 @@ cdf_eval_when: CDF_WHEN cdf_eval_obj cdf_eval_obj: cdf_cond_expr | cdf_expr THRU cdf_expr - | OTHER + | OTHER { + USED_TOKEN(OTHER); + } ; -cdf_cond_expr: BOOL +cdf_cond_expr: BOOL { + USED_TOKEN(BOOL); + } | NAME DEFINED { + USED_TOKEN(DEFINED); cdf_values_t& dictionary( cdf_dictionary() ); auto p = dictionary.find($1); bool found = p != dictionary.end(); if( !$DEFINED ) found = ! found; $$ = found; if( found ) { - dbgmsg("CDF: %s found in dictionary (result %s)", - $1, $$? "true" : "false"); + const char *aint = $DEFINED? "" : "not "; + dbgmsg("CDF: %s %sfound in dictionary (result %s)", + $1, aint, $$? "true" : "false"); } else { dbgmsg("CDF: %s not found in dictionary (result %s)", $1, $$? "true" : "false"); @@ -542,6 +635,7 @@ cdf_cond_expr: BOOL } | cdf_bool_expr { $$ = $1(@1) == 0? false : true; } | FEATURE DEFINED { + USED_TOKEN(DEFINED); const auto& feature($1); $$ = (feature == int(feature & cbl_gcobol_features)); dbgmsg("CDF: feature 0x%02x is %s", $1, $$? "ON" : "OFF"); @@ -609,6 +703,7 @@ cdf_expr: cdf_expr '+' cdf_expr { $$ = $1(@1) + $3(@3); } ; cdf_factor: NAME { + USED_TOKEN(NAME); cdf_values_t& dictionary( cdf_dictionary() ); auto that = dictionary.find($1); if( that != dictionary.end() ) { @@ -623,9 +718,17 @@ cdf_factor: NAME { $$ = cdfval_t(); } } - | NUMBER { $$ = cdfval_t($1); } - | LITERAL { $$ = cdfval_t($1); } + | NUMBER + { + USED_TOKEN(NUMBER); + $$ = cdfval_t($1); + } + | LITERAL { + USED_TOKEN(LITERAL); + $$ = cdfval_t($1); + } | NUMSTR { + USED_TOKEN(NUMSTR); auto value = integer_literal($NUMSTR); if( !value.second ) { error_msg(@1, "CDF error: parsed %qs as %lld", @@ -669,16 +772,16 @@ replace_by: name_any[a] BY name_any[b] bool add_whitespace = false; replace_type_t type = {}; switch($a.token) { - case YDF_NUMSTR: - case YDF_LITERAL: + case parser::token::YDF_NUMSTR: + case parser::token::YDF_LITERAL: type = string_e; break; - case YDF_NAME: + case parser::token::YDF_NAME: type = token_e; break; - case YDF_PSEUDOTEXT: + case parser::token::YDF_PSEUDOTEXT: type = pseudo_e; - add_whitespace = $b.token != YDF_PSEUDOTEXT; + add_whitespace = $b.token != parser::token::YDF_PSEUDOTEXT; break; default: cbl_err("%s:%d: logic error on token %s", @@ -698,20 +801,23 @@ replace_by: name_any[a] BY name_any[b] suppress: %empty | SUPPRESS { + USED_TOKEN(SUPPRESS); copybook.suppress(); } ; name_any: namelit | PSEUDOTEXT { - $$ = cdf_arg_t{YDF_PSEUDOTEXT, $1}; + USED_TOKEN(PSEUDOTEXT); + $$ = cdf_arg_t{parser::token::YDF_PSEUDOTEXT, $1}; } ; name_one: NAME { + USED_TOKEN(NAME); cdf_values_t& dictionary( cdf_dictionary() ); - cdf_arg_t arg = { YDF_NAME, $1 }; + cdf_arg_t arg = { parser::token::YDF_NAME, $1 }; auto p = dictionary.find($1); if( p != dictionary.end() ) { @@ -719,14 +825,20 @@ name_one: NAME } $$ = arg; } - | NUMSTR { $$ = cdf_arg_t{YDF_NUMSTR, $1}; } - | LITERAL { $$ = cdf_arg_t{YDF_LITERAL, $1}; } + | NUMSTR { + USED_TOKEN(NUMSTR); + $$ = cdf_arg_t{parser::token::YDF_NUMSTR, $1}; + } + | LITERAL { + USED_TOKEN(LITERAL); + $$ = cdf_arg_t{parser::token::YDF_LITERAL, $1}; + } ; namelit: name { cdf_values_t& dictionary( cdf_dictionary() ); - cdf_arg_t arg = { YDF_NAME, $1 }; + cdf_arg_t arg = { parser::token::YDF_NAME, $1 }; auto p = dictionary.find($1); if( p != dictionary.end() ) { @@ -740,16 +852,19 @@ namelit: name free(const_cast<char*>($1)); free(const_cast<char*>($2)); - cdf_arg_t arg = { YDF_NAME, s }; + cdf_arg_t arg = { parser::token::YDF_NAME, s }; $$ = arg; } - | NUMSTR { $$ = cdf_arg_t{YDF_NUMSTR, $1}; } - | LITERAL { $$ = cdf_arg_t{YDF_LITERAL, $1}; } + | NUMSTR { $$ = cdf_arg_t{parser::token::YDF_NUMSTR, $1}; } + | LITERAL { $$ = cdf_arg_t{parser::token::YDF_LITERAL, $1}; } ; -name: NAME +name: NAME { + USED_TOKEN(NAME); + } | name inof NAME { + USED_TOKEN(NAME); char *s = xasprintf( "%s %s %s", $1, $2, $3 ); assert($$ == $1); free(const_cast<char*>($1)); @@ -757,13 +872,18 @@ name: NAME $$ = s; } ; -inof: IN { static const char in[] = "IN"; $$ = in; } - | OF { static const char of[] = "OF"; $$ = of; } +inof: IN { + USED_TOKEN(IN); + static const char in[] = "IN"; $$ = in; + } + | OF { + USED_TOKEN(OF); + static const char of[] = "OF"; $$ = of; + } ; subscripts: subscript - | subscripts subscript - { + | subscripts subscript { char *s = xasprintf("%s%s", $1, $2 ); if( $$ != $1 ) free(const_cast<char*>($$)); free(const_cast<char*>($1)); @@ -771,9 +891,12 @@ subscripts: subscript $$ = s; } ; -subscript: SUBSCRIPT +subscript: SUBSCRIPT { + USED_TOKEN(SUBSCRIPT); + } | LSUB subscript RSUB { + USED_TOKEN(RSUB); char *s = xasprintf( "%s%s%s", $1, $2, $3 ); free(const_cast<char*>($1)); free(const_cast<char*>($2)); @@ -783,23 +906,29 @@ subscript: SUBSCRIPT ; as: %empty - | AS + | AS { + USED_TOKEN(AS); + } ; on: %empty - | ON + | ON { + USED_TOKEN(ON); + } ; with: %empty - | WITH + | WITH { + USED_TOKEN(WITH); + } ; %% -static YYLTYPE cdf_location; +static cbl_loc_t cdf_location; -static YYLTYPE -location_set( const YYLTYPE& loc ) { +static cbl_loc_t +location_set( const cbl_loc_t& loc ) { return cdf_location = loc; } @@ -829,8 +958,8 @@ defined_cmd( const char arg[] ) if( yydebug ) { if( cdf_name->second.is_numeric() ) { - dbgmsg("%s: added -D %s = " HOST_SIZE_T_PRINT_DEC, - __func__, name, (fmt_size_t)cdf_name->second.as_number()); + dbgmsg("%s: added -D %s = %ld", + __func__, name, (long)cdf_name->second.as_number()); } else { dbgmsg("%s: added -D %s = \"%s\"", __func__, name, cdf_name->second.string); } @@ -921,13 +1050,6 @@ cdfval_t negate( cdfval_base_t lhs ) { return lhs; } -#undef yylex -int yylex(void); - -static int ydflex(void) { - return yylex(); -} - bool cdf_value( const char name[], const cdfval_t& value ) { cdf_values_t& dictionary( cdf_dictionary() ); @@ -950,7 +1072,7 @@ cdf_value( const char name[] ) { } static bool -verify_integer( const YDFLTYPE& loc, const cdfval_base_t& val ) { +verify_integer( const cbl_loc_t& loc, const cdfval_base_t& val ) { if( val.string ) { error_msg(loc, "'%s' is not an integer", val.string); return false; @@ -959,10 +1081,16 @@ verify_integer( const YDFLTYPE& loc, const cdfval_base_t& val ) { } const cdfval_base_t& -cdfval_base_t::operator()( const YDFLTYPE& loc ) { +cdfval_base_t::operator()( const cbl_loc_t& loc ) { static cdfval_t zero(0); // cppcheck-suppress returnTempReference return verify_integer(loc, *this) ? *this : zero; } - +namespace cdf { + void + parser::error(cbl_loc_t const& loc, std::string const& msg) { + error_msg(loc, msg.c_str()); + } +} + diff --git a/gcc/cobol/cdfval.h b/gcc/cobol/cdfval.h index b9d660023700..60428f5dcb87 100644 --- a/gcc/cobol/cdfval.h +++ b/gcc/cobol/cdfval.h @@ -46,12 +46,14 @@ bool scanner_parsing(); * We use the derived type cdfval_t, which can be properly constructed and * operated on, but tell Bison only about its POD base class. */ -struct YDFLTYPE; + +struct cbl_loc_t; + struct cdfval_base_t { bool off; const char *string; int64_t number; - const cdfval_base_t& operator()( const YDFLTYPE& loc ); + const cdfval_base_t& operator()( const cbl_loc_t& loc ); }; struct cdf_arg_t { @@ -101,6 +103,7 @@ struct cdfval_t : public cdfval_base_t { cdfval_base_t::string = NULL; cdfval_base_t::number = value; } +#if GCC_TYPES explicit cdfval_t( const REAL_VALUE_TYPE& r ) : lineno(yylineno), filename(cobol_filename()) { @@ -109,6 +112,7 @@ struct cdfval_t : public cdfval_base_t { HOST_WIDE_INT value = real_to_integer(&r); cdfval_base_t::number = value; } +#endif cdfval_t( const cdfval_base_t& value ) // cppcheck-suppress noExplicitConstructor : lineno(yylineno), filename(cobol_filename()) { diff --git a/gcc/cobol/copybook.h b/gcc/cobol/copybook.h index bead78eef748..9688ab789bf4 100644 --- a/gcc/cobol/copybook.h +++ b/gcc/cobol/copybook.h @@ -33,6 +33,11 @@ #else #define _COPYBOOK_H +#if defined(CDF_Y) +#define gcc_assert(x) assert(x) +void gcc_unreachable(void); +#endif + FILE * copy_mode_start(); const char * cobol_filename(); @@ -60,7 +65,7 @@ class copybook_t; class copybook_elem_t { friend copybook_t; struct copybook_loc_t { - YYLTYPE loc; + cbl_loc_t loc; const char *name; copybook_loc_t() : loc(), name(NULL) {} } source, library; @@ -126,6 +131,11 @@ private: char *regex_text; }; +#ifndef TOUPPER +#define CTOUPPER(S) ::toupper(S) +#define TOUPPER(S) CTOUPPER(S) +#endif + class uppername_t { std::string upper; public: @@ -136,6 +146,11 @@ class uppername_t { const char *data() const { return upper.data(); } }; +#ifdef CTOUPPER +#undef CTOUPPER +#undef TOUPPER +#endif + class copybook_t { std::list<const char *> directories; copybook_elem_t book; @@ -156,13 +171,13 @@ class copybook_t { void suppress( bool tf = true ) { book.suppress = tf; } bool suppressed() { return book.suppress; } - void source( const YYLTYPE& loc, const char name[] ) { + void source( const cbl_loc_t& loc, const char name[] ) { book.source.loc = loc; book.literally.source = copybook_elem_t::quoted(name); book.source.name = book.literally.source? copybook_elem_t::dequote(name) : transform_name(name); } - void library( const YYLTYPE& loc, const char name[] ) { + void library( const cbl_loc_t& loc, const char name[] ) { book.library.loc = loc; book.literally.library = copybook_elem_t::quoted(name); book.library.name = book.literally.library? @@ -177,7 +192,7 @@ class copybook_t { const char *source() const { return book.source.name; } const char *library() const { return book.library.name; } - int open(YYLTYPE loc, const char name[]) { + int open(cbl_loc_t loc, const char name[]) { int fd = -1; book.clear(); this->source(loc, name); diff --git a/gcc/cobol/exceptg.h b/gcc/cobol/exceptg.h index 80432a04eb7e..815c9b42577f 100644 --- a/gcc/cobol/exceptg.h +++ b/gcc/cobol/exceptg.h @@ -36,6 +36,8 @@ extern const char * ec_type_str( ec_type_t type ); extern ec_disposition_t ec_type_disposition( ec_type_t type ); +struct cbl_label_t; + extern void declarative_runtime_match( const std::list<cbl_declarative_t>& declaratives, cbl_label_t *lave ); diff --git a/gcc/cobol/gcobc b/gcc/cobol/gcobc index 8bc78f79aaf1..754a2b4da491 100755 --- a/gcc/cobol/gcobc +++ b/gcc/cobol/gcobc @@ -200,8 +200,6 @@ do continue fi - #cho "next arg: $opt" >&2 - case $opt in # pass next parameter to GCC @@ -233,7 +231,7 @@ do -echo) echo="echo" ;; - -fec=*) + -fec=* | -fno-ec=*) opt="$(echo "$opt" | sed -E 's/-f(no-)?ec=/-f\1cobol-exceptions=EC-/g')" opts="$opts $opt" ;; diff --git a/gcc/cobol/gcobol.1 b/gcc/cobol/gcobol.1 index 2fed7b713ced..97426966b525 100644 --- a/gcc/cobol/gcobol.1 +++ b/gcc/cobol/gcobol.1 @@ -157,9 +157,9 @@ output to indicate where copybook files were included. For line-number consistency with the input, blank lines are retained. .Pp Unlike the C compiler, This option does not prevent compilation. -To prevent compilation, use the option -.D1 Fl Sy fsyntax-only -also. +To prevent compilation, use the +.Fl Sy fsyntax-only +option. .It Fl fdefaultbyte Ns Li = Ns Ar value Use .Ar value , diff --git a/gcc/cobol/genapi.cc b/gcc/cobol/genapi.cc index a02d7df46920..f883ab41f6e1 100644 --- a/gcc/cobol/genapi.cc +++ b/gcc/cobol/genapi.cc @@ -7379,7 +7379,7 @@ parser_see_stop_run(struct cbl_refer_t exit_status, void parser_label_label(struct cbl_label_t *label) { - label->lain = yylineno; + label->lain = cobol_location().first_line; Analyze(); SHOW_PARSE { diff --git a/gcc/cobol/lang.opt b/gcc/cobol/lang.opt index f72277da1ca3..faf657be8aa8 100644 --- a/gcc/cobol/lang.opt +++ b/gcc/cobol/lang.opt @@ -22,6 +22,13 @@ ; Please try to keep this file in ASCII collating order. +; After modifying any *.opt file, including this one, also update the +; documentation with: +; +; make regenerate-opt-urls +; +; and include the *.opt.urls changes in the patch. + Language Cobol diff --git a/gcc/cobol/lexio.cc b/gcc/cobol/lexio.cc index d537e3f3fdba..40219955ba68 100644 --- a/gcc/cobol/lexio.cc +++ b/gcc/cobol/lexio.cc @@ -520,7 +520,7 @@ struct replacing_term_t { {} }; -extern YYLTYPE yylloc; +extern cbl_loc_t yylloc; static const char * last_newline (const char *p, const char *pend ) { @@ -934,9 +934,9 @@ struct copy_descr_t { : parsed(false), fd(-1), nreplace(0), partial_line(line, eol) {} }; -static YYLTYPE +static cbl_loc_t location_in( const filespan_t& mfile, const csub_match& cm ) { - YYLTYPE loc { + cbl_loc_t loc { int(mfile.lineno() + 1), int(mfile.colno() + 1), int(mfile.lineno() + 1), int(mfile.colno() + 1) }; @@ -1024,10 +1024,10 @@ parse_copy_directive( filespan_t& mfile ) { bool replacing = !cm[20].matched; if( library_name.matched ) { - YYLTYPE loc = location_in( mfile, library_name ); + cbl_loc_t loc = location_in( mfile, library_name ); copybook.library( loc, xstrndup(library_name.first, library_name.length()) ); } - YYLTYPE loc = location_in( mfile, copybook_name ); + cbl_loc_t loc = location_in( mfile, copybook_name ); outcome.fd = copybook.open( loc, xstrndup(copybook_name.first, copybook_name.length()) ); if( outcome.fd == -1 ) { // let parser report missing copybook diff --git a/gcc/cobol/lexio.h b/gcc/cobol/lexio.h index 03d97550f2b4..4a7496ef9ee4 100644 --- a/gcc/cobol/lexio.h +++ b/gcc/cobol/lexio.h @@ -181,8 +181,8 @@ struct filespan_t : public bytespan_t { return p == eol; } - YYLTYPE as_location() const { - YYLTYPE loc; + cbl_loc_t as_location() const { + cbl_loc_t loc; loc.first_line = loc.last_line = 1 + iline; loc.first_column = loc.last_column = 1 + icol; diff --git a/gcc/cobol/messages.cc b/gcc/cobol/messages.cc index 1c572307b4fb..a6178e574205 100644 --- a/gcc/cobol/messages.cc +++ b/gcc/cobol/messages.cc @@ -285,7 +285,7 @@ cbl_diagnostic_option( cbl_diag_id_t id ) { * the framework. */ extern int yychar; -extern YYLTYPE yylloc; +extern cbl_loc_t yylloc; static const diagnostics::option_id option_zero; @@ -326,10 +326,7 @@ bool cbl_message( cbl_loc_t loc, cbl_diag_id_t id, const char gmsgid[], ... ) { gcc_location_set(yylloc); // use lookahead location } - explicit temp_loc_t( const YYLTYPE& loc) : orig(current_token_location()) { - gcc_location_set(loc); - } - explicit temp_loc_t( const YDFLTYPE& loc) : orig(current_token_location()) { + explicit temp_loc_t( const cbl_loc_t& loc) : orig(current_token_location()) { gcc_location_set(loc); } ~temp_loc_t() { diff --git a/gcc/cobol/parse.y b/gcc/cobol/parse.y index e0d1620a7724..04a6c966c7a1 100644 --- a/gcc/cobol/parse.y +++ b/gcc/cobol/parse.y @@ -329,7 +329,13 @@ class locale_tgt_t { #include "inspect.h" } +%define api.location.type {cbl_loc_t} + %{ +// yyssa never freed: +// https://lists.nongnu.org/archive/html/help-bison/2021-01/msg00021.html +#pragma GCC diagnostic ignored "-Wfree-nonheap-object" + #include "config.h" #include <fstream> // Before cobol-system because it uses poisoned functions #include "cobol-system.h" @@ -934,7 +940,7 @@ class locale_tgt_t { declarative_list_t* dcl_list_t; isym_list_t* isym_list; struct { bool is_float; radix_t radix; char *string; } numstr; - struct { YYLTYPE loc; int token; literal_t name; } prog_end; + struct { cbl_loc_base_t loc; int token; literal_t name; } prog_end; struct { int token; special_name_t id; } special_type; struct { char locale_type; const char * name; } locale_phrase; coll_alphanat_t char_class_locales; @@ -1005,13 +1011,13 @@ class locale_tgt_t { struct cbl_ffi_arg_t *ffi_arg; struct ffi_args_t *ffi_args; - struct { YYLTYPE loc; cbl_refer_t *ffi_name, *ffi_returning; + struct { cbl_loc_base_t loc; cbl_refer_t *ffi_name, *ffi_returning; ffi_args_t *using_params; } ffi_impl; struct { bool common, initial, recursive; } comminit; struct { enum select_clause_t clause; cbl_file_t *file; } select_clause; struct { size_t clauses; cbl_file_t *file; } select_clauses; - struct { YYLTYPE loc; char *on, *off; } switches; + struct { cbl_loc_base_t loc; char *on, *off; } switches; struct { cbl_encoding_t encoding; cbl_domain_t *domain; } false_domain; struct { size_t also; unsigned char *low, *high; } colseq; struct { cbl_field_attr_t attr; int nbyte; } pic_part; @@ -1543,7 +1549,7 @@ class locale_tgt_t { cbl_field_t * new_literal( const cbl_loc_t loc, const literal_t& lit, enum cbl_field_attr_t attr ); - static YYLTYPE first_line_of( YYLTYPE loc ); + static cbl_loc_t first_line_of( cbl_loc_t loc ); %} %locations @@ -3308,8 +3314,7 @@ file_descrs: file_descr | file_descrs file_descr ; file_descr: fd_name '.' { field_done(); } fields - | fd_name fd_clauses '.' { field_done(); } - fields + | fd_name fd_clauses '.' { field_done(); } fields ; fd_name: FD NAME { $$ = file_section_fd_set(fd_e, $2, @2); } @@ -4383,8 +4388,7 @@ data_descr1: level_name $field->blank_initial($field->char_capacity()); } $field->encode_numeric($field->data.original(), - data_clause_locations[value_clause_e], - $field->data.original_numeric()); + data_clause_locations[value_clause_e]); } } } else { // no VALUE clause @@ -5526,7 +5530,9 @@ declaratives: %empty parser_label_label($label); enabled_exceptions = current.enabled_exception_cache; current.enabled_exception_cache.clear(); - ast_enter_section(implicit_section()); + cbl_loc_t loc(@4); // the dot + loc.first_line++; + ast_enter_section(loc, implicit_section()); } ; @@ -5542,7 +5548,7 @@ sentences: sentence { if( !label ) { YYERROR; } - ast_enter_paragraph(label); + ast_enter_paragraph(@para, label); current.new_paragraph(label); apply_declaratives(); } @@ -5559,7 +5565,7 @@ sentences: sentence { if( !label ) { YYERROR; } - ast_enter_paragraph(label); + ast_enter_paragraph(@para, label); current.new_paragraph(label); apply_declaratives(); } @@ -7905,14 +7911,14 @@ section_name: NAME section_kw '.' { statement_begin(@1, SECTION); $$ = label_add(@1, LblSection, $1); - ast_enter_section($$); + ast_enter_section(@1, $$); apply_declaratives(); } | NAME section_kw // lexer swallows '.' before USE <label>{ statement_begin(@1, SECTION); $$ = label_add(@1, LblSection, $1); - ast_enter_section($$); + ast_enter_section(@1, $$); apply_declaratives(); } [label] cdf_use dot @@ -8345,7 +8351,7 @@ perform_when1: WHEN perform_ec { []( const cbl_declarative_t *p ) { return *p; } ); - ast_enter_paragraph(when); + ast_enter_paragraph(@WHEN, when); } statements { parser_exit_paragraph(); @@ -8433,12 +8439,12 @@ except_files: except_name[ec] FILE_KW filenames { perform_ec_other: %empty %prec WHEN { const auto& ec_labels( perform_current()->ec_labels ); - ast_enter_paragraph(ec_labels.other); + ast_enter_paragraph(@$, ec_labels.other); parser_exit_paragraph(); } | WHEN OTHER { const auto& ec_labels( perform_current()->ec_labels ); - ast_enter_paragraph(ec_labels.other); + ast_enter_paragraph(@$, ec_labels.other); } exception statements %prec WHEN { parser_exit_paragraph(); @@ -8447,12 +8453,12 @@ perform_ec_other: perform_ec_common: %empty { const auto& ec_labels( perform_current()->ec_labels ); - ast_enter_paragraph(ec_labels.common); + ast_enter_paragraph(@$, ec_labels.common); parser_exit_paragraph(); } | WHEN COMMON { const auto& ec_labels( perform_current()->ec_labels ); - ast_enter_paragraph(ec_labels.common); + ast_enter_paragraph(@$, ec_labels.common); } exception statements { parser_exit_paragraph(); @@ -8461,13 +8467,13 @@ perform_ec_common: perform_ec_finally: %empty { const auto& ec_labels( perform_current()->ec_labels ); - ast_enter_paragraph(ec_labels.finally); + ast_enter_paragraph(@$, ec_labels.finally); parser_exit_paragraph(); parser_label_goto(ec_labels.fini); } | FINALLY { const auto& ec_labels( perform_current()->ec_labels ); - ast_enter_paragraph(ec_labels.finally); + ast_enter_paragraph(@$, ec_labels.finally); } exception statements { parser_exit_paragraph(); @@ -10744,7 +10750,7 @@ label_1: qname isect = symbol_index(symbol_elem_of(sect)); } - $$ = paragraph_reference(para, isect); + $$ = paragraph_reference(@1, para, isect); assert($$); dbgmsg( "using procedure %s of line %d", $$->name, $$->line ); } @@ -11037,7 +11043,7 @@ function_call: function intrinsic { // "intrinsic" includes UDFs. ; function: %empty %prec FUNCTION - { // typed_name in scan_ante.h allows FUNCTION keywod to be ommitted. + { // typed_name in scan_ante.h allows FUNCTION keyword to be ommitted. statement_begin(@$, FUNCTION); } | FUNCTION @@ -12546,8 +12552,8 @@ end_xml: %empty %prec XMLPARSE ; %% -static YYLTYPE -first_line_of( YYLTYPE loc ) { +static cbl_loc_t +first_line_of( cbl_loc_t loc ) { if( loc.first_line < loc.last_line ) loc.last_line = loc.first_line; if( loc.last_column < loc.first_column ) loc.last_column = loc.first_column; return loc; @@ -12712,7 +12718,8 @@ verify_args( const YYLTYPE& loc, } } -void ast_call( const YYLTYPE& loc, cbl_refer_t name, const cbl_refer_t& returning, +static void +ast_call( const cbl_loc_t& loc, cbl_refer_t name, const cbl_refer_t& returning, size_t narg, cbl_ffi_arg_t args[], cbl_label_t *except, cbl_label_t *not_except, @@ -12789,7 +12796,7 @@ statement_prolog( int token ) { * parsed. */ static void -statement_begin( const YYLTYPE& loc, int token ) { +statement_begin( const cbl_loc_t& loc, int token ) { static int prior_token = 0; if( statement_cleanup ) { @@ -13062,7 +13069,7 @@ typedef label_named<LblSection> section_named; typedef label_named<LblParagraph> paragraph_named; static struct cbl_label_t * -label_add( const YYLTYPE& loc, +label_add( const cbl_loc_t& loc, enum cbl_label_type_t type, const char name[] ) { size_t parent = 0; @@ -13108,7 +13115,7 @@ label_add( const YYLTYPE& loc, */ static struct cbl_label_t * label_add( enum cbl_label_type_t type, const char name[], int line ) { - YYLTYPE loc { line, 1, line, 1 }; + cbl_loc_t loc { line, 1, line, 1 }; return label_add(loc, type, name); } @@ -13149,7 +13156,7 @@ perform_t::ec_labels_t::new_label( cbl_label_type_t type, * detects and corrects its misstep. */ static struct cbl_label_t * -paragraph_reference( const char name[], size_t section ) +paragraph_reference( const cbl_loc_t& loc, const char name[], size_t section ) { // A reference has line == 0. It is LblParagraph if the section is // explicitly named, else LblNone (because we don't know). @@ -13160,8 +13167,13 @@ paragraph_reference( const char name[], size_t section ) p = symbol_label_add(PROGRAM, &label); assert(p); - + const char *para_name = p->name; const char *sect_name = section? cbl_label_of(symbol_at(section))->name : NULL; + + match_proc::statement_compose( loc.first_line, + current.program_section(), + para_name, sect_name ); + procedure_reference_add(sect_name, p->name, yylineno, current.program_section()); return p; @@ -13308,7 +13320,7 @@ function_descr_t::init( int isym, bool prototype ) { function_descr_t descr = { FUNCTION_UDF_0 }; descr.ret_type = FldInvalid; const auto L = cbl_label_of(symbol_at(isym)); - bool ok = namcpy(YYLTYPE(), descr.name, L->name); + bool ok = namcpy(cbl_loc_t(), descr.name, L->name); descr.prototype = prototype; gcc_assert(ok); return descr; @@ -13389,7 +13401,7 @@ cbl_key_t::operator=( const sort_key_t& that ) { } static cbl_refer_t * -ast_op( YYLTYPE loc, cbl_refer_t *lhs, char op, cbl_refer_t *rhs ) { +ast_op( const cbl_loc_t& loc, cbl_refer_t *lhs, char op, cbl_refer_t *rhs ) { assert(lhs); assert(rhs); if( ! (is_numeric(lhs->field) && is_numeric(rhs->field)) ) { @@ -13580,7 +13592,7 @@ data_section_str( data_section_t section ) { } static bool -current_data_section_set(const YYLTYPE& loc, data_section_t data_section ) { +current_data_section_set(const cbl_loc_t& loc, data_section_t data_section ) { // order is mandatory if( data_section < current_data_section ) { error_msg(loc, "%s SECTION must precede %s SECTION", @@ -13648,8 +13660,8 @@ lang_check_failed (const char* file, int line, const char* function) {} #pragma GCC diagnostic pop -void -ast_inspect( YYLTYPE loc, cbl_refer_t& input, bool backward, +static void +ast_inspect( cbl_loc_t loc, cbl_refer_t& input, bool backward, cbl_inspect_opers_t& inspects ) { if( yydebug ) { @@ -13959,9 +13971,7 @@ initialize_one( cbl_num_result_t target, bool with_filler, { cbl_refer_t& tgt( target.refer ); if( ! valid_target(tgt) ) return false; -#if 0 - if( field_index(target.refer.field) == return_code_register() ) return true; -#endif + // Rule 1 c: is valid for VALUE, REPLACING, or DEFAULT // If no VALUE (category none), set to blank/zero. if( value_category == data_category_none && replacements.empty() ) { @@ -14548,7 +14558,7 @@ cobol_dialect_set( cbl_dialect_t dialect ) { break; case dialect_gnu_e: if( 0 == (cbl_dialects & dialect) ) { // first time - cdf_tokens.equate(YYLTYPE(), "BINARY-DOUBLE", "BINARY-C-LONG"); + cdf_tokens.equate(cbl_loc_t(), "BINARY-DOUBLE", "BINARY-C-LONG"); } break; } @@ -14575,7 +14585,9 @@ cobol_gcobol_feature_set( cbl_gcobol_feature_t gcobol_feature, bool on ) { } static bool -literal_refmod_valid( YYLTYPE loc, const cbl_refer_t& r ) { +literal_refmod_valid( cbl_loc_t loc, const cbl_refer_t& r ) { + if( r.field->has_attr(any_length_e) ) return true; + unsigned int nchar = r.field->char_capacity(); const cbl_span_t& refmod(r.refmod); @@ -14646,7 +14658,7 @@ const cbl_field_t * literal_subscript_oob( const cbl_refer_t& r, size_t& isub ); static bool -literal_subscripts_valid( YYLTYPE loc, const cbl_refer_t& name ) { +literal_subscripts_valid( cbl_loc_t loc, const cbl_refer_t& name ) { size_t isub; // Report any out-of-bound subscript. @@ -14683,7 +14695,7 @@ literal_subscripts_valid( YYLTYPE loc, const cbl_refer_t& name ) { } static void -subscript_dimension_error( YYLTYPE loc, size_t nsub, const cbl_refer_t *scalar ) { +subscript_dimension_error( cbl_loc_t loc, size_t nsub, const cbl_refer_t *scalar ) { if( 0 == dimensions(scalar->field) ) { error_msg(loc, "%zu subscripts provided for %s, " "which has no dimensions", @@ -14696,14 +14708,14 @@ subscript_dimension_error( YYLTYPE loc, size_t nsub, const cbl_refer_t *scalar ) } static void -reject_refmod( YYLTYPE loc, const cbl_refer_t& scalar ) { +reject_refmod( cbl_loc_t loc, const cbl_refer_t& scalar ) { if( scalar.is_refmod_reference() ) { error_msg(loc, "%s cannot be reference-modified here", scalar.name()); } } static bool -require_pointer( YYLTYPE loc, const cbl_refer_t& scalar ) { +require_pointer( cbl_loc_t loc, const cbl_refer_t& scalar ) { if( scalar.field->type != FldPointer ) { error_msg(loc, "%s must have USAGE POINTER", scalar.name()); return false; @@ -14712,7 +14724,7 @@ require_pointer( YYLTYPE loc, const cbl_refer_t& scalar ) { } static bool -require_numeric( YYLTYPE loc, const cbl_refer_t& scalar ) { +require_numeric( cbl_loc_t loc, const cbl_refer_t& scalar ) { if( ! is_numeric(scalar.field) ) { error_msg(loc, "%s must have numeric USAGE", scalar.name()); return false; @@ -14721,7 +14733,7 @@ require_numeric( YYLTYPE loc, const cbl_refer_t& scalar ) { } static bool -require_integer( YYLTYPE loc, const cbl_refer_t& scalar ) { +require_integer( cbl_loc_t loc, const cbl_refer_t& scalar ) { if( is_literal(scalar.field) ) { if( ! is_integer_literal(scalar.field) ) { error_msg(loc, "numeric literal '%s' must be an integer", @@ -14865,7 +14877,7 @@ eval_subject_t::compare( const cbl_refer_t& object, * Do not set initial value; that is up to PICTURE and VALUE. */ static cbl_field_type_t -field_binary_usage( YYLTYPE loc, cbl_field_t *field, +field_binary_usage( cbl_loc_t loc, cbl_field_t *field, cbl_field_type_t type, uint32_t capacity, bool signable ) { diff --git a/gcc/cobol/parse_ante.h b/gcc/cobol/parse_ante.h index c7311d3f76d8..4d55172d2f83 100644 --- a/gcc/cobol/parse_ante.h +++ b/gcc/cobol/parse_ante.h @@ -42,7 +42,7 @@ #pragma GCC diagnostic push #pragma GCC diagnostic ignored "-Wmissing-field-initializers" -extern YYLTYPE yylloc; +extern cbl_loc_t yylloc; extern int yylineno, yyleng, yychar; extern char *yytext; @@ -198,7 +198,7 @@ enum data_section_t { // values reflect mandatory order linkage_datasect_e, } current_data_section; -static bool current_data_section_set( const YYLTYPE& loc, enum data_section_t ); +static bool current_data_section_set( const cbl_loc_t& loc, enum data_section_t ); enum data_clause_t { picture_clause_e = 0x0001, @@ -261,7 +261,7 @@ static int intrinsic_token_of( const char name[] ); static inline bool -namcpy(const YYLTYPE& loc, cbl_name_t tgt, const char *src ) { +namcpy(const cbl_loc_t& loc, cbl_name_t tgt, const char *src ) { // snprintf(3): writes at most size bytes (including the terminating NUL byte) auto len = snprintf(tgt, sizeof(cbl_name_t), "%s", src); if( ! (0 < len && len < int(sizeof(cbl_name_t))) ) { @@ -285,9 +285,9 @@ new_reference_like( const cbl_field_t& skel ) { return new cbl_refer_t( new_temporary_like(skel) ); } -static void reject_refmod( YYLTYPE loc, const cbl_refer_t& ); -static bool require_pointer( YYLTYPE loc, const cbl_refer_t& ); -static bool require_integer( YYLTYPE loc, const cbl_refer_t& ); +static void reject_refmod( cbl_loc_t loc, const cbl_refer_t& ); +static bool require_pointer( cbl_loc_t loc, const cbl_refer_t& ); +static bool require_integer( cbl_loc_t loc, const cbl_refer_t& ); struct cbl_field_t * constant_of( size_t isym ); @@ -510,7 +510,7 @@ static class file_start_args_t { cbl_file_t *file; public: file_start_args_t() : file(NULL) {} - cbl_file_t * init( YYLTYPE loc, cbl_file_t *file ) { + cbl_file_t * init( cbl_loc_t loc, cbl_file_t *file ) { this->file = file; if( is_sequential(file) ) { error_msg(loc, "START invalid with sequential file %s", file->name); @@ -618,7 +618,7 @@ struct arith_t { } }; -static cbl_refer_t * ast_op( YYLTYPE loc, +static cbl_refer_t * ast_op( const cbl_loc_t& loc, cbl_refer_t *lhs, char op, cbl_refer_t *rhs ); static void ast_add( arith_t *arith ); @@ -874,9 +874,10 @@ perform_current(void) { } static inline perform_t * - perform_tgt_set( cbl_label_t *from, cbl_label_t *to = NULL ) { +perform_tgt_set( cbl_label_t *from, cbl_label_t *to = NULL ) { struct perform_t *perf = perform_current(); perf->tgt = cbl_perform_tgt_t(from, to); + match_proc::statement_add(); return perf; } @@ -934,12 +935,12 @@ struct tgt_list_t { }; static struct cbl_label_t * -label_add( const YYLTYPE& loc, enum cbl_label_type_t type, const char name[] ); +label_add( const cbl_loc_t& loc, enum cbl_label_type_t type, const char name[] ); static struct cbl_label_t * label_add( enum cbl_label_type_t type, const char name[], int line ); static struct cbl_label_t * -paragraph_reference( const char name[], size_t section ); +paragraph_reference( const cbl_loc_t& loc, const char name[], size_t section ); static inline void list_add( list<cbl_num_result_t>& list, const cbl_refer_t& refer, int round ) { @@ -990,7 +991,7 @@ tee_up_empty() { name_queue.allocate(); } void -tee_up_name( const YYLTYPE& loc, const char name[] ) { +tee_up_name( const cbl_loc_t& loc, const char name[] ) { name_queue.push(loc, name); } cbl_namelist_t @@ -1139,8 +1140,9 @@ struct refer_collection_t { } }; -void ast_inspect( YYLTYPE loc, cbl_refer_t& input, bool backward, - cbl_inspect_opers_t& inspects ); +static void +ast_inspect( cbl_loc_t loc, cbl_refer_t& input, bool backward, + cbl_inspect_opers_t& inspects ); template <typename E> struct elem_list_t { @@ -1696,8 +1698,8 @@ class log_expr_t { } }; -static void ast_enter_section( cbl_label_t * ); -static void ast_enter_paragraph( cbl_label_t * ); +static void ast_enter_section( const cbl_loc_t& loc, cbl_label_t * ); +static void ast_enter_paragraph( const cbl_loc_t& loc, cbl_label_t * ); static class current_t { friend cbl_options_t current_options(); @@ -2026,7 +2028,7 @@ static class current_t { return __gg__encoding_iconv_name(encoding); } - bool new_program ( const YYLTYPE& loc, cbl_label_type_t type, + bool new_program ( const cbl_loc_t& loc, cbl_label_type_t type, const char name[], const char os_name[], bool common, bool initial, bool recursive, bool prototype = false ) @@ -2103,7 +2105,7 @@ static class current_t { return programs.empty()? NULL : programs.top().paragraph; } - bool is_first_statement( const YYLTYPE& loc ) { + bool is_first_statement( const cbl_loc_t& loc ) { if( ! in_declaratives && first_statement == 0 ) { auto eval = programs.top().declaratives_eval; if( eval ) { @@ -2137,6 +2139,8 @@ static class current_t { assert(!programs.empty()); + match_proc::statements_verify(); + const procref_t *ref = ambiguous_reference(program_index()); std::set<std::string> externals = programs.top().external_targets(); @@ -2151,7 +2155,6 @@ static class current_t { static std::unordered_set<size_t> callers_we_have_seen; if( programs.size() == 1 ) { - if( yydebug ) parser_call_targets_dump(); for( size_t caller : symbol_program_programs() ) { // We are running through the entire growing list of called programs // at the point of each END PROGRAM. This confuses the name changing @@ -2190,7 +2193,7 @@ static class current_t { error_clients.clear(); exception_clients.clear(); - if( ref ) { + if( false && ref ) { cbl_message(ParUnresolvedProcE, "could not resolve paragraph (or section) '%s' at line %d", ref->paragraph(), ref->line_number()); @@ -2233,7 +2236,7 @@ static class current_t { eval_label = label_add(LblSection, eval, yylineno); struct cbl_label_t * lave_label = label_add(LblSection, lave, yylineno); - ast_enter_section(eval_label); + ast_enter_section(cobol_location(), eval_label); declarative_runtime_match(declaratives.as_list(), lave_label); @@ -2433,7 +2436,7 @@ static bool is_allowed_name( size_t isym, const cbl_label_t *L ) { } static void // add self to prototype map -prototype_add( const YYLTYPE& loc, const std::list<cbl_ffi_arg_t>& args ) { +prototype_add( const cbl_loc_t& loc, const std::list<cbl_ffi_arg_t>& args ) { auto L = cbl_label_of(symbol_at(PROGRAM)); if( is_allowed_name(PROGRAM, L) ) { // parser uses a list @@ -2482,7 +2485,7 @@ prototype_args( const char *name, size_t esym ) { } static void -verify_args( const YYLTYPE& loc, +verify_args( const cbl_loc_t& loc, const char name[], size_t narg, const cbl_ffi_arg_t args[] ); @@ -2573,7 +2576,7 @@ static relop_t relop_invert(relop_t op); static enum classify_t classify_of( int token ); -static void subscript_dimension_error( YYLTYPE loc, size_t, const cbl_refer_t *name ); +static void subscript_dimension_error( cbl_loc_t loc, size_t, const cbl_refer_t *name ); /* * Utility functions @@ -2607,9 +2610,9 @@ bool move_corresponding( cbl_refer_t& tgt, cbl_refer_t& src ); static bool -literal_subscripts_valid( YYLTYPE loc, const cbl_refer_t& name ); +literal_subscripts_valid( cbl_loc_t loc, const cbl_refer_t& name ); static bool -literal_refmod_valid( YYLTYPE loc, const cbl_refer_t& r ); +literal_refmod_valid( cbl_loc_t loc, const cbl_refer_t& r ); static bool is_integer_literal( const cbl_field_t *field ) { @@ -2712,16 +2715,6 @@ is_callable( const cbl_field_t *field ) { /* * intrinsic calls */ -struct cbl_fieldloc_t { - YYLTYPE loc; - cbl_field_t *field; - - cbl_fieldloc_t() : loc{ 1,1, 1,1 }, field(NULL) {} - cbl_fieldloc_t( const YYLTYPE& loc, cbl_field_t *field ) - : loc(loc), field(field) - {} -}; - static size_t intrinsic_invalid_parameter( int token, const std::vector<cbl_refer_t>& args ); @@ -2738,7 +2731,7 @@ intrinsic_call_0( cbl_field_t *output, int token ) { static bool intrinsic_call_1( cbl_field_t *output, int token, - cbl_refer_t *r1, const YYLTYPE& loc ) { + cbl_refer_t *r1, const cbl_loc_t& loc ) { std::vector<cbl_refer_t> args { *r1 }; if( 0 == intrinsic_invalid_parameter(token, args) ) { error_msg(loc, "invalid parameter '%s'", r1->field->name); @@ -2878,7 +2871,7 @@ field_find( cbl_loc_t loc, const std::list<const char *>& names ) { } static inline symbol_elem_t * -symbol_find( const YYLTYPE& loc, const char *name ) { +symbol_find( const cbl_loc_t& loc, const char *name ) { cbl_namelist_t names; if( ! name_queue.empty() ) { auto names = name_queue.pop_as_names(); @@ -2900,7 +2893,7 @@ register_find( const char *name ) { } static bool -valid_redefine( const YYLTYPE& loc, +valid_redefine( const cbl_loc_t& loc, const cbl_field_t *field, const cbl_field_t *orig ) { // Must have same level. if( field->level != orig->level ) { @@ -3042,7 +3035,7 @@ group_attr( const cbl_field_t * field ) { } static struct cbl_field_t * -field_add( const YYLTYPE& loc, cbl_field_t *field ) { +field_add( const cbl_loc_t& loc, cbl_field_t *field ) { switch(current_data_section) { case not_data_datasect_e: case file_datasect_e: @@ -3120,7 +3113,7 @@ uniform_picture( const char *picture ) { static bool field_type_update( cbl_field_t *field, cbl_field_type_t type, - YYLTYPE loc, + cbl_loc_t loc, bool is_usage = false) { // preserve NumericEdited if already established @@ -3161,7 +3154,7 @@ field_type_update( cbl_field_t *field, cbl_field_type_t type, } static bool -field_capacity_error( const YYLTYPE& loc, const cbl_field_t *field ) { +field_capacity_error( const cbl_loc_t& loc, const cbl_field_t *field ) { uint32_t parent_capacity = 0; if( field->parent ) { auto e = symbol_at(field->parent); @@ -3262,7 +3255,7 @@ cbl_field_t::set_initial( const cbl_loc_t& loc ) { #pragma GCC diagnostic ignored "-Wmissing-field-initializers" static struct cbl_field_t * -field_alloc( const YYLTYPE& loc, cbl_field_type_t type, size_t parent, const char name[] ) { +field_alloc( const cbl_loc_t& loc, cbl_field_type_t type, size_t parent, const char name[] ) { static const uint32_t level = 0; cbl_field_t *f, field = { type, 0, cbl_field_data_t(), level, name, yylineno }; field.parent = parent; @@ -3279,7 +3272,7 @@ static const cbl_file_t protofile; #pragma GCC diagnostic push #pragma GCC diagnostic ignored "-Wformat-truncation" static cbl_file_t * -file_add( YYLTYPE loc, cbl_file_t *file ) { +file_add( cbl_loc_t loc, cbl_file_t *file ) { gcc_assert(file); enum { level = 1 }; struct cbl_field_t area{ FldAlphanumeric, level, yylineno }, @@ -3316,7 +3309,7 @@ alphabet_add( const cbl_alphabet_t& alphabet ) { return cbl_alphabet_of(e); } static cbl_alphabet_t * -alphabet_add( const YYLTYPE& loc, cbl_encoding_t encoding ) { +alphabet_add( const cbl_loc_t& loc, cbl_encoding_t encoding ) { cbl_alphabet_t alphabet(loc, encoding); return alphabet_add(alphabet); } @@ -3353,7 +3346,7 @@ current_field(cbl_field_t * field = NULL) { } static void -set_real_from_capacity( const YYLTYPE& loc, +set_real_from_capacity( const cbl_loc_t& loc, cbl_field_t *field, REAL_VALUE_TYPE *r ) { if( field == current_field() ) { @@ -3527,9 +3520,9 @@ ast_enter_exit_section( cbl_label_t * section ) { } static inline void -ast_enter_section( cbl_label_t * section ) { +ast_enter_section( const cbl_loc_t& loc, cbl_label_t * section ) { assert(section); - section->lain = yylineno; + section->lain = loc.first_line; ast_enter_exit_section( section ); } @@ -3539,8 +3532,8 @@ ast_exit_section() { } static void -ast_enter_paragraph( cbl_label_t * para ) { - para->lain = yylineno; +ast_enter_paragraph( const cbl_loc_t& loc, cbl_label_t * para ) { + para->lain = loc.first_line;; cbl_label_t *prior = current.new_paragraph(para); if( prior ) { parser_leave_paragraph(prior); @@ -3609,7 +3602,7 @@ anybody_redefines( const cbl_field_t *tree ) } static bool -procedure_division_ready( YYLTYPE loc, cbl_field_t *returning, ffi_args_t *ffi_args ) { +procedure_division_ready( const cbl_loc_t& loc, cbl_field_t *returning, ffi_args_t *ffi_args ) { auto prog = cbl_label_of(symbols_begin(current.program_index())); if( prog->type == LblFunction ) { @@ -3753,12 +3746,12 @@ procedure_division_ready( YYLTYPE loc, cbl_field_t *returning, ffi_args_t *ffi_a parser_label_goto(tini_label); // And here we create the initialization section: - ast_enter_section(init_label); // _INITIALIZE_PROGRAM section. + ast_enter_section(loc, init_label); // _INITIALIZE_PROGRAM section. parser_init_list(); // Lay down an implicit section to end the init_label - ast_enter_section(implicit_section()); + ast_enter_section(loc, implicit_section()); // This is the end of the island parser_label_label(tini_label); @@ -3774,7 +3767,7 @@ static size_t file_section_fd; static size_t current_sort_file; static size_t -file_section_fd_set( file_entry_type_t type, char name[], const YYLTYPE& loc ) { +file_section_fd_set( file_entry_type_t type, char name[], const cbl_loc_t& loc ) { static std::set<size_t> has_fd; // File must have been uniquely created by SELECT. @@ -3829,12 +3822,13 @@ file_section_parent_set( cbl_field_t *field ) { return file_section_fd > 0; } -void ast_call(const YYLTYPE& loc, cbl_refer_t name, - const cbl_refer_t& returning, - size_t narg, cbl_ffi_arg_t args[], - cbl_label_t *except, - cbl_label_t *not_except, - bool is_function ); +static void +ast_call(const cbl_loc_t& loc, cbl_refer_t name, + const cbl_refer_t& returning, + size_t narg, cbl_ffi_arg_t args[], + cbl_label_t *except, + cbl_label_t *not_except, + bool is_function ); cbl_field_t * ast_file_status_between( file_status_t lower, file_status_t upper ); @@ -3843,19 +3837,20 @@ void internal_ebcdic_lock(); void internal_ebcdic_unlock(); static cbl_field_type_t -field_binary_usage( YYLTYPE loc, cbl_field_t *field, +field_binary_usage( cbl_loc_t loc, cbl_field_t *field, cbl_field_type_t type, uint32_t capacity, bool signable ); void ast_end_program(const char name[] ) { + dbgmsg("%s:%d: program labels:", __func__, __LINE__); std::for_each( symbols_begin(), symbols_end(), []( const auto& elem ) { if( elem.type == SymLabel ) { auto& L( *cbl_label_of(&elem) ); if( L.used ) { if( ! L.lain ) { - YYLTYPE loc { L.line, 1, L.line, 1 }; + cbl_loc_t loc { L.line, 1, L.line, 1 }; error_msg(loc, "line %d: %s " "is used on line %d and never defined", L.line, L.name, L.used ); @@ -3897,23 +3892,23 @@ goodnight_gracie() { // false after USE statement, to enter Declarative with EC intact. static bool statement_cleanup = true; -static YYLTYPE current_location; +static cbl_loc_t current_location; static void statement_epilog( int token ); const char * keyword_str( int token ); -const YYLTYPE& cobol_location() { return current_location; } +const cbl_loc_t& cobol_location() { return current_location; } static inline void -location_set( const YYLTYPE& loc ) { +location_set( const cbl_loc_t& loc ) { current_location = loc; gcc_location_set(loc); } -static void statement_begin( const YYLTYPE& loc, int token ); +static void statement_begin( const cbl_loc_t& loc, int token ); -static void ast_first_statement( const YYLTYPE& loc ) { +static void ast_first_statement( const cbl_loc_t& loc ) { if( current.is_first_statement( loc ) ) { parser_first_statement(loc.first_line); } diff --git a/gcc/cobol/scan.l b/gcc/cobol/scan.l index 2ffc025f332a..534754848012 100644 --- a/gcc/cobol/scan.l +++ b/gcc/cobol/scan.l @@ -210,7 +210,7 @@ LINE_DIRECTIVE ^[#]line{SPC}[[:alnum:]]+{SPC}[""''].+\n [''""]/[01] [01]+/[''""] { if( copy_state == YY_START ) { ydflval.boolean = ((*yytext == 1) ^ is_not); - return YDF_BOOL; + return cdf::parser::token::YDF_BOOL; } yylval.numstr.radix = boolean_e; yylval.numstr.string = xstrdup(yytext); @@ -230,7 +230,7 @@ LINE_DIRECTIVE ^[#]line{SPC}[[:alnum:]]+{SPC}[""''].+\n [''""]/{hdseq} {hdseq}/[''""] { if( copy_state == YY_START ) { ydflval.number = integer_of(yytext, true); - return YDF_NUMBER; + return cdf::parser::token::YDF_NUMBER; } if( 0 == yyleng % 2 ) { yylval.literal.set_data( yyleng/2, hex_decode(yytext) ); @@ -1431,7 +1431,7 @@ USE({SPC}FOR)? { return USE; } [+-]?{INTEGERZ} { int value; if( is_integer_token(&value) ) { ydflval.number = value; - return YDF_NUMBER; + return cdf::parser::token::YDF_NUMBER; } dbgmsg("%s not an integer = %d", yytext, value); diff --git a/gcc/cobol/scan_ante.h b/gcc/cobol/scan_ante.h index d046dfb7753f..bc2454b150a3 100644 --- a/gcc/cobol/scan_ante.h +++ b/gcc/cobol/scan_ante.h @@ -64,7 +64,7 @@ int repeat_count( const char picture[] ); size_t program_level(); -int ydfparse(void); +static int ydfparse(void); FILE * copy_mode_start(); @@ -118,6 +118,13 @@ static const char * start_condition_is(); static bool nonspace( char ch ) { return !ISSPACE(ch); } +cdf::parser cdf_parser; +cdf::parser::symbol_type cdf_symbol_type; +cdf::parser::context cdf_context(cdf_parser, cdf_symbol_type); + +cdf::parser::value_type ydflval; +cdf::parser::location_type ydflloc; + static int numstr_of( const char string[], radix_t radix = decimal_e ) { yylval.numstr.is_float = false; @@ -206,8 +213,6 @@ null_trim( char name[] ) { /* * CDF management */ -static int final_token; - static inline const char * boolalpha( bool tf ) { return tf? "True" : "False"; } @@ -438,33 +443,13 @@ static input_file_status_t input_file_status; void input_file_status_notify() { input_file_status.notify(); } -/* - * parse.y and cdf.y each define a 4-integer struct to hold a token's location. - * parse.y uses YYLTYPE yylloc; - * cdf.y uses YDFLLTYPE ydflloc; - * - * The structs have identical definitions with different types and of course - * names. We define "conversion" between them for convenience. - * - * Each parser expects its location value to be updated whenever it calls - * yylex(). Therefore, here in the lexer we set both locations as each token - * is scanned, so that both parsers see the same location. - */ -static YDFLTYPE -ydfltype_of( const YYLTYPE& loc ) { - YDFLTYPE output { - loc.first_line, loc.first_column, - loc.last_line, loc.last_column }; - return output; -} - /* * After the input filename and yylineno are set, update the location of the * scanned token. */ static void -update_location( const YYLTYPE *ploc = nullptr ) { - YYLTYPE loc = { +update_location( const cbl_loc_t *ploc = nullptr ) { + cbl_loc_t loc = { yylloc.last_line, yylloc.last_column, yylineno, yylloc.last_column + yyleng }; @@ -475,8 +460,7 @@ update_location( const YYLTYPE *ploc = nullptr ) { loc.last_column = (yytext + yyleng) - p; } - yylloc = loc; - ydflloc = ydfltype_of(yylloc); + ydflloc = yylloc = loc; dbgmsg(" SC: %s location (%d,%d) to (%d,%d)", start_condition_is(), @@ -486,7 +470,7 @@ update_location( const YYLTYPE *ploc = nullptr ) { static void reset_location() { - static const YYLTYPE loc { yylineno, 1, yylineno, 1 }; + static const cbl_loc_t loc { yylineno, 1, yylineno, 1 }; update_location(&loc); } @@ -536,9 +520,8 @@ update_location_col( const char str[], int correction = 0) { #define not_implemented(...) cbl_unimplemented_at(yylloc, __VA_ARGS__) #define YY_USER_INIT do { \ - static YYLTYPE ones = {1,1, 1,1}; \ - yylloc = ones; \ - ydflloc = ydfltype_of(yylloc); \ + static cbl_loc_t ones = {1,1, 1,1}; \ + ydflloc = yylloc = ones; \ } while(0) /* @@ -808,7 +791,7 @@ class picture_t { : crdb(0), currency(0), dot(0), pluses(0), minuses(0), stars(0) {} } exclusions; - YYLTYPE loc; + cbl_loc_t loc; bool is_crdb() const { // input must be uppercase for CR/DB if( p[0] == 'C' || p[0] == 'D' ) { @@ -856,7 +839,7 @@ class picture_t { if( !ch ) ch = *p; // use current character unless overridden auto valid = followers.find(TOUPPER(ch)); if( valid == followers.end() ) { - YYLTYPE loc(yylloc); + cbl_loc_t loc(yylloc); loc.first_column += int(p - begin); error_msg( loc, "PICTURE: strange character %qc, giving up", ch ); return nullptr; diff --git a/gcc/cobol/scan_post.h b/gcc/cobol/scan_post.h index 4806332bc55b..5c6002f6a258 100644 --- a/gcc/cobol/scan_post.h +++ b/gcc/cobol/scan_post.h @@ -202,6 +202,20 @@ valid_conditional_context( int token ) { return true; // all other CDF tokens valid regardless of context } +static int ydfparse() { + return cdf_parser.parse(); +} + +static inline int ydfchar() { + auto kind_type = cdf_context.lookahead().kind(); + return kind_type; +} + +void +ydfdebug( bool yn ) { + cdf_parser.set_debug_level(yn? 1 : 0); +} + static bool run_cdf( int token ) { if( ! valid_conditional_context(token) ) { @@ -211,7 +225,8 @@ run_cdf( int token ) { parsing.inject_token(token); // because it will be needed by CDF parser - if( yy_flex_debug ) dbgmsg("CDF parser start with '%s'", keyword_str(token)); + if( yy_flex_debug ) + dbgmsg("%s: CDF parser start with '%s'", __func__, keyword_str(token)); parsing.parser_save(ydfparse); @@ -222,28 +237,91 @@ run_cdf( int token ) { if( YY_START == cdf_state ) yy_pop_state(); if( yy_flex_debug ) { - dbgmsg("CDF parser returned %d, scanner SC <%s>", erc, start_condition_is()); + dbgmsg("%s: CDF parser returned %d, scanner SC <%s>", __func__, + erc, start_condition_is()); } return 0 == erc; } #include <queue> -struct pending_token_t { +struct recent_token_t { int token; YYSTYPE value; - pending_token_t( int token, YYSTYPE value ) : token(token), value(value) {} + cbl_loc_t loc; + recent_token_t( int token, YYSTYPE value, cbl_loc_t loc ) + : token(token), value(value), loc(loc) {} }; -#define PENDING(T) pending_token_t( (T), yylval ) +#define RECENT(T) recent_token_t( (T), yylval ) -static std::queue<pending_token_t> pending_tokens; +namespace cdf { + int used_token(); +} -int next_token() { +/* + * Each time the generated scanner returns a token from lexer(), it's pushed on + * the recent_tokens queue. The queue is 2 deep, representing the CDF parser's + * current and lookahead tokens. + */ +static struct recent_tokens_t : protected std::queue<recent_token_t> +{ + const recent_token_t& operator<<(int token) { + while( 1 < size() ) pop(); + push( recent_token_t(token, yylval, yylloc) ); + return front(); + } + + bool eof() const { + return size() == 1 && front().token == YYEOF; + } + + int next() { + int end_token = cdf::used_token(); + + switch( size() ) { + default: gcc_unreachable(); + case 0: + dbgmsg("%s:%d: 0 recent tokens []", __func__, __LINE__); + break; + case 1: + dbgmsg("%s:%d: 1 recent token [%s]", __func__, __LINE__, + keyword_str(back().token)); + break; + case 2: + dbgmsg("%s:%d: 2 recent tokens [%s, %s]", __func__, __LINE__, + keyword_str(front().token), + keyword_str(back().token)); + break; + } + + /* + * Clear any used tokens. Return the unused token, if extant, which was + * the lookahead token. Because it was the last one returned by lexer(), + * the location is accurate. Else return the next token. + */ + if( ! empty() && front().token == end_token ) pop(); + if( ! empty() && back().token == end_token ) c.clear(); + + end_token = 0; + + if( ! empty() ) { + end_token = front().token; + if( ! eof() ) { + pop(); + assert(empty()); + } + } + + return end_token; + } +} recent_tokens; + +static int next_token() { int token = lexer(); + recent_tokens << token; return token; } -extern int ydfchar; bool in_procedure_division(void); // act on CDF tokens @@ -262,13 +340,23 @@ prelex() { while( is_cdf_token(token) ) { if( ! run_cdf(token) ) { - dbgmsg( ">>CDF parser failed, ydfchar %d", ydfchar ); + dbgmsg( ">>CDF parser failed, ydfchar %d", ydfchar() ); + } + + token = recent_tokens.next(); + + if( recent_tokens.eof() ) { + dbgmsg("lexer() returned EOF (%d)", token); + return YYEOF; } - // Return the CDF's discarded lookahead token, if extant. - token = ydfchar > 0? ydfchar : next_token(); + + if( token == 0 ) token = next_token(); + if( token == NO_CONDITION && parsing.at_eof() ) { + dbgmsg("scanner at EOF, apparently (%d)", token); return YYEOF; } + dbgmsg("next token %s", keyword_str(token)); // Reenter cdf parser only if next token could affect parsing state. if( ! parsing.on() && ! is_cdf_condition_token(token) ) break; @@ -298,7 +386,7 @@ prelex() { yylval.number = level_of(yylval.numstr.string); token = LEVEL; break; - case YDF_NUMBER: + case cdf::parser::token::YDF_NUMBER: dbgmsg("final token is YDF_NUMBER"); yylval.number = ydflval.number; token = LEVEL; @@ -319,10 +407,9 @@ prelex() { } } - dbgmsg( ">>CDF parser done, %s returning " - "%s (because final_token %s, lookhead %d) on line %d", __func__, - keyword_str(token), keyword_str(final_token), - ydfchar, yylineno ); + dbgmsg( ">>CDF parser done, %s returning %s, conditional compilation %s", __func__, + keyword_str(token), + parsing.on()? "TRUE" : "FALSE" ); in_cdf = false; return token; } @@ -333,20 +420,45 @@ prelex() { * prelex calls lexer, the scanner produced by flex. * lexer reads input from yyin via lexer_input. * - * prelex intercepts CDF statements, each of which it parses with ydfparse. - * ydfparse affects CDF variables, which may affect how yylex treats + * prelex intercepts CDF statements, each of which it parses with cdf::parser::parse. + * cdf::parser::parse affects CDF variables, which may affect how yylex treats * the input stream. * * Because the lexer is called recursively: * - * yyparse -> yylex -> ydfparse -> yylex + * yyparse -> yylex -> cdf::parser::parse -> yylex + * + * the global state of the scanner has to be managed, both before and after the + * CDF parser runs. + * + * Before invoking the CDF parser, run_cdf() stashes the CDF token with + * inject_token(). When the CDF parser turns around and calls yylex, the first + * token returned is that stashed one, because it is the reason the CDF parser + * was invoked. + * + * While the CDF parser is active, the scanner saves each token returned by + * lexer() in the recent_tokens queue. As the CDF parser uses a token, it + * records it such that it can be fetched with used_token(). A token fetched + * and *not* used was a lookahead token, and will be directed to the main + * parser. + * + * When the CDF parser returns, recent_tokens.next() compares the last two + * tokens fetched with the last one one used. If there's a recent token in the + * queue after the last one used, that's a lookahead token. It is returned to + * the main parser, which started the whole thing by calling yylex(). + * + * It's not really necessary to keep the last two tokens for the post-parsing + * logic to work. It's enough to compare the last fetched token with the last + * used token. * - * the global state of the scanner has changed when ydfparse returns. Part of - * that state is the unused lookahead token that ydfparse discarded, stored in - * final_token. prelex then returns final_token as its own, which is duly - * returned to yyparse. + * It *is* really necessary to for the CDF parser to record the tokens it + * actually uses, at least as things stand. The Bison C++ parser (which the + * CDF parser uses) records any token values that it doesn't define as -2, + * "invalid token". If the lookahead token is, say, MOVE, it cannot be + * retrieved from the CDF parser. That's why it's kept in the recent_tokens + * queue, where it's preceded by the last valid, used token, as recorded by the + * CDF parser. */ - int yylex(void) { static bool produce_next_sentence_target = false; @@ -390,10 +502,6 @@ yylex(void) { produce_next_sentence_target = true; } - if( parsing.normal() ) { - final_token = token; - } - if( token == YYEOF && parsing.in_cdf() ) { if( yy_flex_debug) dbgmsg("deflecting EOF"); parsing.at_eof(true); @@ -403,6 +511,25 @@ yylex(void) { return token; } +/* + * The CDF parser is a C++ parser. It passes pointers to the semantic value + * and location as parameters to the lexer. The generated lexer OTOH does not + * accept those parameters; rather it works with global variables in the + * old-fashioned C-style. + * + * Below we define the function the CDF parser calls to acquire a token. It + * calls the lexer, which writes to its global variables, copies that output to + * the passed parameters, and returns the token. + */ +namespace cdf { + int cdflex( parser::value_type *value, cbl_loc_t *loc ) { + int tok = ::yylex(); + *value = ydflval; + *loc = yylloc; + return tok; + } +} + /* * Token name<->string utilities */ diff --git a/gcc/cobol/symbols.cc b/gcc/cobol/symbols.cc index de6fabe997a8..2cf73cc4cf49 100644 --- a/gcc/cobol/symbols.cc +++ b/gcc/cobol/symbols.cc @@ -74,13 +74,13 @@ public: } }; -static std::map<size_t, YYLTYPE> field_locs; +static std::map<size_t, cbl_loc_t> field_locs; void -symbol_field_location( size_t ifield, const YYLTYPE& loc ) { +symbol_field_location( size_t ifield, const cbl_loc_t& loc ) { field_locs[ifield] = loc; } -YYLTYPE +cbl_loc_t symbol_field_location( size_t ifield ) { auto p = field_locs.find(ifield); gcc_assert(p != field_locs.end()); @@ -730,7 +730,7 @@ symbol_locale( 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); // cppcheck-suppress syntaxError + cbl_alphabet_t alphabet(cbl_loc_t(), custom_encoding_e); // cppcheck-suppress syntaxError assert(strlen(name) < sizeof alphabet.name); strcpy(alphabet.name, name); @@ -3411,7 +3411,7 @@ cbl_locale_t::cbl_locale_t( const cbl_name_t name, const char iconv_name[] ) { } } -cbl_alphabet_t::cbl_alphabet_t(const YYLTYPE& loc, size_t locale, cbl_name_t name ) +cbl_alphabet_t::cbl_alphabet_t(const cbl_loc_t& loc, size_t locale, cbl_name_t name ) : loc(loc) , locale(locale) , low_index(0) @@ -3528,7 +3528,7 @@ cbl_alphabet_t::reencode( const cbl_loc_t& loc ) { } bool -cbl_alphabet_t::assign( const YYLTYPE& loc, unsigned char ch, unsigned char high_value ) { +cbl_alphabet_t::assign( const cbl_loc_t& loc, unsigned char ch, unsigned char high_value ) { if( collation_sequence[ch] == 0xFF || collation_sequence[ch] == high_value) { collation_sequence[ch] = high_value; last_index = ch; @@ -3545,7 +3545,7 @@ cbl_alphabet_t::assign( const YYLTYPE& loc, unsigned char ch, unsigned char high } void -cbl_alphabet_t::also( const YYLTYPE& loc, size_t ch ) { +cbl_alphabet_t::also( const cbl_loc_t& loc, size_t ch ) { if( ch < 256 ) { collation_sequence[ch] = collation_sequence[last_index]; if( ch == high_index ) high_index--; @@ -3770,7 +3770,7 @@ symbol_temporary_location( const cbl_field_t *field, const cbl_loc_t& loc ) { cbl_loc_t symbol_temporary_location( const cbl_field_t *field ) { - extern YYLTYPE yylloc; + extern cbl_loc_t yylloc; auto p = temporaries.locs.find(field); return p == temporaries.locs.end()? cbl_loc_t(yylloc) : p->second; } @@ -4209,10 +4209,11 @@ cbl_field_t::encode( size_t srclen, cbl_loc_t loc ) { return data.original(); } - extern YYLTYPE yylloc; + extern cbl_loc_t yylloc; + const char *bad_boy = data.original(); if( 0 == loc.first_line ) - loc = level == 0 ? yylloc : symbol_field_location(field_index(this)); + loc = level == 0 ? cbl_loc_t(yylloc) : symbol_field_location(field_index(this)); /* * Hex-encoded means we don't convert. data.initial should be long enough to @@ -4319,7 +4320,7 @@ cbl_field_t::encode( size_t srclen, cbl_loc_t loc ) { // else try again } if( 0 == loc.first_line ) - loc = level == 0 ? yylloc : symbol_field_location(field_index(this)); + loc = level == 0 ? cbl_loc_t(yylloc) : symbol_field_location(field_index(this)); error_msg( loc, "%<%c%> of %qs could not be converted from %s to %s: %s", *bad_boy, data.original(), cbl_encoding_str( diff --git a/gcc/cobol/symbols.h b/gcc/cobol/symbols.h index b4f3bdd7bc57..dd04ed93c35e 100644 --- a/gcc/cobol/symbols.h +++ b/gcc/cobol/symbols.h @@ -95,14 +95,7 @@ bool cbl_diagnostic_kind( cbl_diag_id_t id, diagnostics::kind kind ); bool cbl_dialect_kind( cbl_dialect_t dialect, diagnostics::kind kind ); #endif -enum cbl_gcobol_feature_t { - feature_gcc_e = 0x00, - feature_internal_ebcdic_e = 0x01, - feature_embiggen_e = 0x02, // widen numeric that redefine POINTER -}; - extern size_t cbl_gcobol_features; -bool cobol_gcobol_feature_set( cbl_gcobol_feature_t gcobol_feature, bool on = true ); static inline bool gcobol_feature_internal_ebcdic() { return feature_internal_ebcdic_e == @@ -926,7 +919,7 @@ struct cbl_field_t { return *this; } - bool report_invalid_initial_value(const YYLTYPE& loc) const; + bool report_invalid_initial_value(const cbl_loc_t& loc) const; bool is_ascii() const; bool is_integer() const { return is_numeric(type) && data.rdigits == 0; } @@ -976,8 +969,7 @@ struct cbl_field_t { void set_initial( size_t nchar, const cbl_loc_t& loc = cbl_loc_t() ); size_t source_code_check(const void *initial, size_t length); const char * encode( size_t, cbl_loc_t loc = cbl_loc_t()); - void encode_numeric( const char input[], cbl_loc_t loc, - const REAL_VALUE_TYPE& rvt = {}); + void encode_numeric( const char input[], cbl_loc_t loc ); const char *value_str() const; bool is_key_name() const { return has_attr(record_key_e); } @@ -1025,7 +1017,7 @@ struct cbl_span_t { struct cbl_refer_t { - YYLTYPE loc; + cbl_loc_t loc; cbl_field_t *field; cbl_label_t *prog_func; bool all, addr_of; @@ -1043,7 +1035,7 @@ struct cbl_refer_t { , all(all), addr_of(false) , refmod(NULL) {} - cbl_refer_t( const YYLTYPE& loc, cbl_field_t *field, bool all = false ) + cbl_refer_t( const cbl_loc_t& loc, cbl_field_t *field, bool all = false ) : loc(loc), field(field), prog_func(NULL) , all(all), addr_of(false) , refmod(NULL) @@ -1894,7 +1886,7 @@ char * hex_decode( const char text[] ); * If the encoding is EBCDIC CP1140, then 'A' is 193 and collation_sequence[193] == 1. */ struct cbl_alphabet_t { - YYLTYPE loc; + cbl_loc_t loc; cbl_name_t name; cbl_encoding_t encoding; size_t locale; // index to cbl_locale_t symbol @@ -1915,7 +1907,7 @@ struct cbl_alphabet_t { memset(collation_sequence, 0xFF, sizeof(collation_sequence)); } - cbl_alphabet_t(const YYLTYPE& loc, cbl_encoding_t enc) + cbl_alphabet_t(const cbl_loc_t& loc, cbl_encoding_t enc) : loc(loc) , encoding(enc) , locale(0) @@ -1929,9 +1921,9 @@ struct cbl_alphabet_t { memset(collation_sequence, 0xFF, sizeof(collation_sequence)); } - cbl_alphabet_t(const YYLTYPE& loc, size_t locale, cbl_name_t name ); + cbl_alphabet_t(const cbl_loc_t& loc, size_t locale, cbl_name_t name ); - cbl_alphabet_t( const YYLTYPE& loc, const cbl_name_t name, + cbl_alphabet_t( const cbl_loc_t& loc, const cbl_name_t name, unsigned char low_index, unsigned char high_index, unsigned char collation_sequence[] ) : loc(loc) @@ -1957,7 +1949,7 @@ struct cbl_alphabet_t { } void - add_sequence( const YYLTYPE& loc, const unsigned char seq[] ) { + add_sequence( const cbl_loc_t& loc, const unsigned char seq[] ) { if( low_index == 0 ) low_index = seq[0]; unsigned char last = last_index > 0? collation_sequence[last_index] + 1 : 0; @@ -1968,7 +1960,7 @@ struct cbl_alphabet_t { } void - add_interval( const YYLTYPE& loc, unsigned char low, unsigned char high ) { + add_interval( const cbl_loc_t& loc, unsigned char low, unsigned char high ) { if( low_index == 0 ) low_index = low; unsigned char last = collation_sequence[last_index]; @@ -1978,8 +1970,8 @@ struct cbl_alphabet_t { } } - void also( const YYLTYPE& loc, size_t ch ); - bool assign( const YYLTYPE& loc, unsigned char ch, unsigned char value ); + void also( const cbl_loc_t& loc, size_t ch ); + bool assign( const cbl_loc_t& loc, unsigned char ch, unsigned char value ); bool reencode( const cbl_loc_t& loc ); static const char * @@ -2675,7 +2667,8 @@ struct cbl_perform_tgt_t { cbl_perform_tgt_t() : addresses(), ifrom(0), ito(0) {} explicit cbl_perform_tgt_t( cbl_label_t * from, cbl_label_t *to = NULL ) - : addresses(), ifrom( from? symbol_index(symbol_elem_of(from)) : 0 ) + : addresses() + , ifrom( from? symbol_index(symbol_elem_of(from)) : 0 ) , ito( to? symbol_index(symbol_elem_of(to)) : 0 ) {} @@ -2791,11 +2784,11 @@ size_t current_program_index(); const char * current_declarative_section_name(); struct cbl_nameloc_t { - YYLTYPE loc; + cbl_loc_t loc; const char *name; cbl_nameloc_t() : loc{ 1,1, 1,1 }, name(NULL) {} - cbl_nameloc_t( const YYLTYPE& loc, const char *name ) + cbl_nameloc_t( const cbl_loc_t& loc, const char *name ) : loc(loc), name(name) {} }; @@ -2828,13 +2821,13 @@ class name_queue_t : private std::queue<cbl_namelocs_t> } ); return names; } - size_t push( const YYLTYPE& loc, const char name[] ) { + size_t push( const cbl_loc_t& loc, const char name[] ) { assert( !empty() ); back().push_front( cbl_nameloc_t(loc, name) ); dump(__func__); return size(); } - void qualify( const YYLTYPE& loc, const char name[] ) { + void qualify( const cbl_loc_t& loc, const char name[] ) { if( empty() ) { allocate(); push(loc, name); @@ -2868,7 +2861,7 @@ const std::string& keyword_alias_add( const std::string& keyword, int binary_integer_usage_of( const char name[] ); void tee_up_empty(); -void tee_up_name( const YYLTYPE& loc, const char name[] ); +void tee_up_name( const cbl_loc_t& loc, const char name[] ); cbl_namelist_t teed_up_names(); size_t end_of_group( size_t igroup ); @@ -2948,8 +2941,8 @@ symbol_elem_t * symbol_section_add( size_t program, void symbol_registers_add(); -void symbol_field_location( size_t ifield, const YYLTYPE& loc ); -YYLTYPE symbol_field_location( size_t ifield ); +void symbol_field_location( size_t ifield, const cbl_loc_t& loc ); +cbl_loc_t symbol_field_location( size_t ifield ); bool symbol_label_section_exists( size_t program ); @@ -2968,11 +2961,6 @@ static inline size_t upsi_register() { void wsclear( uint32_t ch); const uint32_t *wsclear(); -enum cbl_call_convention_t { - cbl_call_verbatim_e = 'V', - cbl_call_cobol_e = 'N', // native -}; - int keyword_tok( const char * text, bool include_intrinsics = false ); int redefined_token( const cbl_name_t name ); @@ -3000,7 +2988,7 @@ class current_tokens_t { tokenset_t(); int find( const cbl_name_t name, bool include_intrinsics ); - bool equate( const YYLTYPE& loc, int token, + bool equate( const cbl_loc_t& loc, int token, const cbl_name_t name, const cbl_name_t verb = "EQUATE") { auto lname( lowercase(name) ); auto cw = cobol_words.insert(lname); @@ -3018,7 +3006,7 @@ class current_tokens_t { } return fOK; } - bool undefine( const YYLTYPE& loc, + bool undefine( const cbl_loc_t& loc, const cbl_name_t name, const cbl_name_t verb = "UNDEFINE" ) { auto lname( lowercase(name) ); auto cw = cobol_words.insert(lname); @@ -3044,14 +3032,14 @@ class current_tokens_t { return fOK; } - bool substitute( const YYLTYPE& loc, + bool substitute( const cbl_loc_t& loc, const cbl_name_t extant, int token, const cbl_name_t name ) { return equate( loc, token, name, "SUBSTITUTE" ) && undefine( loc, extant, "SUBSTITUTE" ); } - bool reserve( const YYLTYPE& loc, const cbl_name_t name ) { + bool reserve( const cbl_loc_t& loc, const cbl_name_t name ) { auto lname( lowercase(name) ); auto cw = cobol_words.insert(lname); if( ! cw.second ) { @@ -3084,7 +3072,7 @@ class current_tokens_t { int find( const cbl_name_t name, bool include_intrinsics ) { return tokens.find(name, include_intrinsics); } - bool equate( const YYLTYPE& loc, const cbl_name_t keyword, const cbl_name_t alias ) { + bool equate( const cbl_loc_t& loc, const cbl_name_t keyword, const cbl_name_t alias ) { int token; if( 0 == (token = binary_integer_usage_of(keyword)) ) { if( 0 == (token = keyword_tok(keyword)) ) { @@ -3100,10 +3088,10 @@ class current_tokens_t { } return tokens.equate(loc, token, alias); } - bool undefine( const YYLTYPE& loc, cbl_name_t keyword ) { + bool undefine( const cbl_loc_t& loc, cbl_name_t keyword ) { return tokens.undefine(loc, keyword); } - bool substitute( const YYLTYPE& loc, const cbl_name_t keyword, const cbl_name_t alias ) { + bool substitute( const cbl_loc_t& loc, const cbl_name_t keyword, const cbl_name_t alias ) { int token; if( 0 == (token = binary_integer_usage_of(keyword)) ) { if( 0 == (token = keyword_tok(keyword)) ) { @@ -3121,7 +3109,7 @@ class current_tokens_t { dbgmsg("%s:%d: %s (%d) will have alias %s", __func__, __LINE__, keyword, token, alias); return tokens.substitute(loc, keyword, token, alias); } - bool reserve( const YYLTYPE& loc, const cbl_name_t name ) { + bool reserve( const cbl_loc_t& loc, const cbl_name_t name ) { return tokens.reserve(loc, name); } int redefined_as( const cbl_name_t name ) { @@ -3132,12 +3120,8 @@ class current_tokens_t { } }; -cbl_call_convention_t current_call_convention(); current_tokens_t& cdf_current_tokens(); -void -current_call_convention( cbl_call_convention_t convention); - class procref_base_t { private: const char *section_name, *paragraph_name; @@ -3177,6 +3161,9 @@ public: } int line_number() const { return line; } + const char *called_from() const { + return context? cbl_label_of(symbol_at(context))->name : ""; + } }; void procedure_definition_add( size_t program, const cbl_label_t *procedure ); @@ -3217,8 +3204,7 @@ int rdigits_of_picture(const char *picture); int digits_of_picture(const char *picture, bool for_rdigits); bool is_picture_scaled(const char *picture); -template <typename LOC> -void gcc_location_set( const LOC& loc ); +void gcc_location_set( const cbl_loc_t& loc ); // This is slightly oddball. This is an entry point in the charutf8.cc module. // It's the only entry point in the module, and so it seemed to me wasteful to diff --git a/gcc/cobol/util.cc b/gcc/cobol/util.cc index bf9a60450b60..6f9c481a8d4f 100644 --- a/gcc/cobol/util.cc +++ b/gcc/cobol/util.cc @@ -160,7 +160,7 @@ class cdf_directives_t } void pop() { if( empty() ) { - error_msg(YYLTYPE(), "CDF stack empty"); // cppcheck-suppress syntaxError + error_msg(cbl_loc_t(), "CDF stack empty"); // cppcheck-suppress syntaxError return; } current_value = top(); @@ -314,13 +314,15 @@ void cdf_pop_source_format() { cdf_directives.source_format.value().description()); } +void cdf_unreachable() { gcc_unreachable(); } + /* * Construct a cbl_field_t from a CDF literal, to be installed in the symbol table. */ -cbl_field_t +static cbl_field_t cdf_literalize( const cbl_loc_t& loc, const std::string& name, const cdfval_t& value, - bool set_initial ) { + bool set_initial = true ) { cbl_field_t field; if( value.is_numeric() ) { @@ -345,6 +347,34 @@ cdf_literalize( const cbl_loc_t& loc, return field; } +cbl_file_t * +cdf_file( size_t program, const cbl_name_t name ) { + symbol_elem_t *e = symbol_file(program, name); + if( e && e->type == SymFile ) { + return cbl_file_of(e); + } + return nullptr; +} + +size_t +cdf_file_index( const cbl_file_t *file ) { + return symbol_index(symbol_elem_of(file)); +} + +const char * +cdf_file_name( const cbl_file_t *file ) { + return file->name; +} + + +void +cdf_field_add( const cbl_loc_t& loc, const std::string& name, const cdfval_t& value ) { + if( symbols_begin() < symbols_end() ) { + cbl_field_t field = cdf_literalize(loc, name, value); + symbol_field_add(current_program_index(), &field); + } +} + const std::list<cbl_field_t> cdf_literalize() { std::list<cbl_field_t> fields; @@ -1436,8 +1466,7 @@ binary_initial( char *retval, */ void -cbl_field_t::encode_numeric( const char input[], cbl_loc_t loc, - const REAL_VALUE_TYPE& /*rvt*/ ) { +cbl_field_t::encode_numeric( const char input[], cbl_loc_t loc ) { gcc_assert(input); gcc_assert(is_numeric(this) || type == FldNumericEdited); @@ -1892,7 +1921,7 @@ size_t parse_error_inc(); size_t parse_error_count(); bool // true if error reported -cbl_field_t::report_invalid_initial_value(const YYLTYPE& loc) const { +cbl_field_t::report_invalid_initial_value(const cbl_loc_t& loc) const { if( ! data.original() ) return false; @@ -2531,6 +2560,320 @@ public: } }; +/* + * Use a namespace to define sets of names. Use relational algebra to + * determine uniqueness or ambiguity of each PERFORM reference. + */ +namespace match_proc { + std::string + lcase( std::string name ) { + std::transform(name.begin(), name.end(), name.begin(), ftolower); + return name; + } + + // PERFORM targets are captured by parser + struct stmt_t { + int line; + size_t curr; // current section of the PERFORM statement, else 0 + struct tgt_t { + std::string name, qual; + bool empty() const { return name.empty(); } + bool operator==(const tgt_t& that) const { + return name == that.name && qual == that.qual; + } + tgt_t lcase() const { + tgt_t output{ match_proc::lcase(name), match_proc::lcase(qual) }; + return output; + } + }; + std::pair<tgt_t, tgt_t> tgts; + + stmt_t() : line(0), curr(0) {} + stmt_t( int line, size_t isym, + std::string name, + const char qual[] ) + : line(line), curr(isym) + { + tgts.first = tgt_t{name, qual? std::string(qual) : std::string() }; + } + stmt_t& thru( std::string name, const char qual[] ) { + tgts.second = tgt_t{name, qual? std::string(qual) : std::string() }; + return *this; + } + struct found_t { + size_t n, isym; + found_t() : n(0), isym(0) {} + found_t(size_t n, size_t isym) : n(n), isym(isym) {} + }; + void error(const cbl_name_t program_name, + const tgt_t&tgt, + const found_t& found) const + { + const char *clause = tgt == tgts.first? "" : "THRU "; + + switch( found.n ) { + case 1: + gcc_unreachable(); + break; + case 0: + // error: not found + dbgmsg("%s:%d PERFORM %s%s not resolved", + program_name, line, clause, tgt.name.c_str()); + break; + default: + assert( 1 < found.n ); + // error: ambiguous + dbgmsg("%s:%d PERFORM %s%s ambiguous", + program_name, line, clause, tgt.name.c_str()); + break; + } + } + }; + + struct sect_t { + size_t isym; + std::string name; + sect_t( size_t isym ) : isym(isym) { + auto L = cbl_label_of(symbol_at(isym)); + name = lcase(L->name); + } + bool operator<( const sect_t& that ) const { + return name < that.name; + } + }; + struct para_t { + size_t isym, parent; + std::string name; + para_t( size_t isym ) : isym(isym) { + auto L = cbl_label_of(symbol_at(isym)); + parent = L->parent; + name = lcase(L->name); + } + bool operator<( const para_t& that ) const { + if( name == that.name ) { + return parent < that.parent; + } + return name < that.name; + } + std::string parent_name() const { + if( ! parent ) return std::string(); + const auto f = cbl_label_of(symbol_at(parent)); + return lcase(f->name); + } + }; + struct proc_t { + size_t n, isym; // index of first of n matching pairs + std::string para, sect; + proc_t( size_t n, size_t isym, + const std::string& para, + const std::string& sect ) + : n(n), isym(isym), para(para), sect(sect) + {} + bool operator<( const proc_t& that ) const { + if( para == that.para ) { + return sect < that.sect; + } + return para < that.para; + } + }; + + class procedures_t { + std::set<sect_t> sects; + std::set<para_t> paras; + std::set<proc_t> procs; + friend bool statements_verify(); + public: + procedures_t( size_t program ) { + // find sections and paragraphs + for( symbol_elem_t *e = symbols_begin(program+1); e->program == program; e++ ) { + if( e->type == SymLabel ) { + const auto& L = *cbl_label_of(e); + auto isym = e - symbols_begin(); + switch(L.type) { + case LblSection: + sects.insert(isym); + break; + case LblParagraph: + paras.insert(isym); + break; + default: + continue; + } + } + } + // join sections and paragraphs, unreduced + std::list<proc_t> all; + for( const auto& para : paras ) { + std::set<sect_t> parents; + std::copy_if( sects.begin(), sects.end(), std::inserter(parents, parents.begin()), + [para]( const auto& sect ) { + return para.parent_name() == sect.name; + } ); + std::transform( parents.begin(), parents.end(), std::back_inserter(all), + [para]( const auto& sect ) { + proc_t proc(1, para.isym, para.name, sect.name); + return proc; + } ); + } + // insert paragraph procedures + struct stat_t { + size_t n, isym; + stat_t() : n(0), isym(0) {} + stat_t update( size_t isym ) { + this->isym = this->isym == 0 ? isym : std::min(this->isym, isym); + n++; + return *this; + } + }; + std::map<proc_t, stat_t> nprocs; + for( const auto& proc : all ) { + auto& stat = nprocs[proc]; + stat.update( proc.isym ); + } + std::transform(nprocs.begin(), nprocs.end(), std::inserter(procs, procs.begin()), + []( const auto& elem ) { + proc_t proc ( elem.second.n, elem.second.isym, + elem.first.para, elem.first.sect ); + return proc; + } ); + // insert section procedures + std::map<sect_t, stat_t> nsects; + for( const auto& sect : sects ) { + auto& stat = nsects[sect]; + stat.update( sect.isym ); + } + std::transform(nsects.begin(), nsects.end(), std::inserter(procs, procs.begin()), + []( const auto& elem ) { + proc_t proc ( elem.second.n, elem.second.isym, + std::string(), elem.first.name ); + return proc; + } ); + } + + stmt_t::found_t + find( const stmt_t& stmt, const stmt_t::tgt_t& tgt ) { + if( tgt.empty() ) return stmt_t::found_t(); + std::string curr ( lcase( cbl_label_of(symbol_at(stmt.curr))->name ) ); + + auto p = std::find_if(procs.cbegin(), procs.cend(), + [curr, tgt](auto proc) { + return match(proc, tgt, curr); + }); + size_t n = std::count_if(p, procs.end(), + [curr, tgt](const auto& proc) { + return match(proc, tgt, curr); + }); + stmt_t::found_t found = {n, 0}; + if( n ) { + assert(p != procs.end()); + found.isym = p->isym; + } + return found; + } + protected: + static bool match( const proc_t& proc, const stmt_t::tgt_t& tgt, const std::string& curr ) { + return ( proc.para == tgt.name && tgt.qual.empty() ) + || ( proc.sect == tgt.name && tgt.qual.empty() ) + || ( proc.para == tgt.name && proc.sect == tgt.qual ) + || ( proc.para == tgt.name && proc.sect == curr ); + } + + void dump(const stmt_t& stmt) { + std::string target( stmt.tgts.first.name ); + if( ! stmt.tgts.first.qual.empty() ) { + target += " of " + stmt.tgts.first.qual; + } + if( ! stmt.tgts.second.name.empty() ) { + target += " THRU " + stmt.tgts.second.name; + } + if( ! stmt.tgts.second.qual.empty() ) { + target += " of " + stmt.tgts.second.qual; + } + + fprintf(stderr, "line %d in section #%lu: PERFORM %s\n", + stmt.line, (unsigned long)stmt.curr, target.c_str()); + fprintf(stderr, "%lu Sections:\n", (unsigned long)sects.size()); + for( auto sect : sects ) { + fprintf(stderr, "\t" "#%lu %s\n", (unsigned long)sect.isym, sect.name.c_str()); + } + fprintf(stderr, "%lu Paragraphs:\n", (unsigned long)paras.size()); + for( auto para : paras ) { + fprintf(stderr, "\t" "#%lu %s of #%lu\n", + (unsigned long)para.isym, para.name.c_str(), (unsigned long)para.parent); + } + fprintf(stderr, "%lu Procedures:\n", (unsigned long)procs.size()); + for( auto proc : procs ) { + std::string section(""); + if( ! proc.sect.empty() ) section += "of " + proc.sect; + fprintf(stderr, "\t" "n=%lu %s %s\n", + (unsigned long)proc.isym, proc.para.c_str(), section.c_str()); + } + return; + } + }; // procedures + + + static stmt_t prototype; + static std::list<stmt_t> stmts; + + bool + statements_verify() { + size_t nerr = 0; + size_t iprog = current_program_index(); + const char *program_name = cbl_label_of(symbol_at(iprog))->name; + // instantiate procedure targets for current program from the symbol table + procedures_t procedures(iprog); + + // Verify each PERFORM statement target is a unique reference + for( const auto& stmt : stmts ) { + stmt_t::found_t found = procedures.find(stmt, stmt.tgts.first.lcase()); + stmt_t::found_t thru = procedures.find(stmt, stmt.tgts.second.lcase()); + + if( found.n == 1 && (thru.n == 1 || stmt.tgts.second.empty()) ) { + // update proc call list + if( stmt.tgts.first.qual.empty() ) { + dbgmsg("%s:%d PERFORM %s is ok", program_name, stmt.line, + stmt.tgts.first.name.c_str()); + } else { + dbgmsg("%s:%d PERFORM %s of %s is ok", program_name, stmt.line, + stmt.tgts.first.name.c_str(), + stmt.tgts.first.qual.c_str()); + } + continue; + } + nerr++; + + if( found.n != 1 ) { + stmt.error(program_name, stmt.tgts.first, found); + if( nerr == 1 && yydebug ) { + procedures.dump(stmt); + } + } + if( thru.n != 1 && ! stmt.tgts.second.empty() ) { + stmt.error(program_name, stmt.tgts.second, thru); + } + } + return nerr == 0; + } + + void statement_add() { + stmts.push_back(prototype); + prototype = stmt_t(); + } + void + statement_compose( int line, size_t isection, // isection is where the PERFORM is + const cbl_name_t para, + const cbl_name_t qual ) { + std::string qual_name; + if( qual ) qual_name = qual; + if( prototype.tgts.first.name.empty() ) { + prototype = stmt_t( line, isection, para, qual ); + } else { + prototype.thru( para, qual ); + } + } +} // end match_proc namespace + /* * Every reference occurs in a {program,section,paragraph} context, * even if they're implicit. @@ -2635,20 +2978,54 @@ public: } }; +#define DUMP_PROCEDURE_CALLS 0 +#if DUMP_PROCEDURE_CALLS +static void procedure_calls_dump( size_t program ) { + procedures_t& procedures = programs[program]; + for( const auto& proc : procedures ) { + const procdef_t& def(proc.first); + const auto& refs(proc.second); + auto L = def.label_of(); + if( L ) { + fprintf(stderr, "call to %s", L->name); + if( L->parent ) { + auto S = cbl_label_of(symbol_at(L->parent)); + fprintf(stderr, " of %s", S->name); + } + fprintf(stderr, ":\n"); + for( const procref_t& ref : refs ) { + fprintf(stderr, "\t" "from %s ", ref.paragraph()); + if( ref.section()[0] ) fprintf(stderr, "of %s", ref.section()); + fprintf(stderr, "on line %d\n", ref.line_number()); + } + } + } +} +#endif + procref_t * ambiguous_reference( size_t program ) { procedures_t& procedures = programs[program]; +#if DUMP_PROCEDURE_CALLS + procedure_calls_dump(program); +#endif for( const auto& proc : procedures ) { procedures_t::mapped_type::const_iterator ambiguous = find_if_not( proc.second.begin(), proc.second.end(), is_unique(program, proc.first) ); if( proc.second.end() != ambiguous ) { if( yydebug ) { - dbgmsg("%s: %s of '%s' has " HOST_SIZE_T_PRINT_UNSIGNED - "potential matches", __func__, + dbgmsg("%s: %s of '%s' has " HOST_SIZE_T_PRINT_UNSIGNED " " + "potential matches among references", __func__, ambiguous->paragraph(), ambiguous->section(), (fmt_size_t)procedures.count(procdef_t(*ambiguous))); + for( const auto& ref : proc.second ) { + fprintf(stderr, "\tline %d from {%s}: %s", + ref.line_number(), ref.called_from(), ref.paragraph()); + if( ref.section()[0] ) fprintf(stderr, "of %s", ref.section()); + fprintf(stderr, "\n"); + } } return new procref_t(*ambiguous); } @@ -3104,9 +3481,8 @@ void current_location_minus_one_clear() * with start and caret at the first line/column of LOC, and finishing at the * last line/column of LOC. */ -template <typename LOC> static void -gcc_location_set_impl( const LOC& loc ) { +gcc_location_set_impl( const cbl_loc_t& loc ) { // Set the position to the first line & column in the location. static location_t loc_m_1 = 0; const location_t @@ -3132,13 +3508,15 @@ gcc_location_set_impl( const LOC& loc ) { location_dump(__func__, __LINE__, "parser", loc); } -void gcc_location_set( const YYLTYPE& loc ) { +void gcc_location_set( const cbl_loc_t& loc ) { gcc_location_set_impl(loc); } +#if 0 void gcc_location_set( const YDFLTYPE& loc ) { gcc_location_set_impl(loc); } +#endif #ifdef NDEBUG # define verify_format(M) @@ -3193,7 +3571,7 @@ ydferror( const char gmsgid[], ... ) { } extern int yychar; -extern YYLTYPE yylloc; +extern cbl_loc_t yylloc; /* * temp_loc_t is a hack in lieu of "%define parse.error custom". When @@ -3209,10 +3587,7 @@ class temp_loc_t { gcc_location_set(yylloc); // use lookahead location } - explicit temp_loc_t( const YYLTYPE& loc) : orig(token_location) { - gcc_location_set(loc); - } - explicit temp_loc_t( const YDFLTYPE& loc) : orig(token_location) { + explicit temp_loc_t( const cbl_loc_t& loc) : orig(token_location) { gcc_location_set(loc); } ~temp_loc_t() { @@ -3249,19 +3624,16 @@ class temp_loc_t { global_dc->end_group(); -void error_msg( const YYLTYPE& loc, const char gmsgid[], ... ) { +void error_msg( const cbl_loc_t& loc, const char gmsgid[], ... ) { ERROR_MSG_BODY } -void error_msg( const YDFLTYPE& loc, const char gmsgid[], ... ) +bool +warn_msg( const cbl_loc_t& loc, const char gmsgid[], ... ) ATTRIBUTE_GCOBOL_DIAG(2, 3); -void error_msg( const YDFLTYPE& loc, const char gmsgid[], ... ) { - ERROR_MSG_BODY -} - bool -warn_msg( const YYLTYPE& loc, const char gmsgid[], ... ) { +warn_msg( const cbl_loc_t& loc, const char gmsgid[], ... ) { temp_loc_t looker(loc); verify_format(gmsgid); auto_diagnostic_group d; @@ -3441,16 +3813,18 @@ parse_file( const char filename[] ) #pragma GCC diagnostic pop -extern int yy_flex_debug, yydebug, ydfdebug; +extern int yy_flex_debug, yydebug; extern int f_trace_debug; void cobol_set_indicator_column( int column ); +void ydfdebug( bool yn ); void cobol_set_debugging( bool flex, bool yacc, bool parser ) { yy_flex_debug = flex? 1 : 0; - ydfdebug = yydebug = yacc? 1 : 0; + yydebug = yacc? 1 : 0; + ydfdebug( yacc ); f_trace_debug = parser? 1 : 0; } @@ -3531,7 +3905,7 @@ cbl_unimplemented(const char *gmsgid, ...) { } void -cbl_unimplemented_at( const YYLTYPE& loc, const char *gmsgid, ... ) { +cbl_unimplemented_at( const cbl_loc_t& loc, const char *gmsgid, ... ) { temp_loc_t looker(loc); verify_format(gmsgid); auto_diagnostic_group d; diff --git a/gcc/cobol/util.h b/gcc/cobol/util.h index 57123ee18813..a5a2b9d26382 100644 --- a/gcc/cobol/util.h +++ b/gcc/cobol/util.h @@ -31,12 +31,6 @@ #ifndef _UTIL_H_ #define _UTIL_H_ -[[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); -void cbl_errx(const char *format_string, ...) ATTRIBUTE_GCOBOL_DIAG(1, 2); - bool fisdigit(int c); bool fisspace(int c); int ftolower(int c); @@ -111,18 +105,19 @@ public: }; -void cdf_push(); -void cdf_push_call_convention(); -void cdf_push_current_tokens(); -void cdf_push_dictionary(); -void cdf_push_enabled_exceptions(); -void cdf_push_source_format(); +/* + * Functions that validate every PERFORM calls a unique reference. + */ +namespace match_proc { + typedef char cbl_name_t[64]; -void cdf_pop(); -void cdf_pop_call_convention(); -void cdf_pop_current_tokens(); -void cdf_pop_dictionary(); -void cdf_pop_source_format(); -void cdf_pop_enabled_exceptions(); + // Supply each target as it's mentioned. + void statement_compose( int iline, size_t isection, + const cbl_name_t para, const cbl_name_t qual ); + // Add PERFORM to statement list. + void statement_add(); + // Verify all statements and report problems. + bool statements_verify(); +} #endif diff --git a/libgcobol/posix/shim/open.cc b/libgcobol/posix/shim/open.cc index b4ffa90a8795..ed2a9d131b49 100644 --- a/libgcobol/posix/shim/open.cc +++ b/libgcobol/posix/shim/open.cc @@ -35,19 +35,37 @@ posix_open(const char *pathname, int cbl_flags, int cbl_mode) { { cbl::PSX_O_APPEND, O_APPEND }, { cbl::PSX_O_NONBLOCK, O_NONBLOCK }, { cbl::PSX_O_DSYNC, O_DSYNC }, - { cbl::PSX_O_DIRECT, O_DIRECT }, - { cbl::PSX_O_DIRECTORY, O_DIRECTORY }, - { cbl::PSX_O_NOFOLLOW, O_NOFOLLOW }, - { cbl::PSX_O_CLOEXEC, O_CLOEXEC }, - { cbl::PSX_O_SYNC, O_SYNC }, - { cbl::PSX_O_PATH, O_PATH }, -#if 0 - // Linux, not POSIX - { cbl::PSX_O_LARGEFILE, O_LARGEFILE }, - { cbl::PSX_O_NOATIME, O_NOATIME }, - { cbl::PSX_O_TMPFILE, O_TMPFILE }, + { cbl::PSX_O_LARGEFILE, O_LARGEFILE }, + { cbl::PSX_O_SYNC, O_SYNC }, + /* + * The O_CLOEXEC, O_DIRECTORY, and O_NOFOLLOW flags are not specified in + * POSIX.1-2001, but are specified in POSIX.1-2008. See open(2). + */ +#if defined(_POSIX_C_SOURCE) && 200809L <= (_POSIX_C_SOURCE - 0) + { cbl::PSX_O_CLOEXEC, O_CLOEXEC }, + { cbl::PSX_O_DIRECTORY, O_DIRECTORY }, + { cbl::PSX_O_NOFOLLOW, O_NOFOLLOW }, +#else + { cbl::PSX_O_CLOEXEC, 0 }, + { cbl::PSX_O_DIRECTORY, 0 }, + { cbl::PSX_O_NOFOLLOW, 0 }, #endif - }; + /* + * The O_DIRECT, O_NOATIME, O_PATH, and O_TMPFILE flags are Linux- + * specific. One must define _GNU_SOURCE to obtain their definitions. + */ +#if defined(_GNU_SOURCE) + { cbl::PSX_O_DIRECT, O_DIRECT }, + { cbl::PSX_O_NOATIME, O_NOATIME }, + { cbl::PSX_O_PATH, O_PATH }, + { cbl::PSX_O_TMPFILE, O_TMPFILE }, +#else + { cbl::PSX_O_DIRECT, 0 }, + { cbl::PSX_O_NOATIME, 0 }, + { cbl::PSX_O_PATH, 0 }, + { cbl::PSX_O_TMPFILE, 0 }, +#endif + }; static const std::map<int, int> mode_bits { { cbl::PSX_S_IXOTH, S_IXOTH },
