From: James K. Lowden Date: Mon, 1 Dec 2025 21:08:55 +0000 (-0500) Subject: cobol: Expose warnings as command-line options. X-Git-Url: http://git.ipfire.org/cgi-bin/gitweb.cgi?a=commitdiff_plain;h=d9a64bf6a6d8f6f7570d717364dc767bfb3d7b8c;p=thirdparty%2Fgcc.git cobol: Expose warnings as command-line options. Introduce 45 warning options, integrated with dialects. Update documentation with warning options and syntax supported by each dialect. gcc/cobol/ChangeLog: PR cobol/119329 PR cobol/119331 PR cobol/120786 * Make-lang.in: Add cobol/messages.o to cobol1 sources. * cbldiag.h (yywarn): Remove function. (struct cbl_loc_t): Introduce new location type independent of Bison. (enum cbl_diag_id_t): Enumerate diagnostic messages. (cbl_message): New function. (dialect_ok): Test for dialect, emit standard message. (dialect_not_ok): Emit standard message if syntax excluded by dialect. (dialect_error): Remove function. (cbl_unimplementedw): Use cbl_diag_id_t. (cbl_unimplemented): Whitespace. * cdf.y: Update token values. * cobol1.cc (enable_exceptions): Use cbl_message. (cobol_warning): Declare function. (cobol_langhook_handle_option): Add 44 new warning options. (cobol_langhook_type_for_mode): Remove function. * except.cc (cbl_enabled_exception_t::dump): Remove function. * exceptg.h (class exception_turn_t): Use cbl_diag_id_t. * gcobol.1: Document dialect syntax and new warning options. * genapi.cc (parser_label_label): Remove unused warning. * gengen.cc (gg_find_field_in_struct): Use cbl_internal_error. (gg_printf): Same. (gg_fprintf): Same. (gg_define_function): Same. (gg_get_function_decl): Same. (gg_call_expr): Same. (gg_call): Same. * lang-specs.h: Add warning options. * lang.opt: Add ISO dialect and options. * lexio.cc (parse_replacing_term): Use cbl_message. (parse_replacing_pair): Same. (preprocess_filter_add): Same. (cdftext::echo_input): Same. (cdftext::lex_open): Same. (cdftext::open_input): Same. * messages.cc: New file implements cbl_message. * parse.y: Use cbl_message. * parse_ante.h (dialect_proscribed): Remove function. (parser_move_carefully): Use dialect_ok. (goodnight_gracie): Convert warning to debug message. * scan.l: Use dialect_ok. * scan_ante.h (scanner_parsing): Use cbl_diag_id_t. (scanner_parsing_toggle): Same. (scanner_parsing_pop): Same. (verify_ws): Same. (level_of): Same. (typed_name): Same. (integer_of): Same. * scan_post.h (datetime_format_of): Use cbl_internal_error. (prelex): Emit only debug messages. * show_parse.h: Use cbl_internal_error. * symbols.cc (symbols_update): Remove dialect test because parser's problem. (cbl_field_t::internalize): Use cbl_message. * symbols.h (enum cbl_dialect_t): Add ISO to cbl_dialect_t. (cbl_dialect_str): Recognize ISO dialect. (dialect_has): New function. (cbl_diagnostic_kind): New function. (cbl_dialect_kind): New function. (struct cbl_alphabet_t): Emit only debug message. * token_names.h: Regenerate. * util.cc (gb4): Emit only debug message. (current_token_location): Add overload to set token_location. (yywarn): Remove function. (cobol_fileline_set): Use cbl_message. (cobol_parse_files): Same. (cbl_message): New diagnostic message function uses cbl_diag_id_t. (cbl_diagnostic_kind): New function. (cbl_diagnostic_option): New function. (cbl_unimplementedw): Use cbl_diag_id_t. (dialect_error): Remove function. * util.h (cbl_message): Remove obsolete prototype for cbl_message. --- diff --git a/gcc/cobol/Make-lang.in b/gcc/cobol/Make-lang.in index 5fced594d64..a52e6d87f6a 100644 --- a/gcc/cobol/Make-lang.in +++ b/gcc/cobol/Make-lang.in @@ -71,6 +71,7 @@ cobol1_OBJS = \ cobol/genmath.o \ cobol/gengen.o \ cobol/lexio.o \ + cobol/messages.o \ cobol/parse.o \ cobol/scan.o \ cobol/structs.o \ diff --git a/gcc/cobol/cbldiag.h b/gcc/cobol/cbldiag.h index 2554deb9644..388bc781093 100644 --- a/gcc/cobol/cbldiag.h +++ b/gcc/cobol/cbldiag.h @@ -46,7 +46,6 @@ const char * cobol_filename(); * diagnostic framework and use text that can be localized. */ void yyerror( const char fmt[], ... ) ATTRIBUTE_GCOBOL_DIAG(1, 2); -bool yywarn( 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 @@ -78,6 +77,110 @@ struct YDFLTYPE #endif +struct cbl_loc_t { + int first_line; + int first_column; + int last_line; + int last_column; + + 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) + {} + + operator YYLTYPE() const { + return { first_line, first_column, last_line, last_column }; + } +}; + +/* + * Naming Convention: Names end with a letter that indicates + * their kind: + * F fatal, "fatal error: " + * I ice, "internal compiler error: " + * E error, "error: " + * S sorry, "sorry, unimplemented: " + * W warning, "warning: " + * A anachronism, "anachronism: " + * N note, "note: " + * D debug, "debug: " + */ +enum cbl_diag_id_t : uint64_t { + CdfNotFoundW, + CdfParameterW, + + EcUnknownW, + + LexIncludeE, + LexIncludeOkN, + LexIndicatorE, + LexInputN, + LexLineE, + LexPreprocessE, + LexReplaceE, + LexSeparatorE, + + IbmEjectE, + IbmEqualAssignE, + IbmLengthOf, + IbmProcedurePointer, + IbmSectionNegE, + IbmSectionRangeE, + IbmSectionSegmentW, + IbmStopNumber, + IbmVolatileE, + IbmVolatileW, // dialect warning for ignored syntax + + IsoResume, + + MfBinaryLongLong, + MfCallGiving, + MfCdfDollar, + MfComp6, + MfCompX, + MfLevel_1_Occurs, + MfLevel78, + MfMovePointer, + MfReturningNum, + MfUsageTypename, + MfTrailing, + + Par78CdfDefinedW, + ParIconvE, + ParInfoI, + ParLangInfoW, + ParLiteral2W, + ParLocaleW, + ParNoCorrespondingW, + ParNumstrW, + ParUnresolvedProcE, + + SynApplyCommit, + SynFileCodeSet, + SynHighOrderBit, + SynRecordingMode, + SynSetLocaleTo, + SynSetToLocale, + + DiagDiagDiag // always last +}; + +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); + +bool +dialect_ok( const cbl_loc_t& loc, cbl_diag_id_t id, const char term[], bool ok = true ); + +static inline bool +dialect_not_ok( const cbl_loc_t& loc, cbl_diag_id_t id, const char term[] ) { + return dialect_ok(loc, id, term, false); +} + // 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[], ... ) @@ -91,16 +194,15 @@ warn_msg( const YYLTYPE& loc, const char gmsgid[], ... ) void error_msg_direct( const char gmsgid[], ... ) ATTRIBUTE_GCOBOL_DIAG(1, 2); -void dialect_error( const YYLTYPE& loc, const char term[], const char dialect[] ); - - // for CDF and other warnings that refer back to an earlier line // (not in diagnostic framework yet) void yyerrorvl( int line, const char *filename, const char fmt[], ... ) ATTRIBUTE_PRINTF_3; -void cbl_unimplementedw(const char *gmsgid, ...) ATTRIBUTE_GCOBOL_DIAG(1, 2); // warning -void cbl_unimplemented(const char *gmsgid, ...) ATTRIBUTE_GCOBOL_DIAG(1, 2); // error +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, ... ) ATTRIBUTE_GCOBOL_DIAG(2, 3); diff --git a/gcc/cobol/cdf.y b/gcc/cobol/cdf.y index ea3e8c6fb6f..72e46b3f86e 100644 --- a/gcc/cobol/cdf.y +++ b/gcc/cobol/cdf.y @@ -201,7 +201,7 @@ apply_cdf_turn( const exception_turn_t& turn ) { %type namelit name_any name_one %type name subscript subscripts inof %token BOOL -%token FEATURE 366 NUMBER 303 EXCEPTION_NAME 280 "EXCEPTION NAME" +%token FEATURE 367 NUMBER 304 EXCEPTION_NAME 280 "EXCEPTION NAME" %type cdf_expr %type cdf_relexpr cdf_reloper cdf_and cdf_bool_expr @@ -213,52 +213,52 @@ apply_cdf_turn( const exception_turn_t& turn ) { %type cdf_stackable -%token BY 487 -%token COPY 363 -%token CDF_DISPLAY 385 ">>DISPLAY" +%token BY 488 +%token COPY 364 +%token CDF_DISPLAY 386 ">>DISPLAY" %token IN 606 %token NAME 286 -%token NUMSTR 305 "numeric literal" +%token NUMSTR 306 "numeric literal" %token OF 687 %token PSEUDOTEXT 723 %token REPLACING 745 -%token LITERAL 298 -%token SUPPRESS 377 - -%token LSUB 368 "(" -%token SUBSCRIPT 376 RSUB 373 ")" - -%token CDF_DEFINE 384 ">>DEFINE" -%token CDF_IF 386 ">>IF" -%token CDF_ELSE 387 ">>ELSE" -%token CDF_END_IF 388 ">>END-IF" -%token CDF_EVALUATE 389 ">>EVALUATE" -%token CDF_WHEN 390 ">>WHEN" -%token CDF_END_EVALUATE 391 ">>END-EVALUATE" - -%token ALL 451 -%token CALL_CONVENTION 392 ">>CALL-CONVENTION" -%token COBOL_WORDS 381 ">>COBOL-WORDS" -%token CDF_PUSH 395 ">>PUSH" -%token CDF_POP 396 ">>POP" -%token SOURCE_FORMAT 397 ">>SOURCE FORMAT" - -%token AS 469 CONSTANT 362 DEFINED 364 +%token LITERAL 299 +%token SUPPRESS 378 + +%token LSUB 369 "(" +%token SUBSCRIPT 377 RSUB 374 ")" + +%token CDF_DEFINE 385 ">>DEFINE" +%token CDF_IF 387 ">>IF" +%token CDF_ELSE 388 ">>ELSE" +%token CDF_END_IF 389 ">>END-IF" +%token CDF_EVALUATE 390 ">>EVALUATE" +%token CDF_WHEN 391 ">>WHEN" +%token CDF_END_EVALUATE 392 ">>END-EVALUATE" + +%token ALL 452 +%token CALL_CONVENTION 393 ">>CALL-CONVENTION" +%token COBOL_WORDS 382 ">>COBOL-WORDS" +%token CDF_PUSH 396 ">>PUSH" +%token CDF_POP 397 ">>POP" +%token SOURCE_FORMAT 398 ">>SOURCE FORMAT" + +%token AS 470 CONSTANT 363 DEFINED 365 %type DEFINED -%token OTHER 699 PARAMETER_kw 369 "PARAMETER" -%token OFF 688 OVERRIDE 370 +%token OTHER 699 PARAMETER_kw 370 "PARAMETER" +%token OFF 688 OVERRIDE 371 %token THRU 950 %token TRUE_kw 815 "True" -%token CALL_COBOL 393 "CALL" -%token CALL_VERBATIM 394 "CALL (as C)" +%token CALL_COBOL 394 "CALL" +%token CALL_VERBATIM 395 "CALL (as C)" -%token TURN 817 CHECKING 497 LOCATION 650 ON 690 WITH 844 +%token TURN 817 CHECKING 498 LOCATION 650 ON 690 WITH 844 %left OR 951 %left AND 952 %right NOT 953 -%left '<' '>' '=' NE 954 LE 955 GE 956 +%left '<' '>' EQ 298 "EQUAL" NE 954 LE 955 GE 956 %left '-' '+' %left '*' '/' %right NEG 958 @@ -362,7 +362,7 @@ cdf_define: CDF_DEFINE cdf_constant NAME as cdf_expr[value] override } } - | CDF_DEFINE cdf_constant NAME '=' cdf_expr[value] override + | CDF_DEFINE cdf_constant NAME EQ cdf_expr[value] override { /* accept, but as error */ if( scanner_parsing() ) { error_msg(@NAME, "CDF error: %s = value invalid", $NAME); @@ -382,8 +382,9 @@ cdf_define: CDF_DEFINE cdf_constant NAME as cdf_expr[value] override */ { if( 0 == cdf_dictionary().count($NAME) ) { - yywarn("CDF: '%s' is defined AS PARAMETER " - "but was not defined", $NAME); + cbl_message(@NAME, CdfParameterW, + "CDF: '%s' is defined AS PARAMETER " + "but was not defined", $NAME); } } | CDF_DEFINE FEATURE as ON { @@ -563,7 +564,7 @@ cdf_reloper: cdf_relexpr cdf_relexpr: cdf_relexpr '<' cdf_expr { $$ = $1(@1) < $3(@3); } | cdf_relexpr LE cdf_expr { $$ = $1(@1) <= $3(@3); } - | cdf_relexpr '=' cdf_expr { + | cdf_relexpr EQ cdf_expr { $$ = cdfval_t(false); if( ( $1.string && $3.string) || (!$1.string && !$3.string) ) @@ -612,7 +613,8 @@ cdf_factor: NAME { $$ = that->second; } else { if( ! scanner_parsing() ) { - yywarn("CDF skipping: no such variable '%s' (ignored)", $1); + cbl_message(CdfNotFoundW, + "CDF skipping: no such variable '%s'", $1); } else { error_msg(@NAME, "CDF error: no such variable '%s'", $1); } diff --git a/gcc/cobol/cobol1.cc b/gcc/cobol/cobol1.cc index 77c457d496c..5f1260e4f7a 100644 --- a/gcc/cobol/cobol1.cc +++ b/gcc/cobol/cobol1.cc @@ -317,7 +317,7 @@ enable_exceptions( bool enable ) { NULL != (name = strtok(name, ",")); name = NULL ) { ec_type_t type = ec_type_of(name); if( type == ec_none_e ) { - yywarn("unrecognized exception '%s' was ignored", name); + cbl_message(EcUnknownW, "unrecognized exception '%s'", name); continue; } ec_disposition_t disposition = ec_type_disposition(type); @@ -328,17 +328,21 @@ enable_exceptions( bool enable ) { } } +void cobol_warning( cbl_diag_id_t id, int yn, bool ); + static bool cobol_langhook_handle_option (size_t scode, - const char *arg ATTRIBUTE_UNUSED, + const char *arg, HOST_WIDE_INT value, - int kind ATTRIBUTE_UNUSED, + int kind, location_t loc ATTRIBUTE_UNUSED, const struct cl_option_handlers *handlers ATTRIBUTE_UNUSED) { // process_command (decoded_options_count, decoded_options); enum opt_code code = (enum opt_code) scode; + auto super_kind = diagnostics::kind(kind); + bool warning_as_error = super_kind == diagnostics::kind::error; switch(code) { @@ -403,6 +407,8 @@ cobol_langhook_handle_option (size_t scode, return true; case OPT_dialect: + // gcc disallows 0 as an enumerated value, so we used 0x10 for iso. + if( cobol_dialect == 0x100 ) cobol_dialect = 0; cobol_dialect_set(cbl_dialect_t(cobol_dialect)); return true; @@ -439,6 +445,194 @@ cobol_langhook_handle_option (size_t scode, cobol_gcobol_feature_set(feature_internal_ebcdic_e); return true; + // Warnings and errors + + case OPT_Wbinary_long_long: + cobol_warning(MfBinaryLongLong, binary_long_long, warning_as_error); + return true; + + case OPT_Wcall_giving: + cobol_warning(MfCallGiving, call_giving, warning_as_error); + return true; + + case OPT_Wcdf_dollar: + cobol_warning(MfCdfDollar, cdf_dollar, warning_as_error); + return true; + + case OPT_Wcomp_6: + cobol_warning(MfComp6, comp_6, warning_as_error); + return true; + + case OPT_Wcomp_x: + cobol_warning(MfCompX, comp_x, warning_as_error); + return true; + + case OPT_Winspect_trailing: + cobol_warning(MfTrailing, inspect_trailing, warning_as_error); + return true; + + case OPT_Wlevel_1_occurs: + cobol_warning(MfLevel_1_Occurs, level_1_occurs, warning_as_error); + return true; + + case OPT_Wlevel_78_defined: + cobol_warning(Par78CdfDefinedW, level_78_defined, warning_as_error); + return true; + + case OPT_Wmove_pointer: + cobol_warning(MfMovePointer, move_pointer, warning_as_error); + return true; + + case OPT_Wlevel_78: + cobol_warning(MfLevel78, level_78, warning_as_error); + return true; + + case OPT_Wreturning_number: + cobol_warning(MfReturningNum, returning_number, warning_as_error); + return true; + + case OPT_Wusage_typename: + cobol_warning(MfUsageTypename, usage_typename, warning_as_error); + return true; + + case OPT_Wbad_line_directive: + cobol_warning(LexLineE, bad_line_directive, warning_as_error); + return true; + + case OPT_Wequal_assign: + cobol_warning(IbmEqualAssignE, equal_assign, warning_as_error); + return true; + + case OPT_Wbad_numeric: + cobol_warning(ParNumstrW, bad_numeric, warning_as_error); + return true; + + case OPT_Wcdf_invalid_parameter: + cobol_warning(CdfParameterW, cdf_invalid_parameter, warning_as_error); + return true; + + case OPT_Wcdf_name_not_found: + cobol_warning(CdfNotFoundW, cdf_name_not_found, warning_as_error); + return true; + + case OPT_Wcopybook_found: + cobol_warning(LexInputN, copybook_found, warning_as_error); + return true; + + case OPT_Wec_unknown: + cobol_warning(EcUnknownW, ec_unknown, warning_as_error); + return true; + + case OPT_Wentry_convention: + cobol_warning(ParInfoI, entry_convention, warning_as_error); + return true; + + case OPT_Wiconv_error: + cobol_warning(ParIconvE, iconv_error, warning_as_error); + return true; + + case OPT_Winclude_file_found: + cobol_warning(LexIncludeOkN, include_file_found, warning_as_error); + return true; + + case OPT_Winclude_file_not_found: + cobol_warning(LexIncludeE, include_file_not_found, warning_as_error); + return true; + + case OPT_Wliteral_concat: + cobol_warning(ParLiteral2W, literal_concat, warning_as_error); + return true; + + case OPT_Wlocale_error: + cobol_warning(ParLocaleW, locale_error, warning_as_error); + return true; + + case OPT_Wmove_corresponding: + cobol_warning(ParNoCorrespondingW, warn_corresponding, warning_as_error); + return true; + + case OPT_Wnllanginfo_error: + cobol_warning(ParLangInfoW, nllanginfo_error, warning_as_error); + return true; + + case OPT_Wlength_of: + cobol_warning(IbmLengthOf, cobol_length_of, warning_as_error); + return true; + + case OPT_Wpreprocessor_error: + cobol_warning(ParLangInfoW, preprocessor_error, warning_as_error); + return true; + + case OPT_Wprocedure_pointer: + cobol_warning(IbmProcedurePointer, procedure_pointer, warning_as_error); + return true; + + case OPT_Wprocedure_not_found: + cobol_warning(ParUnresolvedProcE, procedure_not_found, warning_as_error); + return true; + + case OPT_Wreplace_error: + cobol_warning(LexReplaceE, replace_error, warning_as_error); + return true; + + case OPT_Wsegment_error: + cobol_warning(IbmSectionRangeE, segment_error, warning_as_error); + return true; + + case OPT_Wsegment_negative: + cobol_warning(IbmSectionNegE, segment_negative, warning_as_error); + return true; + + case OPT_Wsegment: + cobol_warning(IbmSectionSegmentW, cobol_segment, warning_as_error); + return true; + + case OPT_Wcobol_eject: + cobol_warning(IbmEjectE, cobol_eject, warning_as_error); + return true; + + case OPT_Woperator_space: + cobol_warning(LexSeparatorE, operator_space, warning_as_error); + return true; + + case OPT_Wstop_number: + cobol_warning(IbmStopNumber, stop_number, warning_as_error); + return true; + + case OPT_Wstray_indicator: + cobol_warning(LexIndicatorE, stray_indicator, warning_as_error); + return true; + + case OPT_Wcobol_volatile: + // If arg is true, the error becoomes a warning + cobol_warning(IbmVolatileE, cobol_volatile, warning_as_error); + cobol_warning(IbmVolatileW, cobol_volatile, warning_as_error); + return true; + + case OPT_Wcobol_resume: + cobol_warning(IsoResume, cobol_resume, warning_as_error); + return true; + + case OPT_Wapply_commit: + cobol_warning(SynApplyCommit, apply_commit, warning_as_error); + return true; + + case OPT_Whigh_order_bit: + cobol_warning(SynHighOrderBit, high_order_bit, warning_as_error); + return true; + + case OPT_Wfile_code_set: + cobol_warning(SynFileCodeSet, file_code_set, warning_as_error); + return true; + + case OPT_Wset_locale_to: + cobol_warning(SynSetLocaleTo, set_locale_to, warning_as_error); + return true; + + case OPT_Wset_to_locale: + cobol_warning(SynSetToLocale, set_to_locale, warning_as_error); + return true; + default: break; } @@ -514,14 +708,6 @@ cobol_langhook_type_for_mode (enum machine_mode mode, int unsignedp) return NULL; } -////static tree -////cobol_langhook_type_for_size (unsigned int bits ATTRIBUTE_UNUSED, -//// int unsignedp ATTRIBUTE_UNUSED) -//// { -//// gcc_unreachable (); -//// return NULL; -//// } - /* Record a builtin function. We just ignore builtin functions. */ static tree diff --git a/gcc/cobol/except.cc b/gcc/cobol/except.cc index df1c7dfb1d1..31112d1274a 100644 --- a/gcc/cobol/except.cc +++ b/gcc/cobol/except.cc @@ -75,15 +75,6 @@ ec_level( ec_type_t ec ) { return 3; } -void -cbl_enabled_exception_t::dump( int i ) const { - cbl_message(2, "cbl_enabled_exception_t: %2d {%s, %s, %zu}", - i, - location? "location" : " none", - ec_type_str(ec), - file ); -} - void cbl_enabled_exceptions_t::dump() const { extern int yydebug; diff --git a/gcc/cobol/exceptg.h b/gcc/cobol/exceptg.h index f90cc28ebc5..6869f220417 100644 --- a/gcc/cobol/exceptg.h +++ b/gcc/cobol/exceptg.h @@ -77,7 +77,7 @@ class exception_turn_t { bool add_exception( ec_type_t type, const filelist_t& files = filelist_t() ) { ec_disposition_t disposition = ec_type_disposition(type); if( disposition != ec_implemented(disposition) ) { - cbl_unimplementedw("CDF: exception '%s'", ec_type_str(type)); + cbl_unimplementedw(EcUnknownW, "exception %qs", ec_type_str(type)); } auto elem = exceptions.find(type); if( elem != exceptions.end() ) return false; // cannot add twice diff --git a/gcc/cobol/gcobol.1 b/gcc/cobol/gcobol.1 index 0de86dff623..92b22265bb4 100644 --- a/gcc/cobol/gcobol.1 +++ b/gcc/cobol/gcobol.1 @@ -1,4 +1,4 @@ -.ds lang COBOL + .ds lang COBOL .ds gcobol GCC\ \*[lang]\ Front-end .ds isostd ISO/IEC 1989:2023 .Dd \& February 2025 @@ -31,12 +31,58 @@ .Op Fl preprocess Ar preprocess-filter .Op Fl fflex-debug .Op Fl fyacc-debug +.\" warnings +.Op Fl Wno-apply-commit +.Op Fl Wno-file-code-set +.Op Fl Wno-high-order-bit +.Op Fl Wno-bad-line-directive +.Op Fl Wno-bad-numeric +.Op Fl Wno-binary-long-long +.Op Fl Wno-call-giving +.Op Fl Wno-cdf-dollar +.Op Fl Wno-cdf-invalid-parameter +.Op Fl Wno-cdf-name-not-found +.Op Fl Wno-cobol-eject +.Op Fl Wno-cobol-resume +.Op Fl Wno-cobol-volatile +.Op Fl Wno-comp-6 +.Op Fl Wno-comp-x +.Op Fl Wno-copybook-found +.Op Fl Wno-ec-unknown +.Op Fl Wno-entry-convention +.Op Fl Wno-iconv-error +.Op Fl Wno-include-file-found +.Op Fl Wno-include-file-not-found +.Op Fl Wno-inspect-trailing +.Op Fl Wno-length-of +.Op Fl Wno-level-1-occurs +.Op Fl Wno-level-78 +.Op Fl Wno-level-78-defined +.Op Fl Wno-literal-concat +.Op Fl Wno-locale-error +.Op Fl Wno-move-corresponding +.Op Fl Wno-move-pointer +.Op Fl Wno-nllanginfo-error +.Op Fl Wno-operator-space +.Op Fl Wno-preprocessor-error +.Op Fl Wno-procedure-not-found +.Op Fl Wno-procedure-pointer +.Op Fl Wno-replace-error +.Op Fl Wno-returning-number +.Op Fl Wno-segment-error +.Op Fl Wno-segment-negative +.Op Fl Wno-stop-number +.Op Fl Wno-stray-indicator +.Op Fl Wno-usage-typename +.Op Fl Wno-recording-mode +.Op Fl Wno-set-locale-to +.Op Fl Wno-set-to-locale .Ar filename Op ... . .Sh DESCRIPTION .Nm -compiles \*[lang] source code to object code, and optionally produces an -executable binary or shared object. As a GCC component, it accepts +compiles \*[lang] source code to object code, and optionally produces +an executable binary or shared object. As a GCC component, it accepts all options that affect code-generation and linking. Options specific to \*[lang] are listed below. .Bl -tag -width "\0\0debug" @@ -283,30 +329,66 @@ because its value is determined at run time. By default, .Nm accepts \*[lang] syntax as defined by \*[isostd], with some -extensions for backward compatibility with COBOL-85. To make the -compiler more generally useful, some additional syntax is supported by -this option. -.Pp -The value of +extensions for backward compatibility with COBOL-85. Additional syntax is supported with this option. The value of .Ar dialect-name may be -.Bl -tag -compact +.Bl -tag .It ibm -to indicate IBM COBOL 6.3 syntax, specifically -.D1 STOP . +to indicate IBM COBOL 6.4 syntax: +.Bl -bullet -compact +.It +.Sy EJECT +.It +.Sy EQUAL +as assignment operator +.It +.Sy "LENGTH OF" +.It +.Sy "PROCEDURE POINTER" +.It +.Sy SECTION +segment +.It +.Sy STOP + +.It +.Sy VOLATILE +.El .It gnu -to indicate GnuCOBOL syntax +to indicate GnuCOBOL syntax, generally compatible with MicroFocus. .It mf -to indicate MicroFocus syntax, specifically +to indicate MicroFocus syntax: +.Bl -bullet -compact +.It +.Sy BINARY-LONG-LONG +.It +.Sy CALL ... GIVING +.It +.Sy CDF \[Do]IF +.It +.Sy COMPUTATIONAL-6 +.It +.Sy COMPUTATIONAL +used with +.Sy PICTURE X +.It +.Sy INSPECT ... TRAILING +.It +.Sy OCCURS +at +.Sy "LEVEL 01" +.It .Sy LEVEL 78 -constants. +constants +.It +.Sy MOVE POINTER +.It +.Sy RETURNING + +.It +.Sy USAGE IS TYPENAME +.El .El -.Pp -Only a few such non-standard constructs are accepted, and -.Nm -makes no claim to emulate other compilers. But to the extent that a -feature is popular but nonstandard, this option provides a way to -support it, or add it. . .It Fl include Ar filename Process @@ -371,13 +453,117 @@ The should return a zero exit status, indicating success. If it returns a nonzero exit status, an error is reported and the compiler is not invoked. -. .It Fl fflex-debug Ns Li , Fl fyacc-debug produce messages useful for compiler development. The .Fl fflex-debug option prints the tokenized input stream. The .Fl fyacc-debug option shows the shift and reduce actions taken by the parser. +.El +.Ss Diagnostic Messages +.Pp +Many warning options can be used to convert error messages to +warnings, or to suppress messages related to \*[lang] dialects. The +user may mix and match. A group of features may be enabled by +indicating a dialect (or more than one dialect) and individual +features may be enabled as a warning, or error, or suppressed. +.Bl -tag -width Wno-cdf-name-not-found\0\0 -compact +.It Fl Wno-apply-commit +Warn if APPLY COMMIT is used. +.It Fl Wno-bad-line-directive +Warn if malformed %<#line%> directive is encountered. +.It Fl Wno-binary-long-long +Warn if BINARY-LONG-LONG is used. +.It Fl Wno-call_giving +Warn if CALL ... GIVING is used. +.It Fl Wno-cdf-dollar +Warn if CDF \[Do]IF is used. +.It Fl Wno-comp-6 +Warn if COMPUTATIONAL-6 is used. +.It Fl Wno-comp-x +Warn if COMPUTATIONAL is used with PICTURE X. +.It Fl Wno-file-code-set +Warn if FILE CODE SET is used. +.It Fl Wno-inspect-trailing +Warn if INSPECT ... TRAILING is used. +.It Fl Wno-level-1-occurs +Warn if Level 01 is used with OCCURS. +.It Fl Wno-level-78-defined +Warn if CDF defines Level 78 constant. +.It Fl Wno-move-pointer +Warn if MOVE POINTER is used. +.It Fl Wno-returning-number +Warn if RETURNING is used. +.It Fl Wno-usage-typename +Warn if USAGE IS TYPENAME is used. +.It Fl Wno-bad-numeric +Warn if numeric string is invalid. +.It Fl Wno-cdf-invalid-parameter +Warn if referenced CDF PARAMETER is not defined. +.It Fl Wno-cdf-name-not-found +Warn if referenced CDF name is not defined. +.It Fl Wno-cobol-eject +Warn if IBM-style EJECT is used (instead of error). +.It Fl Wno-cobol-resume +Warn if ISO RESUME is used with \-dialect ibm (instead of error). +.It Fl Wno-cobol-volatile +Warn if VOLATILE is used (instead of error if -dialect ibm). +.It Fl Wno-copybook-found +Print message when copybook is processed. +.It Fl Wno-ec-unknown +Warn if unimplemented/unknown exception condition is referenced. +.It Fl Wno-entry-convention +Print message when ENTRY CONVENTION is specified. +.It Fl Wno-high-order-bit +Warn if HIGH-ORDER-LEFT HIGH-ORDER-RIGHT is used. +.It Fl Wno-include-file-found +Print message when include file is processed. +.It Fl Wno-length-of +Warn if LENGTH OF is used. +.It Fl Wno-level-78 +Warn if Level 78 is used. +.It Fl Wno-literal-concat +Warn if concatenated literals use different encodings. +.It Fl Wno-locale-error +Warn if locale(3) fails. +.It Fl Wno-move-corresponding +Warn if COBOL MOVE has no corresponding fields. +.It Fl Wno-nllanginfo-error +Warn if nlanglanginfo(3) fails. +.It Fl Wno-recording-mode +Warn if RECORDING MODE is used. +.It Fl Wno-segment +Warn if SECTION segments are used. +.It Fl Wno-set-locale-to +Warn if SET LOCALE ... TO is used. +.It Fl Wno-set-to-locale +Warn if SET ... TO LOCALE is used. +. +`.\" convert errors to warnings +Warn if a line directive is malformed (instead of error). +.It Fl Wno-iconv-error +Warn if iconv(3) cannot convert between encodings (instead of error). +.It Fl Wno-include-file-not-found +Warn if include file is not found (instead of error). +.It Fl Wno-operator-space +Warn if relational operator not followed by space (instead of error). +.It Fl Wno-preprocessor-error +Warn if a preprocessor fails (instead of error). +.It Fl Wno-procedure-pointer +Warn if PROCEDURE POINTER is used. +.It Fl Wno-procedure-not-found +Warn if a referenced procedure is not found (instead of error). +.It Fl Wno-replace-error +Warn if REPLACE cannot be processed (instead of error). +.It Fl Wno-segment-error +Warn if a SEGMENT section is invalid (instead of error). +.It Fl Wno-segment-negative +Warn if a SEGMENT range is negative (instead of error). +.It Fl Wno-stop-number +Warn if IBM-style STOP is used (instead of error). +.It Fl Wno-stray-indicator +Warn if indicator column has no recognized meaning (instead of error). + .El . .Sh COMPILATION SCENARIOS diff --git a/gcc/cobol/genapi.cc b/gcc/cobol/genapi.cc index 031d1e1dc77..ee325fca2c0 100644 --- a/gcc/cobol/genapi.cc +++ b/gcc/cobol/genapi.cc @@ -4002,12 +4002,11 @@ public: dangling.insert(index_of(label)); } } - bool lay( const cbl_label_t *label ) { + void lay( const cbl_label_t *label ) { auto ok = lain.insert(index_of(label)); if( ok.second ) { dangling.erase(index_of(label)); } - return true; } bool vet() const { // be always agreeable, for now. return dangling.empty(); @@ -8222,17 +8221,7 @@ parser_label_label(struct cbl_label_t *label) CHECK_LABEL(label); -#if 1 - // At the present time, label_verify.lay is returning true, so I edited - // out the if( !... ) to quiet cppcheck label_verify.lay(label); -#else - if( ! label_verify.lay(label) ) - { - yywarn("%s: label %qs already exists", __func__, label->name); - gcc_unreachable(); - } -#endif if(strcmp(label->name, "_end_declaratives") == 0 ) { diff --git a/gcc/cobol/gengen.cc b/gcc/cobol/gengen.cc index f3642f2d736..fa792d618bb 100644 --- a/gcc/cobol/gengen.cc +++ b/gcc/cobol/gengen.cc @@ -523,10 +523,9 @@ gg_find_field_in_struct(const tree base, const char *field_name) if( !field_decl ) { - yywarn("Somebody asked for the field %s.%s, which does not exist", + cbl_internal_error("Somebody asked for the field %s.%s, which does not exist", IDENTIFIER_POINTER(DECL_NAME(base)), field_name); - gcc_unreachable(); } return field_decl; @@ -2153,17 +2152,15 @@ gg_printf(const char *format_string, ...) { if(nargs >= ARG_LIMIT) { - yywarn("You *must* be joking"); - gcc_unreachable(); + cbl_internal_error("You *must* be joking"); } if( TREE_CODE(arg) >= NUM_TREE_CODES) { // Warning: This test is not completely reliable, because a garbage // byte could have a valid TREE_CODE. But it does help. - yywarn("You forgot to put a % at the end of a " - "% again"); - gcc_unreachable(); + cbl_internal_error("You forgot to put a % at the end of a " + "% again"); } args[nargs++] = arg; @@ -2208,8 +2205,7 @@ gg_fprintf(tree fd, int nargs, const char *format_string, ...) { if(argc >= ARG_LIMIT) { - yywarn("You *must* be joking"); - gcc_unreachable(); + cbl_internal_error("You *must* be joking"); } args[argc++] = arg; @@ -2587,9 +2583,8 @@ gg_define_function( tree return_type, { // Warning: This test is not completely reliable, because a garbage // byte could have a valid TREE_CODE. But it does help. - yywarn("You forgot to put a % at the end of a " + cbl_internal_error("You forgot to put a % at the end of a " "% again"); - gcc_unreachable(); } const char *name = va_arg(params, const char *); @@ -2599,8 +2594,7 @@ gg_define_function( tree return_type, nparams += 1; if(nparams > ARG_LIMIT) { - yywarn("%d parameters? Really? Are you insane?", ARG_LIMIT+1); - gcc_unreachable(); + cbl_internal_error("%d parameters? Really? Are you insane?", ARG_LIMIT+1); } } va_end(params); @@ -2748,9 +2742,8 @@ gg_get_function_decl(tree return_type, const char *funcname, ...) { // Warning: This test is not completely reliable, because a garbage // byte could have a valid TREE_CODE. But it does help. - yywarn("You forgot to put a % at the end of a " + cbl_internal_error("You forgot to put a % at the end of a " "% again"); - gcc_unreachable(); } const char *name = va_arg(params, const char *); @@ -2760,9 +2753,8 @@ gg_get_function_decl(tree return_type, const char *funcname, ...) nparams += 1; if(nparams > ARG_LIMIT) { - yywarn("%d parameters? Really? Are you insane?", + cbl_internal_error("%d parameters? Really? Are you insane?", ARG_LIMIT+1); - gcc_unreachable(); } } va_end(params); @@ -3040,8 +3032,7 @@ gg_call_expr(tree return_type, const char *function_name, ...) { if(nargs >= ARG_LIMIT) { - yywarn("You *must* be joking"); - gcc_unreachable(); + cbl_internal_error("You *must* be joking"); } tree arg = va_arg(ap, tree); @@ -3096,8 +3087,7 @@ gg_call(tree return_type, const char *function_name, ...) { if(nargs >= ARG_LIMIT) { - yywarn("You *must* be joking"); - gcc_unreachable(); + cbl_internal_error("You *must* be joking"); } tree arg = va_arg(ap, tree); diff --git a/gcc/cobol/lang-specs.h b/gcc/cobol/lang-specs.h index b7f15179a04..0032b631ac7 100644 --- a/gcc/cobol/lang-specs.h +++ b/gcc/cobol/lang-specs.h @@ -42,6 +42,52 @@ "%{preprocess} " "%{dialect} " "%{include} " + "%{Wno-apply-commit} " + "%{Wno-file-code-set} " + "%{Wno-high-order-bit} " + "%{Wno-bad-line-directive} " + "%{Wno-bad-numeric} " + "%{Wno-binary-long-long} " + "%{Wno-call-giving} " + "%{Wno-cdf-dollar} " + "%{Wno-cdf-invalid-parameter} " + "%{Wno-cdf-name-not-found} " + "%{Wno-cobol-eject} " + "%{Wno-cobol-resume} " + "%{Wno-cobol-volatile} " + "%{Wno-comp-6} " + "%{Wno-comp-x} " + "%{Wno-copybook-found} " + "%{Wno-ec-unknown} " + "%{Wno-entry-convention} " + "%{Wno-iconv-error} " + "%{Wno-include-file-found} " + "%{Wno-include-file-not-found} " + "%{Wno-inspect-trailing} " + "%{Wno-length-of} " + "%{Wno-level-1-occurs} " + "%{Wno-level-78} " + "%{Wno-level-78-defined} " + "%{Wno-literal-concat} " + "%{Wno-locale-error} " + "%{Wno-move-corresponding} " + "%{Wno-move-pointer} " + "%{Wno-nllanginfo-error} " + "%{Wno-operator-space} " + "%{Wno-preprocessor-error} " + "%{Wno-procedure-not-found} " + "%{Wno-procedure-pointer} " + "%{Wno-replace-error} " + "%{Wno-returning-number} " + "%{Wno-segment-error} " + "%{Wno-segment-negative} " + "%{Wno-stop-number} " + "%{Wno-stray-indicator} " + "%{Wno-usage-typename} " + "%{Wno-recording-mode} " + "%{Wno-set-locale-to} " + "%{Wno-set-to-locale} " "%{nomain} " "%{!fsyntax-only:%(invoke_as)} " , 0, 0, 0}, + diff --git a/gcc/cobol/lang.opt b/gcc/cobol/lang.opt index 1f2a61629b9..9c0493ef057 100644 --- a/gcc/cobol/lang.opt +++ b/gcc/cobol/lang.opt @@ -51,16 +51,19 @@ Enum Name(dialect_type) Type(int) UnknownError(Unrecognized COBOL dialect name: %qs) EnumValue -Enum(dialect_type) String(gcc) Value(0x04) Canonical +Enum(dialect_type) String(iso) Value(0x100) EnumValue -Enum(dialect_type) String(ibm) Value(0x01) +Enum(dialect_type) String(gcc) Value(0x01) Canonical EnumValue -Enum(dialect_type) String(mf) Value(0x02) +Enum(dialect_type) String(ibm) Value(0x02) EnumValue -Enum(dialect_type) String(gnu) Value(0x04) +Enum(dialect_type) String(mf) Value(0x04) + +EnumValue +Enum(dialect_type) String(gnu) Value(0x08) fcobol-exceptions Cobol Joined Separate Var(cobol_exceptions) @@ -70,6 +73,249 @@ copyext Cobol Joined Separate Var(cobol_copyext) Init(0) Define alternative implicit copybook filename extension +;; warnings + +; Par78CdfDefinedW +Wlevel-78-defined +Cobol Warning Var(level_78_defined, 1) Init(1) +Warn if CDF defines Level 78 constant + +; MfBinaryLongLong +Wbinary-long-long +Cobol Warning Var(binary_long_long, 1) Init(1) +Warn if BINARY-LONG-LONG is used + +; MfCallGiving +Wcall-giving +Cobol Warning Var(call_giving, 1) Init(1) +Warn if CALL ... GIVING is used + +; MfCdfDollar +Wcdf-dollar +Cobol Warning Var(cdf_dollar, 1) Init(1) +Warn if CDF %<$IF%> is used + +; MfComp6 +Wcomp-6 +Cobol Warning Var(comp_6, 1) Init(1) +Warn if COMPUTATIONAL-6 is used + +; MfCompX +Wcomp-x +Cobol Warning Var(comp_x, 1) Init(1) +Warn if COMPUTATIONAL is used with PICTURE X + +; MfTrailing +Winspect-trailing +Cobol Warning Var(inspect_trailing, 1) Init(1) +Warn if INSPECT ... TRAILING is used + +; MfLevel_1_Occurs +Wlevel-1-occurs +Cobol Warning Var(level_1_occurs, 1) Init(1) +Warn if Level 01 is used with OCCURS + +; MfLevel78 +Wlevel-78 +Cobol Warning Var(level_78, 1) Init(1) +Warn if Level 78 is used + +; MfMovePointer +Wmove-pointer +Cobol Warning Var(move_pointer, 1) Init(1) +Warn if MOVE POINTER is used + +; MfReturningNum +Wreturning-number +Cobol Warning Var(returning_number, 1) Init(1) +Warn if RETURNING is used + +; MfUsageTypename +Wusage-typename +Cobol Warning Var(usage_typename, 1) Init(1) +Warn if USAGE IS TYPENAME is used + +; ParNumstrW +Wbad-numeric +Cobol Warning Var(bad_numeric, 1) Init(1) +Warn if numeric string is invalid + +; CdfParameterW +Wcdf-invalid-parameter +Cobol Warning Var(cdf_invalid_parameter, 1) Init(1) +Warn if referenced CDF PARAMETER is not defined + +; CdfNotFoundW +Wcdf-name-not-found +Cobol Warning Var(cdf_name_not_found, 1) Init(1) +Warn if referenced CDF name is not defined + +; LexInputN +Wcopybook-found +Cobol Warning Var(copybook_found, 1) Init(1) +Print message when copybook is processed + +; EcUnknownW +Wec-unknown +Cobol Warning Var(ec_unknown, 1) Init(1) +Warn if unimplemented/unknown exception condition is referenced + +; ParInfoI +Wentry-convention +Cobol Warning Var(entry_convention, 1) Init(1) +Print message when ENTRY CONVENTION is specified + +; LexIncludeOkN +Winclude-file-found +Cobol Warning Var(include_file_found, 1) Init(1) +Print message when include file is processed + +; ParLiteral2W +Wliteral-concat +Cobol Warning Var(literal_concat, 1) Init(1) +Warn if concatenated literals use different encodings + +; ParLocaleW +Wlocale-error +Cobol Warning Var(locale_error, 1) Init(1) +Warn if locale(3) fails + +; ParNoCorrespondingW +Wmove-corresponding +Cobol Warning Var(warn_corresponding, 1) Init(1) +Warn if COBOL MOVE has no corresponding fields. + +; ParLangInfoW +Wnllanginfo-error +Cobol Warning Var(nllanginfo_error, 1) Init(1) +Warn if nlanglanginfo(3) fails + +; IbmLengthOf +Wlength-of +Cobol Warning Var(cobol_length_of, 1) Init(1) +Warn if LENGTH OF is used + +; IbmProcedurePointer +Wprocedure-pointer +Cobol Warning Var(procedure_pointer, 1) Init(1) +Warn if PROCEDURE POINTER is used + +; IbmSectionSegmentW +Wsegment +Cobol Warning Var(cobol_segment, 1) Init(1) +Warn if SECTION segments are used + +; IsoResume +Wcobol-resume +Cobol Warning Var(cobol_resume, 1) Init(1) +Warn if resume is used (instead of error for IBM) + +;; unimplemented syntax + +; SynApplyCommit +Wapply-commit +Cobol Warning Var(apply_commit, 1) Init(1) +Warn if APPLY COMMIT is used + +; SynHighOrderBit +Whigh-order-bit +Cobol Warning Var(high_order_bit, 1) Init(1) +Warn if HIGH-ORDER-LEFT HIGH-ORDER-RIGHT is used + +; SynFileCodeSet +Wfile-code-set +Cobol Warning Var(file_code_set, 1) Init(1) +Warn if FILE CODE SET is used + +; SynRecordingMode +Wrecording-mode +Cobol Warning Var(recording_mode, 1) Init(1) +Warn if RECORDING MODE is used + +; SynSetLocaleTo +Wset-locale-to +Cobol Warning Var(set_locale_to, 1) Init(1) +Warn if SET LOCALE ... TO is used + +; SynSetToLocale +Wset-to-locale +Cobol Warning Var(set_to_locale, 1) Init(1) +Warn if SET ... TO LOCALE is used + +;; errors to warnings + +; LexLineE +Wbad-line-directive +Cobol Warning Var(bad_line_directive, 1) Init(1) +Warn if a line directive is malformed (instead of error) + +; IbmEqualAssignE +Wequal-assign +Cobol Warning Var(equal_assign, 1) Init(1) +Warn if EQUAL used as assignment operator (instead of error) + +; ParIconvE +Wiconv-error +Cobol Warning Var(iconv_error, 1) Init(1) +Warn if iconv(3) cannot convert between encodings (instead of error) + +; LexIncludeE +Winclude-file-not-found +Cobol Warning Var(include_file_not_found, 1) Init(1) +Warn if include file is not found (instead of error) + +; LexPreprocessE +Wpreprocessor-error +Cobol Warning Var(preprocessor_error, 1) Init(1) +Warn if a preprocessor fails (instead of error) + +; ParUnresolvedProcE +Wprocedure-not-found +Cobol Warning Var(procedure_not_found, 1) Init(1) +Warn if a referenced procedure is not found (instead of error) + +; LexReplaceE +Wreplace-error +Cobol Warning Var(replace_error, 1) Init(1) +Warn if REPLACE cannot be processed (instead of error) + +; IbmSectionRangeE +Wsegment-error +Cobol Warning Var(segment_error, 1) Init(1) +Warn if a SEGMENT section is invalid (instead of error) + +; IbmSectionNegE +Wsegment-negative +Cobol Warning Var(segment_negative, 1) Init(1) +Warn if a SEGMENT range is negative (instead of error) + +; LexIndicatorE +Wstray-indicator +Cobol Warning Var(stray_indicator, 1) Init(1) +Warn if indicator column has no recognized meaning (instead of error) + +; LexSeparatorE +Woperator-space +Cobol Warning Var(operator_space, 1) Init(1) +Warn if relational operator not followed by space (instead of error) + +; IbmEjectE +Wcobol-eject +Cobol Warning Var(cobol_eject, 1) Init(1) +Warn if IBM-style EJECT is used (instead of error) + +; IbmStopNumber +Wstop-number +Cobol Warning Var(stop_number, 1) Init(1) +Warn if IBM-style STOP is used (instead of error) + +; IbmVolatileE +Wcobol-volatile +Cobol Warning Var(cobol_volatile, 1) Init(1) +Warn if VOLATILE is used (instead of error if -dialect ibm) + +;; end error-suppression options + fdefaultbyte Cobol RejectNegative Joined Separate UInteger Var(cobol_default_byte) Set Working-Storage data items to the supplied value diff --git a/gcc/cobol/lexio.cc b/gcc/cobol/lexio.cc index d7a4f1b2814..58cd3ff2d97 100644 --- a/gcc/cobol/lexio.cc +++ b/gcc/cobol/lexio.cc @@ -681,7 +681,8 @@ parse_replacing_term( const char *stmt, const char *estmt ) { } if( extraneous_replacing ) { update_yylloc( cm[0], cm[8] ); - yywarn("syntax error: invalid '%.*s'", cm[8].length(), cm[8].first); + cbl_message(LexReplaceE, "syntax error: invalid '%.*s'", + cm[8].length(), cm[8].first); output.matched = false; return output; } @@ -797,11 +798,11 @@ parse_replacing_pair( const char *stmt, const char *estmt ) { } } if( pair.stmt.p ) { - yywarn("CDF syntax error '%.*s'", (int)pair.stmt.size(), pair.stmt.p); + cbl_message(LexReplaceE, "LEX syntax error '%.*s'", (int)pair.stmt.size(), pair.stmt.p); } else { // This eliminated a compiler warning about "format-overflow" - yywarn("CDF syntax error"); + cbl_message(LexReplaceE, "LEX syntax error"); } pair.stmt = span_t(size_t(0), stmt); pair.replace = replace_t(); @@ -1466,7 +1467,8 @@ preprocess_filter_add( const char input[] ) { auto filename = find_filter(filter.c_str()); if( !filename ) { - yywarn("preprocessor '%s/%s' not found", getcwd(NULL, 0), filter.c_str()); + cbl_message(LexPreprocessE, "preprocessor '%s/%s' not found", + getcwd(NULL, 0), filter.c_str()); return false; } preprocessor_filters.push_back( std::make_pair(xstrdup(filename), options) ); @@ -1477,22 +1479,22 @@ void cdftext::echo_input( int input, const char filename[] ) { int fd; if( -1 == (fd = dup(input)) ) { - yywarn( "could not open preprocessed file %s to echo to standard output", - filename ); + cbl_message(LexPreprocessE, "could not open preprocessed file " + "%s to echo to standard output", filename ); return; } auto mfile = map_file(fd); if( -1 == write(STDOUT_FILENO, mfile.data, mfile.size()) ) { - yywarn( "could not write preprocessed file %s to standard output", + cbl_message(LexPreprocessE, "could not write preprocessed file %s to standard output", filename ); } if( -1 == munmap(mfile.data, mfile.size()) ) { - yywarn( "could not release mapped file" ); + cbl_message(LexPreprocessE, "could not release mapped file" ); } if( -1 == close(fd) ) { - yywarn( "could not close mapped file" ); + cbl_message(LexPreprocessE, "could not close mapped file" ); } } @@ -1515,7 +1517,7 @@ cdftext::lex_open( const char filename[] ) { // Process any files supplied by the -include command-line option. for( auto name : included_files ) { if( -1 == (input = open(name, O_RDONLY)) ) { - yyerrorvl(1, "", "cannot open -include file %s", name); + cbl_message(LexIncludeE, "cannot open %<-include%> file %qs", name); continue; } cobol_filename(name, inode_of(input)); @@ -1569,7 +1571,7 @@ cdftext::lex_open( const char filename[] ) { } int erc; if( -1 == (erc = execv(filter, argv.data())) ) { - yywarn("could not execute %s", filter); + cbl_message(LexPreprocessE, "could not execute %s", filter); } _exit(erc); } @@ -1588,7 +1590,7 @@ cdftext::lex_open( const char filename[] ) { filter, status); } } - yywarn( "applied %s", filter ); + cbl_message(LexIncludeOkN, "applied %s", filter ); } return fdopen( output, "r"); @@ -1604,7 +1606,7 @@ cdftext::open_input( const char filename[] ) { verbose_file_reader = NULL != getenv("GCOBOL_TEMPDIR"); if( verbose_file_reader ) { - yywarn("verbose: opening %s for input", filename); + cbl_message(LexInputN, "verbose: opening %s for input", filename); } return fd; } diff --git a/gcc/cobol/messages.cc b/gcc/cobol/messages.cc new file mode 100644 index 00000000000..423b53a8c34 --- /dev/null +++ b/gcc/cobol/messages.cc @@ -0,0 +1,388 @@ +/* + * Copyright (c) 2021-2025 Symas Corporation + * + * Redistribution and use in source and binary forms, with or without + * modification, are permitted provided that the following conditions are + * met: + * + * * Redistributions of source code must retain the above copyright + * notice, this list of conditions and the following disclaimer. + * * Redistributions in binary form must reproduce the above + * copyright notice, this list of conditions and the following disclaimer + * in the documentation and/or other materials provided with the + * distribution. + * * Neither the name of the Symas Corporation nor the names of its + * contributors may be used to endorse or promote products derived from + * this software without specific prior written permission. + * + * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS + * "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT + * LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR + * A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT + * OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, + * SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT + * LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, + * DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY + * THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT + * (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE + * OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. + */ + +/* + * Define a table of diagnositic messages, each uniquely identified and + * grouped into dialects. The user can select on the command line which + * ones are in effect. + */ + +#include +#include +#include +#undef yy_flex_debug + +#include + +#include +#include +#include +#include +#include +#include +#include +#include "util.h" + +#include "cbldiag.h" +#include "cdfval.h" +#include "lexio.h" + +#include "../../libgcobol/ec.h" +#include "../../libgcobol/common-defs.h" +#include "symbols.h" +#include "inspect.h" +#include "../../libgcobol/io.h" +#include "genapi.h" +#include "genutil.h" +#include "../../libgcobol/charmaps.h" + + + +/* + * As of now, every diagnositc has one id, one message, one kind, and is + * associated with "one" dialect. The dialect could be ORed. If it is, that + * means among the dialects it belongs to, it is always of the same kind. + * + * The diagnositic mask in force during compilation may include/exclude + * features based on their associated dialect and/or by id. It may stipulate + * that a warning is treated as an error, too, but that's up the diagnostic + * framework. If a feature requires a dialect and is not specifically enabled, + * gcobol emits of message of the associated kind, and names the dialect + * required. + */ +struct cbl_diag_t { + cbl_diag_id_t id; + cbl_name_t option; + diagnostics::kind kind; + cbl_dialect_t dialect; + + explicit cbl_diag_t( cbl_diag_id_t id ) + : id(id), option(""), kind(diagnostics::kind::ignored), dialect(dialect_gcc_e) + {} + + cbl_diag_t( cbl_diag_id_t id, + const char option[], + diagnostics::kind kind, + cbl_dialect_t dialect = dialect_iso_e ) + : id(id), option(""), kind(kind), dialect(dialect) + { + gcc_assert(strlen(option) < sizeof(this->option)); + strcpy(this->option, option); + } + + bool operator<( const cbl_diag_t& that ) const { + return id < that.id; + } +}; + +/* + * Initially, errors and warnings are set per the default, dialect gcc. If the + * user chooses dialect iso, all dialect-enabled features are turned into + * errors. If the user selects a more generous dialect, features associated + * with it are set to be ignored. + * + * Individual features may also be suppressed, and all warnings may be elevated + * to errors. + */ +const static auto dialect_mf_gnu = cbl_dialect_t(dialect_mf_e | dialect_gnu_e); +const static auto dialect_ibm_mf_gnu = cbl_dialect_t(dialect_ibm_e | + dialect_mf_e | + dialect_gnu_e); + +std::set cbl_diagnostics { + { CdfNotFoundW, "-Wcdf-name-not-found", diagnostics::kind::warning }, + { CdfParameterW, "-Wcdf-invalid-parameter", diagnostics::kind::warning }, + + { EcUnknownW, "-Wec-unknown", diagnostics::kind::warning }, + + { IbmEjectE, "-Wcobol-eject", diagnostics::kind::error, dialect_ibm_e }, + { IbmLengthOf, "-Wlength-of", diagnostics::kind::error, dialect_ibm_mf_gnu }, + { IbmEqualAssignE, "-Wequal-assign", diagnostics::kind::error, dialect_ibm_e }, + { IbmProcedurePointer, "-Wprocedure-pointer", diagnostics::kind::error, dialect_ibm_mf_gnu }, + { IbmSectionNegE, "-Wsegment-negative", diagnostics::kind::error, dialect_ibm_e }, + { IbmSectionRangeE, "-Wsegment-error", diagnostics::kind::error, dialect_ibm_e }, + { IbmSectionSegmentW, "-Wsegment", diagnostics::kind::warning, dialect_ibm_e }, + { IbmStopNumber, "-Wstop-number", diagnostics::kind::error, dialect_ibm_e }, + { IbmVolatileE, "-Wcobol-volatile", diagnostics::kind::error, dialect_ibm_e }, + { IbmVolatileW, "-Wcobol-volatile", diagnostics::kind::warning, dialect_ibm_e }, + + // RESUME not supported by IBM + { IsoResume, "-Wcobol-resume", diagnostics::kind::error, dialect_ibm_e }, + + { MfBinaryLongLong, "-Wbinary-long-long", diagnostics::kind::error, dialect_mf_gnu }, + { MfCallGiving, "-Wcall-giving", diagnostics::kind::error, dialect_mf_gnu }, + { MfCdfDollar, "-Wcdf-dollar", diagnostics::kind::error, dialect_mf_gnu }, + { MfComp6, "-Wcomp-6", diagnostics::kind::error, dialect_mf_gnu }, + { MfCompX, "-Wcomp-x", diagnostics::kind::error, dialect_mf_gnu }, + { MfLevel_1_Occurs, "Wlevel-1-occurs", diagnostics::kind::error, dialect_mf_gnu }, + { MfLevel78, "-Wlevel-78", diagnostics::kind::error, dialect_mf_gnu }, + { MfMovePointer, "-Wmove-pointer", diagnostics::kind::error, dialect_mf_gnu }, + { MfReturningNum, "-Wreturning-number", diagnostics::kind::error, dialect_mf_gnu }, + { MfUsageTypename, "-Wusage-typename", diagnostics::kind::error, dialect_mf_gnu }, + { MfTrailing, "-Winspect-trailing", diagnostics::kind::error, dialect_mf_gnu }, + + { LexIncludeE, "-Winclude-file-not-found", diagnostics::kind::error }, + { LexIncludeOkN, "-Winclude-file-found", diagnostics::kind::note }, + { LexIndicatorE, "-Wstray-indicator", diagnostics::kind::error }, + { LexInputN, "-Wcopybook-found", diagnostics::kind::note }, + { LexLineE, "-Wbad-line-directive", diagnostics::kind::error }, + { LexPreprocessE, "-Wpreprocessor-error", diagnostics::kind::error }, + { LexReplaceE, "-Wreplace-error", diagnostics::kind::error }, + // mf and gnu do not require whitespace after relational operators + { LexSeparatorE, "-Woperator-space", diagnostics::kind::error, dialect_mf_gnu }, + + { Par78CdfDefinedW, "-Wlevel-78-defined", diagnostics::kind::warning }, + { ParIconvE, "-Wiconv-error", diagnostics::kind::note }, + { ParInfoI, "-Wentry-convention", diagnostics::kind::note }, + { ParLangInfoW, "-Wnllanginfo-error", diagnostics::kind::warning }, + { ParLiteral2W, "-Wliteral-concat", diagnostics::kind::warning }, + { ParLocaleW, "-Wlocale-error", diagnostics::kind::warning }, + { ParNoCorrespondingW, "-Wmove-corresponding", diagnostics::kind::warning }, + { ParNumstrW, "-Wbad-numeric", diagnostics::kind::warning }, + { ParUnresolvedProcE, "-Wprocedure-not-found", diagnostics::kind::error }, + + // unimplmeneted syntax warnings + { SynApplyCommit, "-Wapply-commit", diagnostics::kind::warning }, + { SynFileCodeSet, "-Wfile-code-set", diagnostics::kind::warning }, + { SynHighOrderBit, "-Whigh-order-bit", diagnostics::kind::warning }, + { SynRecordingMode, "-Wrecording-mode", diagnostics::kind::warning }, + { SynSetLocaleTo, "-Wset-locale-to", diagnostics::kind::warning }, + { SynSetToLocale, "-Wset-to-locale", diagnostics::kind::warning }, + +}; + +static struct set_verify { + set_verify() { + gcc_assert(cbl_diagnostics.size() == DiagDiagDiag); + auto p = std::find_if(cbl_diagnostics.begin(), cbl_diagnostics.end(), + []( const auto& diag ) { + return '?' == cbl_dialect_str(diag.dialect)[0]; + } ); + if( p != cbl_diagnostics.end() ) { + fprintf(stderr, "unregconized dialect '%04x (~%04x)'", p->dialect, ~p->dialect); + } + gcc_assert( std::none_of(cbl_diagnostics.begin(), cbl_diagnostics.end(), + []( const auto& diag ) { + return '?' == cbl_dialect_str(diag.dialect)[0]; + } ) ); + } +} verify_consistent_message_count; + +static inline diagnostics::kind +kind_of( cbl_diag_id_t id ) { + auto diag = cbl_diagnostics.find(cbl_diag_t(id)); + if( diag != cbl_diagnostics.end() ) { + return diag->kind; + } + return diagnostics::kind::ice; +} + +diagnostics::kind +cbl_diagnostic_kind( cbl_diag_id_t id ) { + return kind_of(id); +} + +bool +cbl_diagnostic_kind( cbl_diag_id_t id, diagnostics::kind kind ) { + auto p = cbl_diagnostics.find( cbl_diag_t{id} ); + if( p != cbl_diagnostics.end() ) { + auto diag(*p); + diag.kind = kind; + cbl_diagnostics.erase(p); + return cbl_diagnostics.insert(diag).second; + } + return false; +} + +bool +cbl_diagnostic_kind( cbl_dialect_t dialect, diagnostics::kind kind ) { + bool ok = true; + for( auto diag : cbl_diagnostics ) { + if( diag.dialect == dialect ) { + if( ! cbl_diagnostic_kind(diag.id, kind) ) ok = false; + } + } + return ok; +} + +void +cobol_warning( cbl_diag_id_t id, int yn, bool warning_as_error ) { + gcc_assert( 0 <= yn && yn <= 1 ); + + diagnostics::kind kind = yn? + diagnostics::kind::warning : diagnostics::kind::ignored; + + if( warning_as_error ) { + kind = diagnostics::kind::error; + } + + cbl_diagnostic_kind(id, kind); +} + +static inline const char * +option_of( cbl_diag_id_t id ) { + auto diag = cbl_diagnostics.find(cbl_diag_t(id)); + if( diag != cbl_diagnostics.end() && diag->option[0] ) { + return diag->option; + } + return nullptr; +} + +const char * +cbl_diagnostic_option( cbl_diag_id_t id ) { + return option_of(id); +} + +/* + * This is the general message looker-upper. It determines whether the + * diagnositic is in force, at what level, and the message text, and invokes + * the framework. + */ +extern int yychar; +extern YYLTYPE yylloc; + +static const diagnostics::option_id option_zero; + +location_t current_token_location(); +location_t current_token_location(const location_t& loc); + +bool +cbl_message( cbl_diag_id_t id, const char gmsgid[], ... ) { + auto_diagnostic_group d; + const char *option; + char *msg = nullptr; + + diagnostics::kind kind = kind_of(id); + if( kind == diagnostics::kind::ignored ) return false; + + if( (option = option_of(id)) != nullptr ) { + msg = xasprintf("%s [%s]", gmsgid, option); + gmsgid = msg; + } + + va_list ap; + + va_start (ap, gmsgid); + auto ret = emit_diagnostic_valist( kind, current_token_location(), + option_zero, gmsgid, &ap ); + va_end (ap); + free(msg); + + return ret; +} + +bool cbl_message( cbl_loc_t loc, cbl_diag_id_t id, const char gmsgid[], ... ) { + class temp_loc_t { // copied from util.cc + location_t orig; + public: + temp_loc_t() : orig(current_token_location()) { + if( yychar < 3 ) return; + + 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()) { + gcc_location_set(loc); + } + ~temp_loc_t() { + if( orig != current_token_location() ) { + current_token_location(orig); + } + } + }; + + auto_diagnostic_group d; + const char *option; + char *msg = nullptr; + + diagnostics::kind kind = kind_of(id); + if( kind == diagnostics::kind::ignored ) return false; + + if( (option = option_of(id)) != nullptr ) { + msg = xasprintf("%s [%s]", gmsgid, option); + gmsgid = msg; + } + + temp_loc_t looker(loc); + va_list ap; + + va_start (ap, gmsgid); + rich_location richloc (line_table, current_token_location()); + auto ret = emit_diagnostic_valist( kind, + current_token_location(), + option_zero, gmsgid, &ap ); + va_end (ap); + free(msg); + + return ret; +} + +/* + * Verify the dialect associated with the id (and thus term) is covered by the + * dialects currently in effect. If not, issue a standard message of the kind + * defined by the id. Possible combinations: + * dialect required: ok, dialect matches feature dialect + * dialect prohibits not_ok, dialect matches feature ~dialect + * + * If ok is false, then a match means the dialect prohibits the feature. + */ +bool +dialect_ok( const cbl_loc_t& loc, cbl_diag_id_t id, const char term[], bool ok ) { + auto diag = cbl_diagnostics.find(cbl_diag_t(id)); + + const char *verb = "requires"; + + if( diag == cbl_diagnostics.end() ) { + gcc_unreachable(); + } + + if( diag->kind == diagnostics::kind::ignored ) return true; + + if( dialect_has(diag->dialect) ) { + if( ok ) { + return true; + } else { + verb = "prohibits"; + } + } else { + if( !ok ) return true; // current dialect correctly does not match the feature + } + + cbl_message(loc, id, "%qs %s %<-dialect %s%>", + term, verb, cbl_dialect_str(diag->dialect)); + return false; +} + + + + + diff --git a/gcc/cobol/parse.y b/gcc/cobol/parse.y index 46d7a96bb0a..ad292b9b03a 100644 --- a/gcc/cobol/parse.y +++ b/gcc/cobol/parse.y @@ -359,7 +359,7 @@ class locale_tgt_t { NUMED_CR "NUMERIC-EDITED CR picture" NUMED_DB "NUMERIC-EDITED DB picture" %token NINEDOT NINES NINEV PIC_P ONES -%token SPACES +%token SPACES EQ "EQUAL" %token LITERAL %token END EOP %token FILENAME @@ -477,8 +477,8 @@ class locale_tgt_t { DOWN DUPLICATES DYNAMIC - E EBCDIC EC EGCS ENCODING ENTRY ENVIRONMENT EQUAL EVERY - EXAMINE EXHIBIT EXP EXP10 EXTEND EXTERNAL + E EBCDIC EC EGCS ENCODING ENTRY ENVIRONMENT + EVERY EXAMINE EXHIBIT EXP EXP10 EXTEND EXTERNAL EXCEPTION_FILE "EXCEPTION-FILE" EXCEPTION_FILE_N "EXCEPTION-FILE-N" @@ -1130,7 +1130,7 @@ class locale_tgt_t { DYNAMIC E EBCDIC EC EGCS ELEMENT - ENTRY ENVIRONMENT EQUAL ERROR EVERY + ENTRY ENVIRONMENT ERROR EVERY EXAMINE EXCEPTION EXHIBIT EXP EXP10 EXTEND EXTERNAL EXCEPTION_FILE @@ -1336,7 +1336,7 @@ class locale_tgt_t { %left OR %left AND %right NOT -%left '<' '>' '=' NE LE GE +%left '<' '>' EQ NE LE GE %left '-' '+' %left '*' '/' %right POW @@ -1658,21 +1658,25 @@ opt_round: DEFAULT ROUNDED mode is rounded_type[type] { } ; opt_entry: ENTRY_CONVENTION is COBOL { - yywarn("ENTRY-CONVENTION IS COBOL, check"); + cbl_message(ParInfoI, "ENTRY-CONVENTION IS COBOL"); } ; opt_binary: FLOAT_BINARY default_kw is HIGH_ORDER_LEFT { - cbl_unimplementedw("HIGH-ORDER-LEFT was ignored"); + cbl_unimplementedw(SynHighOrderBit, + "HIGH-ORDER-LEFT was ignored"); if( ! current.option_binary(cbl_options_t::high_order_left_e) ) { - error_msg(@3, "unable to set %"); + cbl_message(@3, SynHighOrderBit, + "unable to set %"); } } | FLOAT_BINARY default_kw is HIGH_ORDER_RIGHT[opt] { - cbl_unimplementedw("HIGH-ORDER-RIGHT was ignored"); + cbl_unimplementedw(SynHighOrderBit, + "HIGH-ORDER-RIGHT was ignored"); if( ! current.option_binary(cbl_options_t::high_order_right_e) ) { - error_msg(@opt, "unable to set HIGH-ORDER-RIGHT"); + cbl_message(@opt, SynHighOrderBit, + "unable to set HIGH-ORDER-RIGHT"); } } ; @@ -1681,30 +1685,38 @@ default_kw: %empty ; opt_decimal: FLOAT_DECIMAL default_kw is HIGH_ORDER_LEFT[opt] { - cbl_unimplementedw("HIGH-ORDER-LEFT was ignored"); + cbl_unimplementedw(SynHighOrderBit, + "HIGH-ORDER-LEFT was ignored"); if( ! current.option_decimal(cbl_options_t::high_order_left_e) ) { - error_msg(@opt, "unable to set HIGH-ORDER-LEFT"); + cbl_message(@opt, SynHighOrderBit, + "unable to set HIGH-ORDER-LEFT"); } } | FLOAT_DECIMAL default_kw is HIGH_ORDER_RIGHT[opt] { - cbl_unimplementedw("HIGH-ORDER-RIGHT was ignored"); + cbl_unimplementedw(SynHighOrderBit, + "HIGH-ORDER-RIGHT was ignored"); if( ! current.option_decimal(cbl_options_t::high_order_right_e) ) { - error_msg(@opt, "unable to set HIGH-ORDER-RIGHT"); + cbl_message(@opt, SynHighOrderBit, + "unable to set HIGH-ORDER-RIGHT"); } } | FLOAT_DECIMAL default_kw is BINARY_ENCODING[opt] { - cbl_unimplementedw("BINARY-ENCODING was ignored"); + cbl_unimplementedw(SynHighOrderBit, + "BINARY-ENCODING was ignored"); if( ! current.option(cbl_options_t::binary_encoding_e) ) { - error_msg(@opt, "unable to set BINARY-ENCODING option"); + cbl_message(@opt, SynHighOrderBit, + "unable to set BINARY-ENCODING option"); } } | FLOAT_DECIMAL default_kw is DECIMAL_ENCODING[opt] { - cbl_unimplementedw("DECIMAL-ENCODING was ignored"); + cbl_unimplementedw(SynHighOrderBit, + "DECIMAL-ENCODING was ignored"); if( ! current.option(cbl_options_t::decimal_encoding_e) ) { - error_msg(@opt, "unable to set DECIMAL-ENCODING option"); + cbl_message(@opt, SynHighOrderBit, + "unable to set DECIMAL-ENCODING option"); } } ; @@ -1888,7 +1900,8 @@ io_control_clause: } | APPLY COMMIT on field_list { - cbl_unimplementedw("I-O-CONTROL APPLY COMMIT"); + cbl_unimplementedw(SynApplyCommit, + "I-O-CONTROL APPLY COMMIT ignored"); } ; area: %empty @@ -3160,14 +3173,16 @@ fd_clause: record_desc error_msg(@NAME, "invalid RECORDING MODE '%s'", $NAME); YYERROR; } - cbl_unimplementedw("RECORDING MODE was ignored, not defined by ISO 2023"); + cbl_unimplementedw(SynRecordingMode, + "RECORDING MODE ignored"); } | VALUE OF fd_values | CODESET is codeset_name[codeset] { auto f = cbl_file_of(symbol_at(file_section_fd)); f->codeset = cbl_file_t::codeset_t($codeset.encoding, $codeset.isym); - cbl_unimplementedw("sorry, unimplemented CODE-SET"); + cbl_unimplementedw(SynFileCodeSet, + "sorry, unimplemented CODE-SET"); } | CODESET for alphanational is codeset_name[codeset] { @@ -3758,24 +3773,23 @@ data_descr1: level_name | LEVEL78 NAME[name] VALUE is value78[data] { - if( ! (dialect_mf() || dialect_gnu()) ) { - dialect_error(@1, "level 78", "mf or gnu"); - YYERROR; - } + dialect_ok(@1, MfLevel78, "LEVEL 78"); cbl_field_t field = { FldLiteralA, constant_e, *$data.data, 78, $name, @name.first_line }; if( field.data.initial ) { field.attr |= quoted_e; field.codeset.set($data.encoding); if( !cdf_value(field.name, field.data.initial) ) { - yywarn("%s was defined by CDF", field.name); + cbl_message(Par78CdfDefinedW, + "%s was defined by CDF", field.name); } } else { field.type = FldLiteralN; field.data.initial = string_of(field.data.value_of()); field.codeset.set($data.encoding); if( !cdf_value(field.name, field.as_integer()) ) { - yywarn("%s was defined by CDF", field.name); + cbl_message(Par78CdfDefinedW, + "%s was defined by CDF", field.name); } } if( ($$ = field_add(@name, &field)) == NULL ) { @@ -4062,8 +4076,9 @@ literalism: LITERAL { $$ = $1; } if( $second.prefix[0] ) { strcpy(output.prefix, $second.prefix); } if( ! $first.compatible_prefix($second) ) { - yywarn("dissimilar literals, '%s' prevails", - output.prefix); + cbl_message(@$, ParLiteral2W, + "dissimilar literals, '%s' prevails", + output.prefix); } } ; @@ -4173,13 +4188,11 @@ data_clauses: data_clause if( field->is_binary_integer() && field->data.capacity == 4) { auto redefined = symbol_redefines(field); if( redefined && redefined->type == FldPointer ) { - if( yydebug ) { - yywarn("expanding %s size from %u bytes to %wd " - "because it redefines %s with %", - field->name, field->size(), - int_size_in_bytes(ptr_type_node), - redefined->name); - } + dbgmsg("expanding %s size from %u bytes to %lu " + "because it redefines %s with USAGE POINTER", + field->name, field->size(), + int_size_in_bytes(ptr_type_node), + redefined->name); field->embiggen(); } } @@ -4213,7 +4226,7 @@ data_clause: any_length { $$ = any_length_e; } cbl_field_t *field = current_field(); switch( field->level ) { case 1: - if( dialect_mf() ) break; + if( dialect_ok(@$, MfLevel_1_Occurs, "LEVEL 01 for OCCURS") ) break; __attribute__((fallthrough)); case 77: case 88: @@ -4336,7 +4349,7 @@ picture_clause: PIC signed nps[fore] nines nps[aft] if( field->type == FldNumericBin5 && field->data.capacity == 0xFF && - (dialect_gnu() || dialect_mf()) ) + dialect_ok(@2, MfCompX, "alphanumeric PICTURE with numeric USAGE") ) { // PIC X COMP-X or COMP-9 if( ! field->has_attr(all_x_e) ) { error_msg(@2, "COMP PICTURE requires all X%'s or all 9%'s"); @@ -4568,22 +4581,15 @@ usage_clause1: usage BIT case FldAlphanumeric: // PIC X COMP-5 or COMP-X assert( field->data.digits == 0 ); assert( field->data.rdigits == 0 ); - if( (dialect_mf() || dialect_gnu()) ) { - field->type = $comp.type; - field->clear_attr(signable_e); - } else { - error_msg(@comp, "numeric USAGE invalid " - "with Alphanumeric PICTURE"); - dialect_error(@1, "Alphanumeric COMP-5 or COMP-X", "mf or gnu"); - YYERROR; - } + dialect_ok(@2, MfCompX, "alphanumeric PICTURE with numeric USAGE"); + + field->type = $comp.type; + field->clear_attr(signable_e); break; case FldNumericDisplay: // PIC 9 COMP-5 or COMP-X if( $comp.capacity == 0xFF ) { // comp-x is a bit like comp-5 assert( field->data.digits == field->data.capacity ); - if( ! (dialect_mf() || dialect_gnu()) ) { - dialect_error(@1, "COMP-X", "mf or gnu"); - } + dialect_ok(@2, MfCompX, "alphanumeric PICTURE with numeric USAGE"); } field->type = $comp.type; field->data.capacity = type_capacity(field->type, @@ -4596,9 +4602,7 @@ usage_clause1: usage BIT case FldPacked: // comp-6 is unsigned comp-3 assert(! $comp.signable); // else PACKED_DECIMAL from scanner field->attr |= separate_e; - if( ! dialect_mf() ) { - dialect_error(@1, "COMP-6", "mf"); - } + dialect_ok(@2, MfComp6, "COMP-6"); if( field->type == FldNumericDisplay ) {// PICTURE before USAGE infer = false; assert(field->data.capacity > 0); @@ -4649,22 +4653,14 @@ usage_clause1: usage BIT case FldAlphanumeric: // PIC X COMP-5 or COMP-X assert( field->data.digits == 0 ); assert( field->data.rdigits == 0 ); - if( (dialect_mf() || dialect_gnu()) ) { - field->type = $comp.type; - field->clear_attr(signable_e); - } else { - error_msg(@comp, "numeric USAGE invalid " - "with Alphanumeric PICTURE"); - dialect_error(@1, "Alphanumeric COMP-5 or COMP-X", "mf or gnu"); - YYERROR; - } + dialect_ok(@2, MfCompX, "alphanumeric PICTURE with numeric USAGE"); + field->type = $comp.type; + field->clear_attr(signable_e); break; case FldNumericDisplay: // PIC 9 COMP-5 or COMP-X if( $comp.capacity == 0xFF ) { // comp-x is a bit like comp-5 assert( field->data.digits == field->data.capacity ); - if( ! (dialect_mf() || dialect_gnu()) ) { - dialect_error(@1, "COMP-X", "mf or gnu"); - } + dialect_ok(@2, MfCompX, "alphanumeric PICTURE with numeric USAGE"); } field->type = $comp.type; field->data.capacity = type_capacity(field->type, @@ -4677,9 +4673,7 @@ usage_clause1: usage BIT case FldPacked: // comp-6 is unsigned comp-3 assert(! $comp.signable); // else PACKED_DECIMAL from scanner field->attr |= separate_e; - if( ! dialect_mf() ) { - dialect_error(@1, "COMP-6", "mf"); - } + dialect_ok(@2, MfComp6, "COMP-6"); if( field->type == FldNumericDisplay ) {// PICTURE before USAGE infer = false; assert(field->data.capacity > 0); @@ -5074,10 +5068,7 @@ type_clause: TYPE to typename } | USAGE is typename { - if( ! dialect_mf() ) { - dialect_error(@typename, "USAGE TYPENAME", "mf"); - YYERROR; - } + dialect_ok(@typename, MfUsageTypename, "USAGE TYPENAME"); cbl_field_t *field = current_field(); if( $typename ) { const auto e = symbol_field_same_as(field, $typename); @@ -5112,10 +5103,8 @@ typedef_clause: is TYPEDEF strong volatile_clause: VOLATILE { - if( dialect_ibm() ) { - yywarn("VOLATILE has no effect"); - } else { - dialect_error(@1, "VOLATILE", "ibm"); + if( dialect_ok(@1, IbmVolatileE, "VOLATILE") ) { + cbl_message(@1, IbmVolatileW, "VOLATILE has no effect"); } } ; @@ -5272,10 +5261,9 @@ sentence: statements '.' std::set externals = current.end_program(); if( !externals.empty() ) { for( const auto& name : externals ) { - yywarn("%s calls external symbol '%s'", + dbgmsg("%s calls external symbol '%s'", prog->name, name.c_str()); } - YYERROR; } // pointer still valid because name is in symbol table ast_end_program(prog->name); @@ -5692,9 +5680,10 @@ add_body: sum TO rnames corresponding_arith_fields( $sum->refers.front().field, rhs.front().refer.field ); if( pairs.empty() ) { - yywarn( "%s and %s have no corresponding fields", - $sum->refers.front().field->name, - rhs.front().refer.field->name ); + cbl_message( @$, ParNoCorrespondingW, + "%s and %s have no corresponding fields", + $sum->refers.front().field->name, + rhs.front().refer.field->name ); } // First src/tgt elements are templates. // Their subscripts apply to the correspondents. @@ -5854,21 +5843,16 @@ compute_body: rnames { statement_begin(@$, COMPUTE); } compute_expr[expr] { $$.expr = $expr; } ; -compute_expr: '=' { +compute_expr: EQ { + if( $1[0] == 'E' ) { // lexer found EQUALS keyword + dialect_ok(@1, IbmEqualAssignE, + "EQUAL as assignment operator" ); + } current.compute_begin(); } expr { $$ = $expr; } ; - | EQUAL { - if( ! dialect_ibm() ) { - dialect_error(@1, "EQUAL invalid as assignment operator", "ibm"); - } - current.compute_begin(); - } expr { - $$ = $expr; - } - ; display: disp_body end_display[advance] { @@ -6079,9 +6063,8 @@ end_program: end_program1[end] '.' std::set externals = current.end_program(); if( !externals.empty() ) { for( const auto& name : externals ) { - yywarn("%s calls external symbol '%s'", prog->name, name.c_str()); + dbgmsg("%s calls external symbol '%s'", prog->name, name.c_str()); } - YYERROR; } // pointer still valid because name is in symbol table ast_end_program(prog->name); @@ -6192,9 +6175,7 @@ exit_with: %empty } | RETURNING stop_status { - if( ! dialect_mf() ) { - dialect_error(@2, "RETURNING ", "mf"); - } + dialect_ok(@$, MfReturningNum, "RETURNING "); $$ = $stop_status? $stop_status : new_reference(literally_one); } ; @@ -7229,8 +7210,9 @@ move: MOVE scalar TO move_tgts[tgts] } if( !move_corresponding(*$to, *$from) ) { - yywarn( "%s and %s have no corresponding fields", - $from->field->name, $to->field->name ); + cbl_message( @$, ParNoCorrespondingW, + "%s and %s have no corresponding fields", + $from->field->name, $to->field->name ); } } ; @@ -7407,7 +7389,7 @@ arith_err: SIZE_ERROR relop: '<' { $$ = '<'; } | LE { $$ = LE; } - | '=' { $$ = '='; } + | EQ { $$ = EQ; } | NE { $$ = NE; } | GE { $$ = GE; } | '>' { $$ = '>'; } @@ -7442,25 +7424,19 @@ num_value: scalar // might actually be a string | LENGTH_OF binary_type[size] { location_set(@1); $$ = new cbl_refer_t( new_tempnumeric(none_e) ); - if( dialect_gcc() ) { - dialect_error(@1, "LENGTH OF", "ibm"); - } + dialect_ok(@1, IbmLengthOf, "LENGTH OF"); parser_set_numeric($$->field, $size); } | LENGTH_OF name[val] { location_set(@1); $$ = new cbl_refer_t( new_tempnumeric(none_e) ); - if( dialect_gcc() ) { - dialect_error(@1, "LENGTH OF", "ibm"); - } + dialect_ok(@1, IbmLengthOf, "LENGTH OF"); parser_set_numeric($$->field, $val->data.capacity); } | LENGTH_OF name[val] subscripts[subs] { location_set(@1); $$ = new cbl_refer_t( new_tempnumeric(none_e) ); - if( dialect_gcc() ) { - dialect_error(@1, "LENGTH OF", "ibm"); - } + dialect_ok(@1, IbmLengthOf, "LENGTH OF"); if( 0 == dimensions($val) ) { cbl_refer_t r1($val); subscript_dimension_error( @subs, $subs->refers.size(), &r1 ); @@ -7488,7 +7464,7 @@ num_value: scalar // might actually be a string /* cce_relexpr: cce_expr */ /* | cce_relexpr '<' cce_expr { $$ = $1 < $3; } */ /* | cce_relexpr LE cce_expr { $$ = $1 <= $3; } */ -/* | cce_relexpr '=' cce_expr { $$ = $1 == $3; } */ +/* | cce_relexpr EQ cce_expr { $$ = $1 == $3; } */ /* | cce_relexpr NE cce_expr { $$ = $1 != $3; } */ /* | cce_relexpr GE cce_expr { $$ = $1 >= $3; } */ /* | cce_relexpr '>' cce_expr { $$ = $1 > $3; } */ @@ -7553,23 +7529,19 @@ section_name: NAME section_kw '.' section_kw: SECTION { - if( $1 ) { + if( $1 && dialect_ok(@1, IbmSectionSegmentW, "SECTION segment") ) { + cbl_message(@1, IbmSectionSegmentW, + "SECTION segment %qs was ignored", $1); if( *$1 == '-' ) { - error_msg(@1, "SECTION segment %qs is negative", $1); + cbl_message(@1, IbmSectionNegE, + "SECTION segment %qs is negative", $1); } else { - if( dialect_ibm() ) { - int sectno; - sscanf($1, "%d", §no); - if( ! (0 <= sectno && sectno <= 99) ) { - error_msg(@1, "SECTION segment %qs must be 0-99", $1); - } else { - if(false) { // stand-in for warning, someday. - yywarn("SECTION segment %qs was ignored", $1); - } - } - } else { - cbl_unimplemented("SECTION segment %qs is not ISO syntax", $1); - } + int sectno; + sscanf($1, "%d", §no); + if( ! (0 <= sectno && sectno <= 99) ) { + cbl_message(@1, IbmSectionRangeE, + "SECTION segment %qs must be 0-99", $1); + } } } } @@ -7587,10 +7559,7 @@ stop: STOP RUN exit_with | STOP NUMSTR[status] // IBM syntax { statement_begin(@1, STOP); - if( ! dialect_ibm() ) { - dialect_error(@2, "STOP is not ISO syntax,", "ibm"); - YYERROR; - } + dialect_ok(@2, IbmStopNumber, "STOP "); cbl_refer_t status( new_literal($status.string, $status.radix) ); parser_see_stop_run( status, NULL ); } @@ -7674,25 +7643,19 @@ signed_literal: num_literal | LENGTH_OF binary_type[size] { location_set(@1); $$ = new_tempnumeric(none_e); - if( dialect_gcc() ) { - dialect_error(@1, "LENGTH OF", "ibm"); - } + dialect_ok(@1, IbmLengthOf, "LENGTH OF"); parser_set_numeric($$, $size); } | LENGTH_OF name[val] { location_set(@1); $$ = new_tempnumeric(none_e); - if( dialect_gcc() ) { - dialect_error(@1, "LENGTH OF", "ibm"); - } + dialect_ok(@1, IbmLengthOf, "LENGTH OF"); parser_set_numeric($$, $val->data.capacity); } | LENGTH_OF name[val] subscripts[subs] { location_set(@1); $$ = new_tempnumeric(none_e); - if( dialect_gcc() ) { - dialect_error(@1, "LENGTH OF", "ibm"); - } + dialect_ok(@1, IbmLengthOf, "LENGTH OF"); if( 0 == dimensions($val) ) { cbl_refer_t r1($val); subscript_dimension_error( @subs, $subs->refers.size(), &r1 ); @@ -8198,9 +8161,10 @@ subtract_body: sum FROM rnames corresponding_arith_fields( $sum->refers.front().field, rhs.front().refer.field ); if( pairs.empty() ) { - yywarn( "%s and %s have no corresponding fields", - $sum->refers.front().field->name, - rhs.front().refer.field->name ); + cbl_message(ParNoCorrespondingW, + "%s and %s have no corresponding fields", + $sum->refers.front().field->name, + rhs.front().refer.field->name ); } // First src/tgt elements are templates. // Their subscripts apply to the correspondents. @@ -8241,25 +8205,19 @@ varg1a: ADDRESS OF scalar { | LENGTH_OF binary_type[size] { location_set(@1); $$ = new cbl_refer_t( new_tempnumeric(none_e) ); - if( dialect_gcc() ) { - dialect_error(@1, "LENGTH OF", "ibm"); - } + dialect_ok(@1, IbmLengthOf, "LENGTH OF"); parser_set_numeric($$->field, $size); } | LENGTH_OF name[val] { location_set(@1); $$ = new cbl_refer_t( new_tempnumeric(none_e) ); - if( dialect_gcc() ) { - dialect_error(@1, "LENGTH OF", "ibm"); - } + dialect_ok(@1, IbmLengthOf, "LENGTH OF"); parser_set_numeric($$->field, $val->size()); } | LENGTH_OF name[val] subscripts[subs] { location_set(@1); $$ = new cbl_refer_t( new_tempnumeric(none_e) ); - if( dialect_gcc() ) { - dialect_error(@1, "LENGTH OF", "ibm"); - } + dialect_ok(@1, IbmLengthOf, "LENGTH OF"); if( 0 == dimensions($val) ) { cbl_refer_t r1($val); subscript_dimension_error( @subs, $subs->refers.size(), &r1 ); @@ -8879,10 +8837,7 @@ start_body: filename[file] int size = key == 0 ? 0 : $file->keys[key - 1].size(); auto ksize = new_tempnumeric(); parser_set_numeric(ksize, size); - if( yydebug ) { - yywarn("START: key #%d '%s' has size %d", - key, $key->name, size); - } + dbgmsg("START: key #%d '%s' has size %d", key, $key->name, size); $$ = file_start_args.init(@file, $file); parser_file_start( $file, relop_of($relop), key, ksize ); } @@ -9069,7 +9024,8 @@ set: SET set_tgts[tgts] TO set_operand[src] default: gcc_unreachable(); } - cbl_unimplementedw("unimplemented: SET TO LOCALE"); + cbl_unimplementedw(SynSetToLocale, + "unimplemented: %"); } ; | SET set_tgts[tgts] UP BY num_operand[src] @@ -9139,7 +9095,8 @@ set: SET set_tgts[tgts] TO set_operand[src] } else { // do something $tgt->lc_categories() } - cbl_unimplementedw("unimplemented: SET LOCALE"); + cbl_unimplementedw(SynSetLocaleTo, + "unimplemented: %"); } ; @@ -9260,7 +9217,7 @@ search_1_cases: search_1_case lookahead = keyword_str(yychar); } } - yywarn("Just one case, lookahead is '%s'", lookahead); + dbgmsg("Just one case, lookahead is '%s'", lookahead); } } | search_1_cases search_1_case @@ -9314,7 +9271,7 @@ search_stmts: statements %prec ADD search_terms: search_term | search_terms AND search_term ; -search_term: scalar[key] '=' search_expr[sarg] +search_term: scalar[key] EQ search_expr[sarg] { if( $key->nsubscript() == 0 ) { error_msg(@1, "no index for key"); @@ -9764,9 +9721,7 @@ tally_forth: CHARACTERS insp_mtqual[q] scalar[next_tally] | TRAILING tally_matches[q] { $q->bound = bound_trailing_e; $$ = $q; - if( ! dialect_mf() ) { - dialect_error(@1, "TRAILING", "mf"); - } + dialect_ok(@1, MfTrailing, "TRAILING"); } ; @@ -9897,9 +9852,7 @@ first_leading: FIRST { $$ = bound_first_e; } | ALL { $$ = bound_all_e; } | LEADING { $$ = bound_leading_e; } | TRAILING { $$ = bound_trailing_e; - if( ! dialect_mf() ) { - dialect_error(@1, "TRAILING", "mf"); - } + dialect_ok(@1, MfTrailing, "TRAILING"); } ; @@ -10089,9 +10042,7 @@ call_body: ffi_name ; call_returning: RETURNING | GIVING { - if( !dialect_mf() ) { - dialect_error(@1, "CALL ... GIVING", "mf"); - } + dialect_ok(@1, MfCallGiving, "CALL ... GIVING"); } ; @@ -10343,13 +10294,13 @@ go_to: GOTO labels[args] resume: RESUME NEXT STATEMENT { statement_begin(@1, RESUME); - if( dialect_proscribed( @1, dialect_ibm_e, "RESUME") ) YYERROR; + dialect_not_ok( @1, IsoResume, "RESUME"); parser_clear_exception(); } | RESUME label_1[tgt] { statement_begin(@1, RESUME); - if( dialect_proscribed( @1, dialect_ibm_e, "RESUME") ) YYERROR; + dialect_not_ok( @1, IsoResume, "RESUME"); parser_clear_exception(); $tgt->used = @1.first_line; parser_goto( cbl_refer_t(), 1, &$tgt ); @@ -12289,7 +12240,7 @@ relop_of(int token) { switch(token) { case '<': return lt_op; case LE: return le_op; - case '=': return eq_op; + case EQ: return eq_op; case NE: return ne_op; case GE: return ge_op; case '>': return gt_op; @@ -12322,7 +12273,7 @@ relop_debug_str(int token) { case 0: return "zilch"; case '<': return "<"; case LE: return "LE"; - case '=': return "="; + case EQ: return "="; case NE: return "NE"; case GE: return "GE"; case '>': return ">"; @@ -12336,7 +12287,7 @@ token_of(enum relop_t op) { switch(op) { case lt_op: return '<'; case le_op: return LE; - case eq_op: return '='; + case eq_op: return EQ; case ne_op: return NE; case ge_op: return GE; case gt_op: return '>'; @@ -12807,7 +12758,7 @@ struct stringify_src_t : public cbl_string_src_t { protected: static void dump_input( const cbl_refer_t& refer ) { - yywarn( "%s: %s", __func__, field_str(refer.field) ); + dbgmsg( "%s: %s", __func__, field_str(refer.field) ); } }; @@ -12817,13 +12768,13 @@ stringify( refer_collection_t *inputs, cbl_label_t *on_error, cbl_label_t *not_error ) { - std::vector sources(inputs->lists.size()); - if( inputs->lists.back().marker == NULL ) { inputs->lists.back().marker = cbl_refer_t::empty(); } assert( inputs->lists.back().marker ); - std::copy( inputs->lists.begin(), inputs->lists.end(), sources.begin() ); + + std::vector sources(inputs->lists.begin(), inputs->lists.end()); + parser_string( into, pointer, sources.size(), sources.data(), on_error, not_error ); } @@ -13114,7 +13065,7 @@ numstr2i( const char input[], radix_t radix ) { case boolean_e: for( const char *p = input; *p != '\0'; p++ ) { if( ssize_t(8 * sizeof(integer) - 1) < p - input ) { - yywarn("'%s' was accepted as %zu", input, integer); + dbgmsg("'%s' was accepted as %lu", input, (unsigned long)integer); break; } switch(*p) { @@ -13124,7 +13075,7 @@ numstr2i( const char input[], radix_t radix ) { integer |= ((*p) == '0' ? 0 : 1); break; default: - yywarn("'%s' was accepted as %zu", input, integer); + dbgmsg("'%s' was accepted as %lu", input, (unsigned long)integer); break; } } @@ -13132,7 +13083,7 @@ numstr2i( const char input[], radix_t radix ) { return output; } if( erc == -1 ) { - yywarn("'%s' was accepted as %zu", input, integer); + cbl_message(ParNumstrW, "'%s' was accepted as %zu", input, integer); } return output; } @@ -13843,6 +13794,7 @@ mode_syntax_only() { void cobol_dialect_set( cbl_dialect_t dialect ) { switch(dialect) { + case dialect_iso_e: case dialect_gcc_e: break; case dialect_ibm_e: diff --git a/gcc/cobol/parse_ante.h b/gcc/cobol/parse_ante.h index b838240e65c..54d1f9a358f 100644 --- a/gcc/cobol/parse_ante.h +++ b/gcc/cobol/parse_ante.h @@ -189,16 +189,6 @@ has_clause( int data_clauses, data_clause_t clause ) { return clause == (data_clauses & clause); } -static bool -dialect_proscribed( const YYLTYPE& loc, cbl_dialect_t dialect, const char msg[] ) { - if( dialect == cbl_dialects ) { - error_msg(loc, "dialect %s does not allow syntax: %qs", - cbl_dialect_str(dialect), msg); - return true; - } - return false; -} - static bool is_cobol_charset( const char name[] ) { auto eoname = name + strlen(name); @@ -2072,21 +2062,14 @@ static class current_t { parser_leave_section( programs.top().section ); programs.pop(); -#if 0 - if( programs.empty() ) { - // The default encoding can be changed only with -finternal-ebcdic, and - // remains in effect for all programs while the compiler runs. - // This comment here to remind us. - default_encoding = prog_descr_t::encoding_t::encoding_base_t(); - } -#endif debugging_clients.clear(); error_clients.clear(); exception_clients.clear(); if( ref ) { - yywarn("could not resolve paragraph (or section) '%s' at line %d", - ref->paragraph(), ref->line_number()); + cbl_message(ParUnresolvedProcE, + "could not resolve paragraph (or section) '%s' at line %d", + ref->paragraph(), ref->line_number()); // add string to indicate ambiguity error externals.insert(":ambiguous:"); } @@ -2227,11 +2210,10 @@ static class current_t { } void antecedent_dump() const { - if( ! yydebug ) return; if( ! antecedent_cache.operand ) { - yywarn( "Antecedent: none" ); + dbgmsg( "Antecedent: none" ); } else { - yywarn( "Antecedent: %c %s %s %c", + dbgmsg( "Antecedent: %c %s %s %c", antecedent_cache.invert? '!':' ', name_of(antecedent_cache.operand->field), relop_str(antecedent_cache.relop), @@ -3139,8 +3121,7 @@ parser_move_carefully( const char */*F*/, int /*L*/, if( ! valid_move( tgt.field, src.field ) ) { if( src.field->type == FldPointer && tgt.field->type == FldPointer ) { - if( dialect_mf() || dialect_gnu() ) return true; - dialect_error(src.loc, "MOVE POINTER", "mf"); + dialect_ok(src.loc, MfMovePointer, "MOVE POINTER"); } if( ! is_index ) { char ach[16]; @@ -3612,7 +3593,7 @@ goodnight_gracie() { if( !externals.empty() ) { for( const auto& name : externals ) { - yywarn("%s calls external symbol '%s'", + dbgmsg("%s calls external symbol '%s'", prog->name, name.c_str()); } return false; diff --git a/gcc/cobol/scan.l b/gcc/cobol/scan.l index 9d24daab829..75b2f3c7d2a 100644 --- a/gcc/cobol/scan.l +++ b/gcc/cobol/scan.l @@ -762,7 +762,9 @@ EVERY { return EVERY; } ERROR { return ERROR; } EVALUATE { return EVALUATE; } -EQUALS? { return '='; } +EQUALS? { ydflval.string = yylval.string = xstrdup(yytext); + return '='; } + ENVIRONMENT[[:blank:]]+DIVISION { return ENVIRONMENT_DIV; } ENTRY { return ENTRY; } @@ -900,11 +902,7 @@ ACCESS { return ACCESS; } ACCEPT { return ACCEPT; } DELETE { return DELETE; } -EJECT{DOTEOL}? { - if( ! dialect_ibm() ) { - dialect_error(yylloc, "EJECT is not ISO syntax,", "ibm"); - } - } +EJECT{DOTEOL}? { dialect_ok(yylloc, IbmEjectE, "EJECT"); } INSERTT { return INSERTT; } LABEL { return LABEL; } PROCESS { return PROCESS; } @@ -1007,9 +1005,7 @@ USE({SPC}FOR)? { return USE; } BINARY-SHORT { return bcomputable(FldNumericBin5, 2); } BINARY-LONG { return bcomputable(FldNumericBin5, 4); } BINARY-DOUBLE { return bcomputable(FldNumericBin5, 8); } - BINARY-LONG-LONG { if( ! dialect_mf() ) { - dialect_error(yylloc, yytext, "mf"); - } + BINARY-LONG-LONG { dialect_ok(yylloc, MfBinaryLongLong, "BINARY-LONG-LONG"); return bcomputable(FldNumericBin5, 8); } @@ -1044,9 +1040,8 @@ USE({SPC}FOR)? { return USE; } PROGRAM-POINTER { yylval.field_attr = prog_ptr_e; return POINTER; } POINTER { yylval.field_attr = none_e; return POINTER; } - PROCEDURE-POINTER { if( dialect_gcc() ) { - dialect_error(yylloc, yytext, "ibm or mf"); - } + PROCEDURE-POINTER { + dialect_ok(yylloc, IbmProcedurePointer, yytext); yylval.field_attr = prog_ptr_e; return POINTER; // return it anyway } @@ -1086,13 +1081,11 @@ USE({SPC}FOR)? { return USE; } DEPENDING { return DEPENDING; } DESCENDING { return DESCENDING; } DISPLAY { return DISPLAY; } - EJECT{DOTEOL}? { - if( ! dialect_ibm() ) { - dialect_error(yylloc, "EJECT is not ISO syntax,", "ibm"); - } - auto len = yyleng - 1; - if( yytext[len] == '\f' ) myless(--len); - } + EJECT{DOTEOL}? { + dialect_ok(yylloc, IbmEjectE, "EJECT"); + auto len = yyleng - 1; + if( yytext[len] == '\f' ) myless(--len); + } EXTERNAL { return EXTERNAL; } FALSE { return FALSE_kw; } FROM { return FROM; } @@ -1506,16 +1499,21 @@ USE({SPC}FOR)? { return USE; } { (IS{SPC})?"<" { return '<'; } (IS{SPC})?"<=" { return LE; } - (IS{SPC})?"=" { return '='; } + (IS{SPC})?"=" { static char eq[] = "="; + ydflval.string = yylval.string = eq; + return EQ; } (IS{SPC})?"<>" { return NE; } (IS{SPC})?">=" { return GE; } (IS{SPC})?">" { return '>'; } - {LESS_THAN} { return '<'; } + {LESS_THAN} { return '<'; } {LESS_THAN}{SPC}{OR_EQUAL}/[[:space:]] { return LE; } - (IS{SPC})?EQUALS?({SPC}TO)?/[[:space:]] { return '='; } + (IS{SPC})?EQUALS?({SPC}TO)?/[[:space:]] { + static char eq[] = "EQUAL"; + ydflval.string = yylval.string = eq; + return EQ; } {GREATER_THAN}{SPC}{OR_EQUAL}/[[:space:]] { return GE; } - {GREATER_THAN} { return '>'; } + {GREATER_THAN} { return '>'; } {ISNT}{OSPC}">=" { verify_ws(yytext[yyleng - 3]); return '<'; } {ISNT}{OSPC}">" { verify_ws(yytext[yyleng - 2]); return LE; } @@ -1992,7 +1990,8 @@ BASIS { yy_push_state(basis); return BASIS; } {STRING} { yy_pop_state(); yypush_buffer_state( yy_create_buffer(yyin, YY_BUF_SIZE) ); if( (yyin = cdftext::lex_open(yytext)) == NULL ) { - yywarn("could not open BASIS file '%s'", yytext); + cbl_message(yylloc, LexIncludeE, + "could not open BASIS file '%s'", yytext); yyterminate(); } } @@ -2003,7 +2002,8 @@ BASIS { yy_push_state(basis); return BASIS; } } { - EQUALS?{OSPC}/[(] { return '='; } + EQUALS?{OSPC}/[(] { ydflval.string = yylval.string = xstrdup(yytext); + return EQ; } {NAME}{OSPC}/[(] { /* If /{OSPC}, "dangerous trailing context" "*/ if( is_integer_token() ) return numstr_of(yytext); @@ -2084,21 +2084,15 @@ BASIS { yy_push_state(basis); return BASIS; } ^[ ]*>>{OBLANK}ELSE { return CDF_ELSE; } ^[ ]*>>{OBLANK}END-IF { return CDF_END_IF; } - ^[ ]*[$]{OBLANK}IF { if( ! dialect_mf() ) { - dialect_error(yylloc, yytext, "mf"); - } + ^[ ]*[$]{OBLANK}IF { dialect_ok(yylloc, MfCdfDollar, yytext); yy_push_state(cdf_state); return CDF_IF; } - ^[ ]*[$]{OBLANK}ELSE { if( ! dialect_mf() ) { - dialect_error(yylloc, yytext, "mf"); - } + ^[ ]*[$]{OBLANK}ELSE { dialect_ok(yylloc, MfCdfDollar, yytext); return CDF_ELSE; } - ^[ ]*[$]{OBLANK}END { if( ! dialect_mf() ) { - dialect_error(yylloc, yytext, "mf"); - } + ^[ ]*[$]{OBLANK}END { dialect_ok(yylloc, MfCdfDollar, yytext); return CDF_END_IF; } ^[ ]*[$]{OBLANK}SET({SPC}CONSTANT)? { - if( ! dialect_mf() ) dialect_error(yylloc, yytext, "mf"); + dialect_ok(yylloc, MfCdfDollar, yytext); yy_push_state(cdf_state); return CDF_DEFINE; } ^[ ]*>>{OBLANK}EVALUATE { return CDF_EVALUATE; } @@ -2293,7 +2287,8 @@ BASIS { yy_push_state(basis); return BASIS; } END-SUBTRACT { return END_SUBTRACT; } END-WRITE { return END_WRITE; } ENVIRONMENT { return ENVIRONMENT; } - EQUAL { return EQUAL; } + EQUAL { ydflval.string = yylval.string = xstrdup(yytext); + return EQ; } ERROR { return ERROR; } EVALUATE { return EVALUATE; } EXCEPTION { return EXCEPTION; } diff --git a/gcc/cobol/scan_ante.h b/gcc/cobol/scan_ante.h index a6ec99bef6b..e75bb383a71 100644 --- a/gcc/cobol/scan_ante.h +++ b/gcc/cobol/scan_ante.h @@ -295,7 +295,7 @@ static class parsing_status_t : public std::stack { void splat() const { int i=0; for( const auto& status : c ) { - yywarn( "%d %s", ++i, status.str() ); + dbgmsg( "%d %s", ++i, status.str() ); } } } parsing; @@ -316,11 +316,9 @@ bool scanner_normal() { return parsing.normal(); } void scanner_parsing( int token, bool tf ) { parsing.push( cdf_status_t(token, tf) ); - if( yydebug ) { - yywarn("%s: parsing now %s, depth %zu", - keyword_str(token), boolalpha(parsing.on()), parsing.size()); - parsing.splat(); - } + dbgmsg("%s: parsing now %s, depth %zu", + keyword_str(token), boolalpha(parsing.on()), parsing.size()); + parsing.splat(); } void scanner_parsing_toggle() { if( parsing.empty() ) { @@ -328,10 +326,8 @@ void scanner_parsing_toggle() { return; } parsing.top().toggle(); - if( yydebug ) { - yywarn("%s: parsing now %s", - keyword_str(CDF_ELSE), boolalpha(parsing.on())); - } + dbgmsg("%s: parsing now %s", + keyword_str(CDF_ELSE), boolalpha(parsing.on())); } void scanner_parsing_pop() { if( parsing.empty() ) { @@ -339,12 +335,10 @@ void scanner_parsing_pop() { return; } parsing.pop(); - if( yydebug ) { - yywarn("%s: parsing now %s, depth %zu", - keyword_str(CDF_END_IF), boolalpha(parsing.on()), - parsing.size()); - parsing.splat(); - } + dbgmsg("%s: parsing now %s, depth %zu", + keyword_str(CDF_END_IF), boolalpha(parsing.on()), + parsing.size()); + parsing.splat(); } @@ -640,11 +634,9 @@ binary_integer_usage( const char name[]) { } static void -verify_ws( const YYLTYPE& loc, const char input[], char ch ) { +verify_ws( const YYLTYPE& loc, const char [] /* input[] */, char ch ) { if( ! fisspace(ch) ) { - if( ! (dialect_mf() || dialect_gnu()) ) { - dialect_error(loc, "separator space required in %qs", input); - } + dialect_ok(loc, LexSeparatorE, "missing separator space"); } } #define verify_ws(C) verify_ws(yylloc, yytext, C) @@ -676,7 +668,7 @@ level_of( const char input[] ) { if( input[0] == '0' ) input++; if( 1 != sscanf(input, "%u", &output) ) { - yywarn( "%s:%d: invalid level '%s'", __func__, __LINE__, input ); + cbl_internal_error( "%s:%d: invalid level '%s'", __func__, __LINE__, input ); } return output; @@ -1221,7 +1213,7 @@ typed_name( const char name[] ) { return cbl_field_of(e)->level == 88? NAME88 : CLASS_NAME; break; default: - yywarn("%s:%d: invalid symbol type %s for symbol %qs", + cbl_internal_error("%s:%d: invalid symbol type %s for symbol %qs", __func__, __LINE__, cbl_field_type_str(type), name); return NAME; } @@ -1253,8 +1245,14 @@ integer_of( const char input[], bool is_hex = false) { if( input[0] == '0' ) input++; if( 1 != sscanf(input, fmt, &output) ) { - yywarn( "%s:%d: invalid integer '%s'", __func__, __LINE__, input ); + cbl_internal_error( "%s:%d: invalid integer '%s'", __func__, __LINE__, input ); } return output; } + + + + + + diff --git a/gcc/cobol/scan_post.h b/gcc/cobol/scan_post.h index 01c863ed1cd..cb729b3f9aa 100644 --- a/gcc/cobol/scan_post.h +++ b/gcc/cobol/scan_post.h @@ -120,7 +120,8 @@ datetime_format_of( const char input[] ) { if( 0 != (erc = regcomp(&p->re, p->regex, cflags)) ) { static char msg[80]; regerror(erc, &p->re, msg, sizeof(msg)); - yywarn("%s:%d: %s: %s", __func__, __LINE__, keyword_str(p->token), msg); + cbl_internal_error("%s:%d: %s: %s", __func__, __LINE__, + keyword_str(p->token), msg); } } } @@ -293,12 +294,12 @@ prelex() { if( YY_START == field_state && level_needed() ) { switch( token ) { case NUMSTR: - if( yy_flex_debug ) yywarn("final token is NUMSTR"); + dbgmsg("final token is NUMSTR"); yylval.number = level_of(yylval.numstr.string); token = LEVEL; break; case YDF_NUMBER: - if( yy_flex_debug ) yywarn("final token is %"); + dbgmsg("final token is YDF_NUMBER"); yylval.number = ydflval.number; token = LEVEL; break; diff --git a/gcc/cobol/show_parse.h b/gcc/cobol/show_parse.h index 7945e904573..a5f1467dfaa 100644 --- a/gcc/cobol/show_parse.h +++ b/gcc/cobol/show_parse.h @@ -449,19 +449,15 @@ extern bool cursor_at_sol; do { \ if(!a) \ { \ - yywarn("%s: parameter %<" #a "%> is NULL", __func__); \ - gcc_unreachable(); \ - abort(); \ + cbl_internal_error("%s: parameter %<" #a "%> is NULL", __func__); \ } \ if( !a->var_decl_node ) \ { \ - yywarn("%s: parameter %<" #a "%> is variable " \ + cbl_internal_error("%s: parameter %<" #a "%> is variable " \ "%s<%s> with NULL %", \ __func__, \ a->name, \ cbl_field_type_str(a->type) ); \ - gcc_unreachable(); \ - abort(); \ } \ } while(0); @@ -470,19 +466,15 @@ extern bool cursor_at_sol; do { \ if(!a) \ { \ - yywarn("%s: parameter %<" #a "%> is NULL", __func__); \ - gcc_unreachable(); \ - abort(); \ + cbl_internal_error("%s: parameter %<" #a "%> is NULL", __func__); \ } \ if( !a->var_decl_node && a->type != FldConditional && a->type != FldLiteralA) \ { \ - yywarn("%s: parameter %<" #a "%> is variable " \ + cbl_internal_error("%s: parameter %<" #a "%> is variable " \ "%s<%s> with NULL %", \ __func__, \ a->name, \ cbl_field_type_str(a->type) ); \ - gcc_unreachable(); \ - abort(); \ } \ } while(0); @@ -491,9 +483,7 @@ extern bool cursor_at_sol; do{ \ if(!a) \ { \ - yywarn("%s: parameter %<" #a "%> is NULL", __func__); \ - gcc_unreachable(); \ - abort(); \ + cbl_internal_error("%s: parameter %<" #a "%> is NULL", __func__); \ } \ }while(0); diff --git a/gcc/cobol/symbols.cc b/gcc/cobol/symbols.cc index 4a9c8564c99..a177fcdfa62 100644 --- a/gcc/cobol/symbols.cc +++ b/gcc/cobol/symbols.cc @@ -1318,7 +1318,7 @@ static struct symbol_elem_t * switch( group->level ) { case 1: case 77: - if( dialect_mf() && is_table(group) ) { + if( is_table(group) ) { size_t elem_size = std::max(group->data.memsize, group->data.memsize); group->data.memsize = elem_size * group->occurs.ntimes(); } @@ -1783,7 +1783,7 @@ symbols_update( size_t first, bool parsed_ok ) { break; case 1: pend = calculate_capacity(p); - if( dialect_mf() && is_table(field) ) { + if( is_table(field) ) { if( field->data.memsize < field->size() ) { field->data.memsize = field->size(); } @@ -3858,7 +3858,9 @@ cbl_field_t::internalize() { iconv_t cd = tocodes[toname]; if (cd == (iconv_t)-1) { - yywarn("failed % tocode = %qs fromcode = %qs", tocode, fromcode); + cbl_message(ParIconvE, + "failed % tocode = %qs fromcode = %qs", + tocode, fromcode); } if( fromcode == tocode || has_attr(hex_encoded_e) ) { diff --git a/gcc/cobol/symbols.h b/gcc/cobol/symbols.h index 2f3cb9a0a78..e0a71958223 100644 --- a/gcc/cobol/symbols.h +++ b/gcc/cobol/symbols.h @@ -51,20 +51,28 @@ extern const char *numed_message; enum cbl_dialect_t { - dialect_gcc_e = 0x00, - dialect_ibm_e = 0x01, - dialect_mf_e = 0x02, - dialect_gnu_e = 0x04, + dialect_iso_e = 0x00, + dialect_gcc_e = 0x01, + dialect_ibm_e = 0x02, + dialect_mf_e = 0x04, + dialect_gnu_e = 0x08, }; static inline const char * cbl_dialect_str(cbl_dialect_t dialect) { switch(dialect) { + case dialect_iso_e: return "iso"; case dialect_gcc_e: return "gcc"; case dialect_ibm_e: return "ibm"; case dialect_mf_e: return "mf"; case dialect_gnu_e: return "gnu"; } + + switch(size_t(dialect)) { + case dialect_mf_e | dialect_gnu_e: return "mf or gnu"; + case dialect_ibm_e | dialect_mf_e | dialect_gnu_e: return "ibm or mf or gnu"; + } + return "???"; }; @@ -86,6 +94,15 @@ static inline bool dialect_gnu() { return dialect_gnu_e == (cbl_dialects & dialect_gnu_e ); } +static inline bool dialect_has( cbl_dialect_t dialect) { + return 0 < (cbl_dialects & dialect); +} + +#ifdef GCC_DIAGNOSTIC_H +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, @@ -1715,9 +1732,9 @@ struct cbl_alphabet_t { } void dump() const { - yywarn("%qs: %s, %<%c%> to %<%c%> (low 0x%x, high 0x%x)", - name, encoding_str(encoding), - low_index, last_index, low_index, high_index); + dbgmsg("%s: '%s', '%c' to '%c' (low 0x%x, high 0x%x)", + name, encoding_str(encoding), + low_index, last_index, low_index, high_index); if( encoding == custom_encoding_e ) { fprintf(stderr, "\t" " 0 1 2 3 4 5 6 7" diff --git a/gcc/cobol/token_names.h b/gcc/cobol/token_names.h index ceb277713f4..8ce64728b23 100644 --- a/gcc/cobol/token_names.h +++ b/gcc/cobol/token_names.h @@ -1,5 +1,5 @@ -// generated by ./token_names.h.gen ../../build/gcc/cobol/parse.h -// Tue Nov 11 22:26:46 EST 2025 +// generated by /home/jklowden/projects/3rd/gcc/parser/gcc/cobol/token_names.h.gen cobol/parse.h +// Wed Nov 26 11:57:23 EST 2025 tokens = { { "identification", IDENTIFICATION_DIV }, // 258 { "environment", ENVIRONMENT_DIV }, // 259 @@ -42,268 +42,268 @@ tokens = { { "ones", ONES }, // 296 { "spaces", SPACES }, // 297 { "space", SPACES }, // 297 - { "literal", LITERAL }, // 298 - { "end", END }, // 299 - { "eop", EOP }, // 300 - { "filename", FILENAME }, // 301 - { "invalid", INVALID }, // 302 - { "number", NUMBER }, // 303 - { "negative", NEGATIVE }, // 304 - { "numstr", NUMSTR }, // 305 - { "overflow", OVERFLOW_kw }, // 306 - { "binary-integer", BINARY_INTEGER }, // 307 - { "computational", COMPUTATIONAL }, // 308 - { "perform", PERFORM }, // 309 - { "backward", BACKWARD }, // 310 - { "positive", POSITIVE }, // 311 - { "pointer", POINTER }, // 312 - { "section", SECTION }, // 313 - { "standard-alphabet", STANDARD_ALPHABET }, // 314 - { "switch", SWITCH }, // 315 - { "upsi", UPSI }, // 316 - { "zero", ZERO }, // 317 - { "zeros", ZERO }, // 317 - { "zeroes", ZERO }, // 317 - { "sysin", SYSIN }, // 318 - { "sysipt", SYSIPT }, // 319 - { "sysout", SYSOUT }, // 320 - { "syslist", SYSLIST }, // 321 - { "syslst", SYSLST }, // 322 - { "syspunch", SYSPUNCH }, // 323 - { "syspch", SYSPCH }, // 324 - { "console", CONSOLE }, // 325 - { "c01", C01 }, // 326 - { "c02", C02 }, // 327 - { "c03", C03 }, // 328 - { "c04", C04 }, // 329 - { "c05", C05 }, // 330 - { "c06", C06 }, // 331 - { "c07", C07 }, // 332 - { "c08", C08 }, // 333 - { "c09", C09 }, // 334 - { "c10", C10 }, // 335 - { "c11", C11 }, // 336 - { "c12", C12 }, // 337 - { "csp", CSP }, // 338 - { "s01", S01 }, // 339 - { "s02", S02 }, // 340 - { "s03", S03 }, // 341 - { "s04", S04 }, // 342 - { "s05", S05 }, // 343 - { "afp-5a", AFP_5A }, // 344 - { "stdin", STDIN }, // 345 - { "stdout", STDOUT }, // 346 - { "stderr", STDERR }, // 347 - { "list", LIST }, // 348 - { "map", MAP }, // 349 - { "nolist", NOLIST }, // 350 - { "nomap", NOMAP }, // 351 - { "nosource", NOSOURCE }, // 352 - { "might-be", MIGHT_BE }, // 353 - { "function-udf", FUNCTION_UDF }, // 354 - { "function-udf-0", FUNCTION_UDF_0 }, // 355 - { "default", DEFAULT }, // 356 - { "date-fmt", DATE_FMT }, // 357 - { "time-fmt", TIME_FMT }, // 358 - { "datetime-fmt", DATETIME_FMT }, // 359 - { "basis", BASIS }, // 360 - { "cbl", CBL }, // 361 - { "constant", CONSTANT }, // 362 - { "copy", COPY }, // 363 - { "defined", DEFINED }, // 364 - { "enter", ENTER }, // 365 - { "feature", FEATURE }, // 366 - { "insertt", INSERTT }, // 367 - { "lsub", LSUB }, // 368 - { "parameter", PARAMETER_kw }, // 369 - { "override", OVERRIDE }, // 370 - { "ready", READY }, // 371 - { "reset", RESET }, // 372 - { "rsub", RSUB }, // 373 - { "service-reload", SERVICE_RELOAD }, // 374 - { "star-cbl", STAR_CBL }, // 375 - { "subscript", SUBSCRIPT }, // 376 - { "suppress", SUPPRESS }, // 377 - { "title", TITLE }, // 378 - { "trace", TRACE }, // 379 - { "use", USE }, // 380 - { "cobol-words", COBOL_WORDS }, // 381 - { "equate", EQUATE }, // 382 - { "undefine", UNDEFINE }, // 383 - { "cdf-define", CDF_DEFINE }, // 384 - { "cdf-display", CDF_DISPLAY }, // 385 - { "cdf-if", CDF_IF }, // 386 - { "cdf-else", CDF_ELSE }, // 387 - { "cdf-end-if", CDF_END_IF }, // 388 - { "cdf-evaluate", CDF_EVALUATE }, // 389 - { "cdf-when", CDF_WHEN }, // 390 - { "cdf-end-evaluate", CDF_END_EVALUATE }, // 391 - { "call-convention", CALL_CONVENTION }, // 392 - { "call-cobol", CALL_COBOL }, // 393 - { "call-verbatim", CALL_VERBATIM }, // 394 - { "cdf-push", CDF_PUSH }, // 395 - { "cdf-pop", CDF_POP }, // 396 - { "source-format", SOURCE_FORMAT }, // 397 - { "if", IF }, // 398 - { "then", THEN }, // 399 - { "else", ELSE }, // 400 - { "sentence", SENTENCE }, // 401 - { "accept", ACCEPT }, // 402 - { "add", ADD }, // 403 - { "alter", ALTER }, // 404 - { "call", CALL }, // 405 - { "cancel", CANCEL }, // 406 - { "close", CLOSE }, // 407 - { "compute", COMPUTE }, // 408 - { "continue", CONTINUE }, // 409 - { "delete", DELETE }, // 410 - { "display", DISPLAY }, // 411 - { "divide", DIVIDE }, // 412 - { "evaluate", EVALUATE }, // 413 - { "exit", EXIT }, // 414 - { "filler", FILLER_kw }, // 415 - { "goback", GOBACK }, // 416 - { "goto", GOTO }, // 417 - { "initialize", INITIALIZE }, // 418 - { "inspect", INSPECT }, // 419 - { "merge", MERGE }, // 420 - { "move", MOVE }, // 421 - { "multiply", MULTIPLY }, // 422 - { "open", OPEN }, // 423 - { "paragraph", PARAGRAPH }, // 424 - { "read", READ }, // 425 - { "release", RELEASE }, // 426 - { "return", RETURN }, // 427 - { "rewrite", REWRITE }, // 428 - { "search", SEARCH }, // 429 - { "set", SET }, // 430 - { "select", SELECT }, // 431 - { "sort", SORT }, // 432 - { "sort-merge", SORT_MERGE }, // 433 - { "string", STRING_kw }, // 434 - { "stop", STOP }, // 435 - { "subtract", SUBTRACT }, // 436 - { "start", START }, // 437 - { "unstring", UNSTRING }, // 438 - { "write", WRITE }, // 439 - { "when", WHEN }, // 440 - { "argument-number", ARGUMENT_NUMBER }, // 441 - { "argument-value", ARGUMENT_VALUE }, // 442 - { "environment-name", ENVIRONMENT_NAME }, // 443 - { "environment-value", ENVIRONMENT_VALUE }, // 444 - { "abs", ABS }, // 445 - { "access", ACCESS }, // 446 - { "acos", ACOS }, // 447 - { "actual", ACTUAL }, // 448 - { "advancing", ADVANCING }, // 449 - { "after", AFTER }, // 450 - { "all", ALL }, // 451 - { "allocate", ALLOCATE }, // 452 - { "alphabet", ALPHABET }, // 453 - { "alphabetic", ALPHABETIC }, // 454 - { "alphabetic-lower", ALPHABETIC_LOWER }, // 455 - { "alphabetic-upper", ALPHABETIC_UPPER }, // 456 - { "alphanumeric", ALPHANUMERIC }, // 457 - { "alphanumeric-edited", ALPHANUMERIC_EDITED }, // 458 - { "also", ALSO }, // 459 - { "alternate", ALTERNATE }, // 460 - { "annuity", ANNUITY }, // 461 - { "anum", ANUM }, // 462 - { "any", ANY }, // 463 - { "anycase", ANYCASE }, // 464 - { "apply", APPLY }, // 465 - { "are", ARE }, // 466 - { "area", AREA }, // 467 - { "areas", AREAS }, // 468 - { "as", AS }, // 469 - { "ascending", ASCENDING }, // 470 - { "activating", ACTIVATING }, // 471 - { "asin", ASIN }, // 472 - { "assign", ASSIGN }, // 473 - { "at", AT }, // 474 - { "atan", ATAN }, // 475 - { "based", BASED }, // 476 - { "baseconvert", BASECONVERT }, // 477 - { "before", BEFORE }, // 478 - { "binary", BINARY }, // 479 - { "bit", BIT }, // 480 - { "bit-of", BIT_OF }, // 481 - { "bit-to-char", BIT_TO_CHAR }, // 482 - { "blank", BLANK }, // 483 - { "block", BLOCK_kw }, // 484 - { "boolean-of-integer", BOOLEAN_OF_INTEGER }, // 485 - { "bottom", BOTTOM }, // 486 - { "by", BY }, // 487 - { "byte", BYTE }, // 488 - { "byte-length", BYTE_LENGTH }, // 489 - { "cf", CF }, // 490 - { "ch", CH }, // 491 - { "changed", CHANGED }, // 492 - { "char", CHAR }, // 493 - { "char-national", CHAR_NATIONAL }, // 494 - { "character", CHARACTER }, // 495 - { "characters", CHARACTERS }, // 496 - { "checking", CHECKING }, // 497 - { "class", CLASS }, // 498 - { "cobol", COBOL }, // 499 - { "code", CODE }, // 500 - { "code-set", CODESET }, // 501 - { "collating", COLLATING }, // 502 - { "column", COLUMN }, // 503 - { "combined-datetime", COMBINED_DATETIME }, // 504 - { "comma", COMMA }, // 505 - { "command-line", COMMAND_LINE }, // 506 - { "command-line-count", COMMAND_LINE_COUNT }, // 507 - { "commit", COMMIT }, // 508 - { "common", COMMON }, // 509 - { "concat", CONCAT }, // 510 - { "condition", CONDITION }, // 511 - { "configuration", CONFIGURATION_SECT }, // 512 - { "contains", CONTAINS }, // 513 - { "content", CONTENT }, // 514 - { "control", CONTROL }, // 515 - { "controls", CONTROLS }, // 516 - { "convert", CONVERT }, // 517 - { "converting", CONVERTING }, // 518 - { "corresponding", CORRESPONDING }, // 519 - { "cos", COS }, // 520 - { "count", COUNT }, // 521 - { "currency", CURRENCY }, // 522 - { "current", CURRENT }, // 523 - { "current-date", CURRENT_DATE }, // 524 - { "data", DATA }, // 525 - { "date", DATE }, // 526 - { "date-compiled", DATE_COMPILED }, // 527 - { "date-of-integer", DATE_OF_INTEGER }, // 528 - { "date-to-yyyymmdd", DATE_TO_YYYYMMDD }, // 529 - { "date-written", DATE_WRITTEN }, // 530 - { "day", DAY }, // 531 - { "day-of-integer", DAY_OF_INTEGER }, // 532 - { "day-of-week", DAY_OF_WEEK }, // 533 - { "day-to-yyyyddd", DAY_TO_YYYYDDD }, // 534 - { "dbcs", DBCS }, // 535 - { "de", DE }, // 536 - { "debugging", DEBUGGING }, // 537 - { "decimal-point", DECIMAL_POINT }, // 538 - { "declaratives", DECLARATIVES }, // 539 - { "delimited", DELIMITED }, // 540 - { "delimiter", DELIMITER }, // 541 - { "depending", DEPENDING }, // 542 - { "descending", DESCENDING }, // 543 - { "detail", DETAIL }, // 544 - { "direct", DIRECT }, // 545 - { "direct-access", DIRECT_ACCESS }, // 546 - { "down", DOWN }, // 547 - { "duplicates", DUPLICATES }, // 548 - { "dynamic", DYNAMIC }, // 549 - { "e", E }, // 550 - { "ebcdic", EBCDIC }, // 551 - { "ec", EC }, // 552 - { "egcs", EGCS }, // 553 - { "encoding", ENCODING }, // 554 - { "entry", ENTRY }, // 555 - { "environment", ENVIRONMENT }, // 556 - { "equal", EQUAL }, // 557 + { "eq", EQ }, // 298 + { "literal", LITERAL }, // 299 + { "end", END }, // 300 + { "eop", EOP }, // 301 + { "filename", FILENAME }, // 302 + { "invalid", INVALID }, // 303 + { "number", NUMBER }, // 304 + { "negative", NEGATIVE }, // 305 + { "numstr", NUMSTR }, // 306 + { "overflow", OVERFLOW_kw }, // 307 + { "binary-integer", BINARY_INTEGER }, // 308 + { "computational", COMPUTATIONAL }, // 309 + { "perform", PERFORM }, // 310 + { "backward", BACKWARD }, // 311 + { "positive", POSITIVE }, // 312 + { "pointer", POINTER }, // 313 + { "section", SECTION }, // 314 + { "standard-alphabet", STANDARD_ALPHABET }, // 315 + { "switch", SWITCH }, // 316 + { "upsi", UPSI }, // 317 + { "zero", ZERO }, // 318 + { "zeros", ZERO }, // 318 + { "zeroes", ZERO }, // 318 + { "sysin", SYSIN }, // 319 + { "sysipt", SYSIPT }, // 320 + { "sysout", SYSOUT }, // 321 + { "syslist", SYSLIST }, // 322 + { "syslst", SYSLST }, // 323 + { "syspunch", SYSPUNCH }, // 324 + { "syspch", SYSPCH }, // 325 + { "console", CONSOLE }, // 326 + { "c01", C01 }, // 327 + { "c02", C02 }, // 328 + { "c03", C03 }, // 329 + { "c04", C04 }, // 330 + { "c05", C05 }, // 331 + { "c06", C06 }, // 332 + { "c07", C07 }, // 333 + { "c08", C08 }, // 334 + { "c09", C09 }, // 335 + { "c10", C10 }, // 336 + { "c11", C11 }, // 337 + { "c12", C12 }, // 338 + { "csp", CSP }, // 339 + { "s01", S01 }, // 340 + { "s02", S02 }, // 341 + { "s03", S03 }, // 342 + { "s04", S04 }, // 343 + { "s05", S05 }, // 344 + { "afp-5a", AFP_5A }, // 345 + { "stdin", STDIN }, // 346 + { "stdout", STDOUT }, // 347 + { "stderr", STDERR }, // 348 + { "list", LIST }, // 349 + { "map", MAP }, // 350 + { "nolist", NOLIST }, // 351 + { "nomap", NOMAP }, // 352 + { "nosource", NOSOURCE }, // 353 + { "might-be", MIGHT_BE }, // 354 + { "function-udf", FUNCTION_UDF }, // 355 + { "function-udf-0", FUNCTION_UDF_0 }, // 356 + { "default", DEFAULT }, // 357 + { "date-fmt", DATE_FMT }, // 358 + { "time-fmt", TIME_FMT }, // 359 + { "datetime-fmt", DATETIME_FMT }, // 360 + { "basis", BASIS }, // 361 + { "cbl", CBL }, // 362 + { "constant", CONSTANT }, // 363 + { "copy", COPY }, // 364 + { "defined", DEFINED }, // 365 + { "enter", ENTER }, // 366 + { "feature", FEATURE }, // 367 + { "insertt", INSERTT }, // 368 + { "lsub", LSUB }, // 369 + { "parameter", PARAMETER_kw }, // 370 + { "override", OVERRIDE }, // 371 + { "ready", READY }, // 372 + { "reset", RESET }, // 373 + { "rsub", RSUB }, // 374 + { "service-reload", SERVICE_RELOAD }, // 375 + { "star-cbl", STAR_CBL }, // 376 + { "subscript", SUBSCRIPT }, // 377 + { "suppress", SUPPRESS }, // 378 + { "title", TITLE }, // 379 + { "trace", TRACE }, // 380 + { "use", USE }, // 381 + { "cobol-words", COBOL_WORDS }, // 382 + { "equate", EQUATE }, // 383 + { "undefine", UNDEFINE }, // 384 + { "cdf-define", CDF_DEFINE }, // 385 + { "cdf-display", CDF_DISPLAY }, // 386 + { "cdf-if", CDF_IF }, // 387 + { "cdf-else", CDF_ELSE }, // 388 + { "cdf-end-if", CDF_END_IF }, // 389 + { "cdf-evaluate", CDF_EVALUATE }, // 390 + { "cdf-when", CDF_WHEN }, // 391 + { "cdf-end-evaluate", CDF_END_EVALUATE }, // 392 + { "call-convention", CALL_CONVENTION }, // 393 + { "call-cobol", CALL_COBOL }, // 394 + { "call-verbatim", CALL_VERBATIM }, // 395 + { "cdf-push", CDF_PUSH }, // 396 + { "cdf-pop", CDF_POP }, // 397 + { "source-format", SOURCE_FORMAT }, // 398 + { "if", IF }, // 399 + { "then", THEN }, // 400 + { "else", ELSE }, // 401 + { "sentence", SENTENCE }, // 402 + { "accept", ACCEPT }, // 403 + { "add", ADD }, // 404 + { "alter", ALTER }, // 405 + { "call", CALL }, // 406 + { "cancel", CANCEL }, // 407 + { "close", CLOSE }, // 408 + { "compute", COMPUTE }, // 409 + { "continue", CONTINUE }, // 410 + { "delete", DELETE }, // 411 + { "display", DISPLAY }, // 412 + { "divide", DIVIDE }, // 413 + { "evaluate", EVALUATE }, // 414 + { "exit", EXIT }, // 415 + { "filler", FILLER_kw }, // 416 + { "goback", GOBACK }, // 417 + { "goto", GOTO }, // 418 + { "initialize", INITIALIZE }, // 419 + { "inspect", INSPECT }, // 420 + { "merge", MERGE }, // 421 + { "move", MOVE }, // 422 + { "multiply", MULTIPLY }, // 423 + { "open", OPEN }, // 424 + { "paragraph", PARAGRAPH }, // 425 + { "read", READ }, // 426 + { "release", RELEASE }, // 427 + { "return", RETURN }, // 428 + { "rewrite", REWRITE }, // 429 + { "search", SEARCH }, // 430 + { "set", SET }, // 431 + { "select", SELECT }, // 432 + { "sort", SORT }, // 433 + { "sort-merge", SORT_MERGE }, // 434 + { "string", STRING_kw }, // 435 + { "stop", STOP }, // 436 + { "subtract", SUBTRACT }, // 437 + { "start", START }, // 438 + { "unstring", UNSTRING }, // 439 + { "write", WRITE }, // 440 + { "when", WHEN }, // 441 + { "argument-number", ARGUMENT_NUMBER }, // 442 + { "argument-value", ARGUMENT_VALUE }, // 443 + { "environment-name", ENVIRONMENT_NAME }, // 444 + { "environment-value", ENVIRONMENT_VALUE }, // 445 + { "abs", ABS }, // 446 + { "access", ACCESS }, // 447 + { "acos", ACOS }, // 448 + { "actual", ACTUAL }, // 449 + { "advancing", ADVANCING }, // 450 + { "after", AFTER }, // 451 + { "all", ALL }, // 452 + { "allocate", ALLOCATE }, // 453 + { "alphabet", ALPHABET }, // 454 + { "alphabetic", ALPHABETIC }, // 455 + { "alphabetic-lower", ALPHABETIC_LOWER }, // 456 + { "alphabetic-upper", ALPHABETIC_UPPER }, // 457 + { "alphanumeric", ALPHANUMERIC }, // 458 + { "alphanumeric-edited", ALPHANUMERIC_EDITED }, // 459 + { "also", ALSO }, // 460 + { "alternate", ALTERNATE }, // 461 + { "annuity", ANNUITY }, // 462 + { "anum", ANUM }, // 463 + { "any", ANY }, // 464 + { "anycase", ANYCASE }, // 465 + { "apply", APPLY }, // 466 + { "are", ARE }, // 467 + { "area", AREA }, // 468 + { "areas", AREAS }, // 469 + { "as", AS }, // 470 + { "ascending", ASCENDING }, // 471 + { "activating", ACTIVATING }, // 472 + { "asin", ASIN }, // 473 + { "assign", ASSIGN }, // 474 + { "at", AT }, // 475 + { "atan", ATAN }, // 476 + { "based", BASED }, // 477 + { "baseconvert", BASECONVERT }, // 478 + { "before", BEFORE }, // 479 + { "binary", BINARY }, // 480 + { "bit", BIT }, // 481 + { "bit-of", BIT_OF }, // 482 + { "bit-to-char", BIT_TO_CHAR }, // 483 + { "blank", BLANK }, // 484 + { "block", BLOCK_kw }, // 485 + { "boolean-of-integer", BOOLEAN_OF_INTEGER }, // 486 + { "bottom", BOTTOM }, // 487 + { "by", BY }, // 488 + { "byte", BYTE }, // 489 + { "byte-length", BYTE_LENGTH }, // 490 + { "cf", CF }, // 491 + { "ch", CH }, // 492 + { "changed", CHANGED }, // 493 + { "char", CHAR }, // 494 + { "char-national", CHAR_NATIONAL }, // 495 + { "character", CHARACTER }, // 496 + { "characters", CHARACTERS }, // 497 + { "checking", CHECKING }, // 498 + { "class", CLASS }, // 499 + { "cobol", COBOL }, // 500 + { "code", CODE }, // 501 + { "code-set", CODESET }, // 502 + { "collating", COLLATING }, // 503 + { "column", COLUMN }, // 504 + { "combined-datetime", COMBINED_DATETIME }, // 505 + { "comma", COMMA }, // 506 + { "command-line", COMMAND_LINE }, // 507 + { "command-line-count", COMMAND_LINE_COUNT }, // 508 + { "commit", COMMIT }, // 509 + { "common", COMMON }, // 510 + { "concat", CONCAT }, // 511 + { "condition", CONDITION }, // 512 + { "configuration", CONFIGURATION_SECT }, // 513 + { "contains", CONTAINS }, // 514 + { "content", CONTENT }, // 515 + { "control", CONTROL }, // 516 + { "controls", CONTROLS }, // 517 + { "convert", CONVERT }, // 518 + { "converting", CONVERTING }, // 519 + { "corresponding", CORRESPONDING }, // 520 + { "cos", COS }, // 521 + { "count", COUNT }, // 522 + { "currency", CURRENCY }, // 523 + { "current", CURRENT }, // 524 + { "current-date", CURRENT_DATE }, // 525 + { "data", DATA }, // 526 + { "date", DATE }, // 527 + { "date-compiled", DATE_COMPILED }, // 528 + { "date-of-integer", DATE_OF_INTEGER }, // 529 + { "date-to-yyyymmdd", DATE_TO_YYYYMMDD }, // 530 + { "date-written", DATE_WRITTEN }, // 531 + { "day", DAY }, // 532 + { "day-of-integer", DAY_OF_INTEGER }, // 533 + { "day-of-week", DAY_OF_WEEK }, // 534 + { "day-to-yyyyddd", DAY_TO_YYYYDDD }, // 535 + { "dbcs", DBCS }, // 536 + { "de", DE }, // 537 + { "debugging", DEBUGGING }, // 538 + { "decimal-point", DECIMAL_POINT }, // 539 + { "declaratives", DECLARATIVES }, // 540 + { "delimited", DELIMITED }, // 541 + { "delimiter", DELIMITER }, // 542 + { "depending", DEPENDING }, // 543 + { "descending", DESCENDING }, // 544 + { "detail", DETAIL }, // 545 + { "direct", DIRECT }, // 546 + { "direct-access", DIRECT_ACCESS }, // 547 + { "down", DOWN }, // 548 + { "duplicates", DUPLICATES }, // 549 + { "dynamic", DYNAMIC }, // 550 + { "e", E }, // 551 + { "ebcdic", EBCDIC }, // 552 + { "ec", EC }, // 553 + { "egcs", EGCS }, // 554 + { "encoding", ENCODING }, // 555 + { "entry", ENTRY }, // 556 + { "environment", ENVIRONMENT }, // 557 { "every", EVERY }, // 558 { "examine", EXAMINE }, // 559 { "exhibit", EXHIBIT }, // 560 @@ -750,266 +750,266 @@ token_names = { "PIC-P", // 37 (295) "ONES", // 38 (296) "SPACES", // 39 (297) - "LITERAL", // 40 (298) - "END", // 41 (299) - "EOP", // 42 (300) - "FILENAME", // 43 (301) - "INVALID", // 44 (302) - "NUMBER", // 45 (303) - "NEGATIVE", // 46 (304) - "NUMSTR", // 47 (305) - "OVERFLOW", // 48 (306) - "BINARY-INTEGER", // 49 (307) - "COMPUTATIONAL", // 50 (308) - "PERFORM", // 51 (309) - "BACKWARD", // 52 (310) - "POSITIVE", // 53 (311) - "POINTER", // 54 (312) - "SECTION", // 55 (313) - "STANDARD-ALPHABET", // 56 (314) - "SWITCH", // 57 (315) - "UPSI", // 58 (316) - "ZERO", // 59 (317) - "SYSIN", // 60 (318) - "SYSIPT", // 61 (319) - "SYSOUT", // 62 (320) - "SYSLIST", // 63 (321) - "SYSLST", // 64 (322) - "SYSPUNCH", // 65 (323) - "SYSPCH", // 66 (324) - "CONSOLE", // 67 (325) - "C01", // 68 (326) - "C02", // 69 (327) - "C03", // 70 (328) - "C04", // 71 (329) - "C05", // 72 (330) - "C06", // 73 (331) - "C07", // 74 (332) - "C08", // 75 (333) - "C09", // 76 (334) - "C10", // 77 (335) - "C11", // 78 (336) - "C12", // 79 (337) - "CSP", // 80 (338) - "S01", // 81 (339) - "S02", // 82 (340) - "S03", // 83 (341) - "S04", // 84 (342) - "S05", // 85 (343) - "AFP-5A", // 86 (344) - "STDIN", // 87 (345) - "STDOUT", // 88 (346) - "STDERR", // 89 (347) - "LIST", // 90 (348) - "MAP", // 91 (349) - "NOLIST", // 92 (350) - "NOMAP", // 93 (351) - "NOSOURCE", // 94 (352) - "MIGHT-BE", // 95 (353) - "FUNCTION-UDF", // 96 (354) - "FUNCTION-UDF-0", // 97 (355) - "DEFAULT", // 98 (356) - "DATE-FMT", // 99 (357) - "TIME-FMT", // 100 (358) - "DATETIME-FMT", // 101 (359) - "BASIS", // 102 (360) - "CBL", // 103 (361) - "CONSTANT", // 104 (362) - "COPY", // 105 (363) - "DEFINED", // 106 (364) - "ENTER", // 107 (365) - "FEATURE", // 108 (366) - "INSERTT", // 109 (367) - "LSUB", // 110 (368) - "PARAMETER", // 111 (369) - "OVERRIDE", // 112 (370) - "READY", // 113 (371) - "RESET", // 114 (372) - "RSUB", // 115 (373) - "SERVICE-RELOAD", // 116 (374) - "STAR-CBL", // 117 (375) - "SUBSCRIPT", // 118 (376) - "SUPPRESS", // 119 (377) - "TITLE", // 120 (378) - "TRACE", // 121 (379) - "USE", // 122 (380) - "COBOL-WORDS", // 123 (381) - "EQUATE", // 124 (382) - "UNDEFINE", // 125 (383) - "CDF-DEFINE", // 126 (384) - "CDF-DISPLAY", // 127 (385) - "CDF-IF", // 128 (386) - "CDF-ELSE", // 129 (387) - "CDF-END-IF", // 130 (388) - "CDF-EVALUATE", // 131 (389) - "CDF-WHEN", // 132 (390) - "CDF-END-EVALUATE", // 133 (391) - "CALL-CONVENTION", // 134 (392) - "CALL-COBOL", // 135 (393) - "CALL-VERBATIM", // 136 (394) - "CDF-PUSH", // 137 (395) - "CDF-POP", // 138 (396) - "SOURCE-FORMAT", // 139 (397) - "IF", // 140 (398) - "THEN", // 141 (399) - "ELSE", // 142 (400) - "SENTENCE", // 143 (401) - "ACCEPT", // 144 (402) - "ADD", // 145 (403) - "ALTER", // 146 (404) - "CALL", // 147 (405) - "CANCEL", // 148 (406) - "CLOSE", // 149 (407) - "COMPUTE", // 150 (408) - "CONTINUE", // 151 (409) - "DELETE", // 152 (410) - "DISPLAY", // 153 (411) - "DIVIDE", // 154 (412) - "EVALUATE", // 155 (413) - "EXIT", // 156 (414) - "FILLER", // 157 (415) - "GOBACK", // 158 (416) - "GOTO", // 159 (417) - "INITIALIZE", // 160 (418) - "INSPECT", // 161 (419) - "MERGE", // 162 (420) - "MOVE", // 163 (421) - "MULTIPLY", // 164 (422) - "OPEN", // 165 (423) - "PARAGRAPH", // 166 (424) - "READ", // 167 (425) - "RELEASE", // 168 (426) - "RETURN", // 169 (427) - "REWRITE", // 170 (428) - "SEARCH", // 171 (429) - "SET", // 172 (430) - "SELECT", // 173 (431) - "SORT", // 174 (432) - "SORT-MERGE", // 175 (433) - "STRING", // 176 (434) - "STOP", // 177 (435) - "SUBTRACT", // 178 (436) - "START", // 179 (437) - "UNSTRING", // 180 (438) - "WRITE", // 181 (439) - "WHEN", // 182 (440) - "ARGUMENT-NUMBER", // 183 (441) - "ARGUMENT-VALUE", // 184 (442) - "ENVIRONMENT-NAME", // 185 (443) - "ENVIRONMENT-VALUE", // 186 (444) - "ABS", // 187 (445) - "ACCESS", // 188 (446) - "ACOS", // 189 (447) - "ACTUAL", // 190 (448) - "ADVANCING", // 191 (449) - "AFTER", // 192 (450) - "ALL", // 193 (451) - "ALLOCATE", // 194 (452) - "ALPHABET", // 195 (453) - "ALPHABETIC", // 196 (454) - "ALPHABETIC-LOWER", // 197 (455) - "ALPHABETIC-UPPER", // 198 (456) - "ALPHANUMERIC", // 199 (457) - "ALPHANUMERIC-EDITED", // 200 (458) - "ALSO", // 201 (459) - "ALTERNATE", // 202 (460) - "ANNUITY", // 203 (461) - "ANUM", // 204 (462) - "ANY", // 205 (463) - "ANYCASE", // 206 (464) - "APPLY", // 207 (465) - "ARE", // 208 (466) - "AREA", // 209 (467) - "AREAS", // 210 (468) - "AS", // 211 (469) - "ASCENDING", // 212 (470) - "ACTIVATING", // 213 (471) - "ASIN", // 214 (472) - "ASSIGN", // 215 (473) - "AT", // 216 (474) - "ATAN", // 217 (475) - "BASED", // 218 (476) - "BASECONVERT", // 219 (477) - "BEFORE", // 220 (478) - "BINARY", // 221 (479) - "BIT", // 222 (480) - "BIT-OF", // 223 (481) - "BIT-TO-CHAR", // 224 (482) - "BLANK", // 225 (483) - "BLOCK", // 226 (484) - "BOOLEAN-OF-INTEGER", // 227 (485) - "BOTTOM", // 228 (486) - "BY", // 229 (487) - "BYTE", // 230 (488) - "BYTE-LENGTH", // 231 (489) - "CF", // 232 (490) - "CH", // 233 (491) - "CHANGED", // 234 (492) - "CHAR", // 235 (493) - "CHAR-NATIONAL", // 236 (494) - "CHARACTER", // 237 (495) - "CHARACTERS", // 238 (496) - "CHECKING", // 239 (497) - "CLASS", // 240 (498) - "COBOL", // 241 (499) - "CODE", // 242 (500) - "CODE-SET", // 243 (501) - "COLLATING", // 244 (502) - "COLUMN", // 245 (503) - "COMBINED-DATETIME", // 246 (504) - "COMMA", // 247 (505) - "COMMAND-LINE", // 248 (506) - "COMMAND-LINE-COUNT", // 249 (507) - "COMMIT", // 250 (508) - "COMMON", // 251 (509) - "CONCAT", // 252 (510) - "CONDITION", // 253 (511) - "CONFIGURATION", // 254 (512) - "CONTAINS", // 255 (513) - "CONTENT", // 256 (514) - "CONTROL", // 257 (515) - "CONTROLS", // 258 (516) - "CONVERT", // 259 (517) - "CONVERTING", // 260 (518) - "CORRESPONDING", // 261 (519) - "COS", // 262 (520) - "COUNT", // 263 (521) - "CURRENCY", // 264 (522) - "CURRENT", // 265 (523) - "CURRENT-DATE", // 266 (524) - "DATA", // 267 (525) - "DATE", // 268 (526) - "DATE-COMPILED", // 269 (527) - "DATE-OF-INTEGER", // 270 (528) - "DATE-TO-YYYYMMDD", // 271 (529) - "DATE-WRITTEN", // 272 (530) - "DAY", // 273 (531) - "DAY-OF-INTEGER", // 274 (532) - "DAY-OF-WEEK", // 275 (533) - "DAY-TO-YYYYDDD", // 276 (534) - "DBCS", // 277 (535) - "DE", // 278 (536) - "DEBUGGING", // 279 (537) - "DECIMAL-POINT", // 280 (538) - "DECLARATIVES", // 281 (539) - "DELIMITED", // 282 (540) - "DELIMITER", // 283 (541) - "DEPENDING", // 284 (542) - "DESCENDING", // 285 (543) - "DETAIL", // 286 (544) - "DIRECT", // 287 (545) - "DIRECT-ACCESS", // 288 (546) - "DOWN", // 289 (547) - "DUPLICATES", // 290 (548) - "DYNAMIC", // 291 (549) - "E", // 292 (550) - "EBCDIC", // 293 (551) - "EC", // 294 (552) - "EGCS", // 295 (553) - "ENCODING", // 296 (554) - "ENTRY", // 297 (555) - "ENVIRONMENT", // 298 (556) - "EQUAL", // 299 (557) + "EQ", // 40 (298) + "LITERAL", // 41 (299) + "END", // 42 (300) + "EOP", // 43 (301) + "FILENAME", // 44 (302) + "INVALID", // 45 (303) + "NUMBER", // 46 (304) + "NEGATIVE", // 47 (305) + "NUMSTR", // 48 (306) + "OVERFLOW", // 49 (307) + "BINARY-INTEGER", // 50 (308) + "COMPUTATIONAL", // 51 (309) + "PERFORM", // 52 (310) + "BACKWARD", // 53 (311) + "POSITIVE", // 54 (312) + "POINTER", // 55 (313) + "SECTION", // 56 (314) + "STANDARD-ALPHABET", // 57 (315) + "SWITCH", // 58 (316) + "UPSI", // 59 (317) + "ZERO", // 60 (318) + "SYSIN", // 61 (319) + "SYSIPT", // 62 (320) + "SYSOUT", // 63 (321) + "SYSLIST", // 64 (322) + "SYSLST", // 65 (323) + "SYSPUNCH", // 66 (324) + "SYSPCH", // 67 (325) + "CONSOLE", // 68 (326) + "C01", // 69 (327) + "C02", // 70 (328) + "C03", // 71 (329) + "C04", // 72 (330) + "C05", // 73 (331) + "C06", // 74 (332) + "C07", // 75 (333) + "C08", // 76 (334) + "C09", // 77 (335) + "C10", // 78 (336) + "C11", // 79 (337) + "C12", // 80 (338) + "CSP", // 81 (339) + "S01", // 82 (340) + "S02", // 83 (341) + "S03", // 84 (342) + "S04", // 85 (343) + "S05", // 86 (344) + "AFP-5A", // 87 (345) + "STDIN", // 88 (346) + "STDOUT", // 89 (347) + "STDERR", // 90 (348) + "LIST", // 91 (349) + "MAP", // 92 (350) + "NOLIST", // 93 (351) + "NOMAP", // 94 (352) + "NOSOURCE", // 95 (353) + "MIGHT-BE", // 96 (354) + "FUNCTION-UDF", // 97 (355) + "FUNCTION-UDF-0", // 98 (356) + "DEFAULT", // 99 (357) + "DATE-FMT", // 100 (358) + "TIME-FMT", // 101 (359) + "DATETIME-FMT", // 102 (360) + "BASIS", // 103 (361) + "CBL", // 104 (362) + "CONSTANT", // 105 (363) + "COPY", // 106 (364) + "DEFINED", // 107 (365) + "ENTER", // 108 (366) + "FEATURE", // 109 (367) + "INSERTT", // 110 (368) + "LSUB", // 111 (369) + "PARAMETER", // 112 (370) + "OVERRIDE", // 113 (371) + "READY", // 114 (372) + "RESET", // 115 (373) + "RSUB", // 116 (374) + "SERVICE-RELOAD", // 117 (375) + "STAR-CBL", // 118 (376) + "SUBSCRIPT", // 119 (377) + "SUPPRESS", // 120 (378) + "TITLE", // 121 (379) + "TRACE", // 122 (380) + "USE", // 123 (381) + "COBOL-WORDS", // 124 (382) + "EQUATE", // 125 (383) + "UNDEFINE", // 126 (384) + "CDF-DEFINE", // 127 (385) + "CDF-DISPLAY", // 128 (386) + "CDF-IF", // 129 (387) + "CDF-ELSE", // 130 (388) + "CDF-END-IF", // 131 (389) + "CDF-EVALUATE", // 132 (390) + "CDF-WHEN", // 133 (391) + "CDF-END-EVALUATE", // 134 (392) + "CALL-CONVENTION", // 135 (393) + "CALL-COBOL", // 136 (394) + "CALL-VERBATIM", // 137 (395) + "CDF-PUSH", // 138 (396) + "CDF-POP", // 139 (397) + "SOURCE-FORMAT", // 140 (398) + "IF", // 141 (399) + "THEN", // 142 (400) + "ELSE", // 143 (401) + "SENTENCE", // 144 (402) + "ACCEPT", // 145 (403) + "ADD", // 146 (404) + "ALTER", // 147 (405) + "CALL", // 148 (406) + "CANCEL", // 149 (407) + "CLOSE", // 150 (408) + "COMPUTE", // 151 (409) + "CONTINUE", // 152 (410) + "DELETE", // 153 (411) + "DISPLAY", // 154 (412) + "DIVIDE", // 155 (413) + "EVALUATE", // 156 (414) + "EXIT", // 157 (415) + "FILLER", // 158 (416) + "GOBACK", // 159 (417) + "GOTO", // 160 (418) + "INITIALIZE", // 161 (419) + "INSPECT", // 162 (420) + "MERGE", // 163 (421) + "MOVE", // 164 (422) + "MULTIPLY", // 165 (423) + "OPEN", // 166 (424) + "PARAGRAPH", // 167 (425) + "READ", // 168 (426) + "RELEASE", // 169 (427) + "RETURN", // 170 (428) + "REWRITE", // 171 (429) + "SEARCH", // 172 (430) + "SET", // 173 (431) + "SELECT", // 174 (432) + "SORT", // 175 (433) + "SORT-MERGE", // 176 (434) + "STRING", // 177 (435) + "STOP", // 178 (436) + "SUBTRACT", // 179 (437) + "START", // 180 (438) + "UNSTRING", // 181 (439) + "WRITE", // 182 (440) + "WHEN", // 183 (441) + "ARGUMENT-NUMBER", // 184 (442) + "ARGUMENT-VALUE", // 185 (443) + "ENVIRONMENT-NAME", // 186 (444) + "ENVIRONMENT-VALUE", // 187 (445) + "ABS", // 188 (446) + "ACCESS", // 189 (447) + "ACOS", // 190 (448) + "ACTUAL", // 191 (449) + "ADVANCING", // 192 (450) + "AFTER", // 193 (451) + "ALL", // 194 (452) + "ALLOCATE", // 195 (453) + "ALPHABET", // 196 (454) + "ALPHABETIC", // 197 (455) + "ALPHABETIC-LOWER", // 198 (456) + "ALPHABETIC-UPPER", // 199 (457) + "ALPHANUMERIC", // 200 (458) + "ALPHANUMERIC-EDITED", // 201 (459) + "ALSO", // 202 (460) + "ALTERNATE", // 203 (461) + "ANNUITY", // 204 (462) + "ANUM", // 205 (463) + "ANY", // 206 (464) + "ANYCASE", // 207 (465) + "APPLY", // 208 (466) + "ARE", // 209 (467) + "AREA", // 210 (468) + "AREAS", // 211 (469) + "AS", // 212 (470) + "ASCENDING", // 213 (471) + "ACTIVATING", // 214 (472) + "ASIN", // 215 (473) + "ASSIGN", // 216 (474) + "AT", // 217 (475) + "ATAN", // 218 (476) + "BASED", // 219 (477) + "BASECONVERT", // 220 (478) + "BEFORE", // 221 (479) + "BINARY", // 222 (480) + "BIT", // 223 (481) + "BIT-OF", // 224 (482) + "BIT-TO-CHAR", // 225 (483) + "BLANK", // 226 (484) + "BLOCK", // 227 (485) + "BOOLEAN-OF-INTEGER", // 228 (486) + "BOTTOM", // 229 (487) + "BY", // 230 (488) + "BYTE", // 231 (489) + "BYTE-LENGTH", // 232 (490) + "CF", // 233 (491) + "CH", // 234 (492) + "CHANGED", // 235 (493) + "CHAR", // 236 (494) + "CHAR-NATIONAL", // 237 (495) + "CHARACTER", // 238 (496) + "CHARACTERS", // 239 (497) + "CHECKING", // 240 (498) + "CLASS", // 241 (499) + "COBOL", // 242 (500) + "CODE", // 243 (501) + "CODE-SET", // 244 (502) + "COLLATING", // 245 (503) + "COLUMN", // 246 (504) + "COMBINED-DATETIME", // 247 (505) + "COMMA", // 248 (506) + "COMMAND-LINE", // 249 (507) + "COMMAND-LINE-COUNT", // 250 (508) + "COMMIT", // 251 (509) + "COMMON", // 252 (510) + "CONCAT", // 253 (511) + "CONDITION", // 254 (512) + "CONFIGURATION", // 255 (513) + "CONTAINS", // 256 (514) + "CONTENT", // 257 (515) + "CONTROL", // 258 (516) + "CONTROLS", // 259 (517) + "CONVERT", // 260 (518) + "CONVERTING", // 261 (519) + "CORRESPONDING", // 262 (520) + "COS", // 263 (521) + "COUNT", // 264 (522) + "CURRENCY", // 265 (523) + "CURRENT", // 266 (524) + "CURRENT-DATE", // 267 (525) + "DATA", // 268 (526) + "DATE", // 269 (527) + "DATE-COMPILED", // 270 (528) + "DATE-OF-INTEGER", // 271 (529) + "DATE-TO-YYYYMMDD", // 272 (530) + "DATE-WRITTEN", // 273 (531) + "DAY", // 274 (532) + "DAY-OF-INTEGER", // 275 (533) + "DAY-OF-WEEK", // 276 (534) + "DAY-TO-YYYYDDD", // 277 (535) + "DBCS", // 278 (536) + "DE", // 279 (537) + "DEBUGGING", // 280 (538) + "DECIMAL-POINT", // 281 (539) + "DECLARATIVES", // 282 (540) + "DELIMITED", // 283 (541) + "DELIMITER", // 284 (542) + "DEPENDING", // 285 (543) + "DESCENDING", // 286 (544) + "DETAIL", // 287 (545) + "DIRECT", // 288 (546) + "DIRECT-ACCESS", // 289 (547) + "DOWN", // 290 (548) + "DUPLICATES", // 291 (549) + "DYNAMIC", // 292 (550) + "E", // 293 (551) + "EBCDIC", // 294 (552) + "EC", // 295 (553) + "EGCS", // 296 (554) + "ENCODING", // 297 (555) + "ENTRY", // 298 (556) + "ENVIRONMENT", // 299 (557) "EVERY", // 300 (558) "EXAMINE", // 301 (559) "EXHIBIT", // 302 (560) diff --git a/gcc/cobol/util.cc b/gcc/cobol/util.cc index 0724595403b..32add9f9954 100644 --- a/gcc/cobol/util.cc +++ b/gcc/cobol/util.cc @@ -100,7 +100,7 @@ get_current_dir_name () unsigned long gb4( size_t input ) { if( input != static_cast(input) ) { - yywarn("size too large to print: %lx:%lx", + dbgmsg("size too large to print: %lx:%lx", (unsigned long)(input >> (4 * sizeof(unsigned long))), static_cast(input)); } @@ -2147,6 +2147,9 @@ static location_t token_location_minus_1 = 0; static location_t token_location = 0; location_t current_token_location() { return token_location; } +location_t current_token_location(const location_t& loc) { + return token_location = loc; +} location_t current_location_minus_one() { return token_location_minus_1; } void current_location_minus_one_clear() { @@ -2360,18 +2363,6 @@ yyerror( const char gmsgid[], ... ) { global_dc->end_group(); } -bool -yywarn( const char gmsgid[], ... ) { - verify_format(gmsgid); - auto_diagnostic_group d; - va_list ap; - va_start (ap, gmsgid); - auto ret = emit_diagnostic_valist( diagnostics::kind::warning, token_location, - option_zero, gmsgid, &ap ); - va_end (ap); - return ret; -} - /* * Sometimes during parsing an error is noticed late. This message refers back * to an arbitrary file and line number. @@ -2430,9 +2421,11 @@ cobol_fileline_set( const char line[] ) { *filename = xstrndup(line + pmatch[2].rm_so, matched_length(pmatch[2])); int fileline; - if( 1 != sscanf(line_str, "%d", &fileline) ) - yywarn("could not parse line number %s from %<#line%> directive", line_str); - + if( 1 != sscanf(line_str, "%d", &fileline) ) { + cbl_message(LexLineE, + "could not parse line number %s from %<#line%> directive", + line_str); + } input_file_t input_file( filename, ino_t(0), fileline ); // constructor sets inode if( input_filenames.empty() ) { @@ -2525,11 +2518,11 @@ cobol_parse_files (int nfile, const char **files) { const char * opaque = setlocale(LC_CTYPE, ""); if( ! opaque ) { - yywarn("setlocale: unable to initialize LOCALE"); + cbl_message(ParLocaleW, "setlocale: unable to initialize LOCALE"); } else { char *codeset = nl_langinfo(CODESET); if( ! codeset ) { - yywarn("% failed after % succeeded"); + cbl_message(ParLangInfoW, "% failed after % succeeded"); } else { os_locale.codeset = codeset; } @@ -2541,20 +2534,6 @@ cobol_parse_files (int nfile, const char **files) } } -/* Outputs the formatted string onto the file descriptor */ - -void -cbl_message(int fd, const char *format_string, ...) - { - va_list ap; - va_start(ap, format_string); - char *ostring = xvasprintf(format_string, ap); - va_end(ap); - write(fd, ostring, strlen(ostring)); - write(fd, "\n", 1); - free(ostring); - } - /* Uses the GCC internal_error () to output the formatted string. Processing ends with a stack trace */ @@ -2571,15 +2550,30 @@ cbl_internal_error(const char *gmsgid, ...) { // // doesn't cause a warning. } +diagnostics::kind cbl_diagnostic_kind( cbl_diag_id_t id ); +const char * cbl_diagnostic_option( cbl_diag_id_t id ); + void -cbl_unimplementedw(const char *gmsgid, ...) { +cbl_unimplementedw(cbl_diag_id_t id, const char *gmsgid, ...) { verify_format(gmsgid); auto_diagnostic_group d; + const char *option; + char *msg = nullptr; + + diagnostics::kind kind = cbl_diagnostic_kind(id); + if( kind == diagnostics::kind::ignored ) return; + + if( (option = cbl_diagnostic_option(id)) != nullptr ) { + msg = xasprintf("%s [%s]", gmsgid, option); + gmsgid = msg; + } + va_list ap; + va_start(ap, gmsgid); - emit_diagnostic_valist( diagnostics::kind::warning, - token_location, option_zero, gmsgid, &ap ); + emit_diagnostic_valist( kind, token_location, option_zero, gmsgid, &ap ); va_end(ap); + free(msg); } void @@ -2635,6 +2629,13 @@ cbl_errx(const char *gmsgid, ...) { va_end(ap); } +/* + * For a function that uses host *printf, %zu or %td or %wu are not ok, sadly. + * not all supported host arches support those. So, for *printf family one + * needs to use macros like HOST_WIDE_INT_PRINT_DEC (for HOST_WIDE_INT + * argument), or HOST_SIZE_T_PRINT_UNSIGNED (for size_t, with casts to + * (fmt_size_t)). + */ void dbgmsg(const char *msg, ...) { if( yy_flex_debug || yydebug ) { @@ -2647,12 +2648,6 @@ dbgmsg(const char *msg, ...) { } } -void -dialect_error( const YYLTYPE& loc, const char term[], const char dialect[] ) { - error_msg(loc, "%s is not ISO syntax, requires %<-dialect %s%>", - term, dialect); -} - bool fisdigit(int c) { return ISDIGIT(c); diff --git a/gcc/cobol/util.h b/gcc/cobol/util.h index d478ea22731..d457e3ee41b 100644 --- a/gcc/cobol/util.h +++ b/gcc/cobol/util.h @@ -31,8 +31,6 @@ #ifndef _UTIL_H_ #define _UTIL_H_ -void cbl_message(int fd, const char *format_string, ...) - ATTRIBUTE_PRINTF_2; [[noreturn]] void cbl_internal_error(const char *format_string, ...) ATTRIBUTE_GCOBOL_DIAG(1, 2);