diff options
Diffstat (limited to 'gcc')
117 files changed, 4787 insertions, 1554 deletions
diff --git a/gcc/ChangeLog b/gcc/ChangeLog index 0fdeab3..dd930d6 100644 --- a/gcc/ChangeLog +++ b/gcc/ChangeLog @@ -1,3 +1,92 @@ +2025-10-23 Andrew Pinski <andrew.pinski@oss.qualcomm.com> + + * match.pd (`(type1)x CMP CST1 ? (type2)x : CST2`): Better handling + of `((signed)x) < 0`. + +2025-10-23 Andrew Pinski <andrew.pinski@oss.qualcomm.com> + + PR tree-optimization/101024 + * tree-ssa-phiopt.cc (match_simplify_replacement): Special + case fp `a CMP b ? a : b` when not creating a min/max. + (strip_bit_not): Remove. + (invert_minmax_code): Remove. + (minmax_replacement): Remove. + (pass_phiopt::execute): Update pass comment. + Don't call minmax_replacement. + +2025-10-23 Andrew Pinski <andrew.pinski@oss.qualcomm.com> + + PR tree-optimization/101024 + * fold-const.cc (minmax_from_comparison): New version that takes widest_int + instead of tree. + (minmax_from_comparison): Call minmax_from_comparison for integer cst case. + * fold-const.h (minmax_from_comparison): New declaration. + * match.pd (`((signed)a </>= 0) ? min/max (a, c) : b`): New pattern. + +2025-10-23 Alfie Richards <alfie.richards@arm.com> + + * config/aarch64/aarch64-c.cc (aarch64_update_cpp_builtins): Add + __HAVE_FUNCTION_MULTI_VERSIONING macro. + +2025-10-23 Alfie Richards <alfie.richards@arm.com> + + * config/aarch64/aarch64.cc (dispatch_function_versions): Remove + unnecessary sorting and data structure. + +2025-10-23 Alfie Richards <alfie.richards@arm.com> + + PR target/122190 + * config/aarch64/aarch64.cc (compare_feature_masks): Fix version rules. + +2025-10-23 Alfie Richards <alfie.richards@arm.com> + + * config/aarch64/aarch64.cc (aarch64_generate_version_dispatcher_body): + Dump function versions and the ordering. + +2025-10-23 zhaozhou <zhaozhou@loongson.cn> + + * match.pd: Add new pattern for round. + +2025-10-23 Richard Biener <rguenther@suse.de> + + * tree-vectorizer.h (_loop_vec_info::slp_unrolling_factor): Remove. + (LOOP_VINFO_SLP_UNROLLING_FACTOR): Likewise. + * tree-vect-loop.cc (_loop_vec_info::_loop_vec_info): Adjust. + (vect_analyze_loop_2): Likewise. + * tree-vect-slp.cc (vect_make_slp_decision): Set + LOOP_VINFO_VECT_FACTOR directly. + +2025-10-23 Richard Biener <rguenther@suse.de> + + * tree-vect-loop.cc (vect_analyze_loop_2): Move vect_optimize_slp + after applying suggested_unroll_factor. + +2025-10-23 Richard Biener <rguenther@suse.de> + + * tree-vect-loop.cc (vect_analyze_loop_2): Deal with NULL + element in SLP_TREE_SCALAR_STMTS. + +2025-10-23 liuhongt <hongtao.liu@intel.com> + + PR target/101639 + * config/i386/sse.md + (VI_AVX): New mode iterator. + (VI_AVX_CMP): Ditto. + (ssebytemode): Add V16HI, V32QI, V16QI. + (reduc_sbool_and_scal_<mode>): New expander. + (reduc_sbool_ior_scal_<mode>): Ditto. + (reduc_sbool_xor_scal_<mode>): Ditto. + (*eq<mode>3_2_negate): New pre_reload splitter. + (*ptest<mode>_ccz): Ditto. + +2025-10-23 liuhongt <hongtao.liu@intel.com> + + PR target/101639 + * config/i386/sse.md + (reduc_sbool_and_scal_<mode>): New expander. + (reduc_sbool_ior_scal_<mode>): Ditto. + (reduc_sbool_xor_scal_<mode>): Ditto. + 2025-10-22 H.J. Lu <hjl.tools@gmail.com> * config/i386/i386-expand.cc (ix86_expand_set_or_cpymem): Use diff --git a/gcc/DATESTAMP b/gcc/DATESTAMP index b8ebc41..a234d9f 100644 --- a/gcc/DATESTAMP +++ b/gcc/DATESTAMP @@ -1 +1 @@ -20251023 +20251024 diff --git a/gcc/ada/gcc-interface/Makefile.in b/gcc/ada/gcc-interface/Makefile.in index d456ac1..964a4d1 100644 --- a/gcc/ada/gcc-interface/Makefile.in +++ b/gcc/ada/gcc-interface/Makefile.in @@ -905,7 +905,6 @@ adadecode.o : adadecode.c adadecode.h aux-io.o : aux-io.c argv.o : argv.c cal.o : cal.c -deftarg.o : deftarg.c errno.o : errno.c exit.o : adaint.h exit.c expect.o : expect.c @@ -938,10 +937,6 @@ init.o : init.c adaint.h raise.h $(CC) -c $(ALL_CFLAGS) $(ADA_CFLAGS) \ $(ALL_CPPFLAGS) $(INCLUDES) $< $(OUTPUT_OPTION) -init-vxsim.o : init-vxsim.c - $(CC) -c $(ALL_CFLAGS) $(ADA_CFLAGS) \ - $(ALL_CPPFLAGS) $(INCLUDES) $< $(OUTPUT_OPTION) - initialize.o : initialize.c raise.h $(CC) -c $(ALL_CFLAGS) $(ADA_CFLAGS) \ $(ALL_CPPFLAGS) $(INCLUDES) $< $(OUTPUT_OPTION) diff --git a/gcc/ada/gnatlink.adb b/gcc/ada/gnatlink.adb index 527aa7f..406147b 100644 --- a/gcc/ada/gnatlink.adb +++ b/gcc/ada/gnatlink.adb @@ -266,6 +266,9 @@ procedure Gnatlink is function Index (S, Pattern : String) return Natural; -- Return the last occurrence of Pattern in S, or 0 if none + function Is_Prefix (S, Prefix : String) return Boolean; + -- Return whether Prefix is a strict prefix of S + procedure Search_Library_Path (Next_Line : String; Nfirst : Integer; @@ -395,6 +398,16 @@ procedure Gnatlink is return 0; end Index; + --------------- + -- Is_Prefix -- + --------------- + + function Is_Prefix (S, Prefix : String) return Boolean is + begin + return Prefix'Length < S'Length + and then S (S'First .. S'First + Prefix'Length - 1) = Prefix; + end Is_Prefix; + ------------------ -- Process_Args -- ------------------ @@ -1292,13 +1305,8 @@ procedure Gnatlink is else for J in reverse 1 .. Linker_Options.Last loop if Linker_Options.Table (J) /= null - and then - Linker_Options.Table (J)'Length - > Run_Path_Opt'Length - and then - Linker_Options.Table (J) - (1 .. Run_Path_Opt'Length) = - Run_Path_Opt + and then Is_Prefix + (Linker_Options.Table (J).all, Run_Path_Opt) then -- We have found an already specified -- run_path_option: we will add to this switch, @@ -1887,31 +1895,12 @@ begin Shared_Libgcc_Seen : Boolean := False; Static_Libgcc_Seen : Boolean := False; - function Is_Prefix - (Complete_String : String; Prefix : String) return Boolean; - -- Returns whether Prefix is a prefix of Complete_String - - --------------- - -- Is_Prefix -- - --------------- - - function Is_Prefix - (Complete_String : String; Prefix : String) return Boolean - is - S : String renames Complete_String; - P : String renames Prefix; - begin - return P'Length <= S'Length - and then S (S'First .. S'First + P'Length - 1) = P; - end Is_Prefix; - begin J := Linker_Options.First; while J <= Linker_Options.Last loop if Linker_Options.Table (J).all = "-Xlinker" and then J < Linker_Options.Last - and then Linker_Options.Table (J + 1)'Length > 8 - and then Linker_Options.Table (J + 1) (1 .. 8) = "--stack=" + and then Is_Prefix (Linker_Options.Table (J + 1).all, "--stack=") then if Stack_Op then Linker_Options.Table (J .. Linker_Options.Last - 2) := @@ -1956,12 +1945,8 @@ begin -- Here we just check for a canonical form that matches the -- pragma Linker_Options set in the NT runtime. - if Is_Prefix - (Complete_String => Linker_Options.Table (J).all, - Prefix => "-Xlinker --stack=") - or else Is_Prefix - (Complete_String => Linker_Options.Table (J).all, - Prefix => "-Wl,--stack=") + if Is_Prefix (Linker_Options.Table (J).all, "-Xlinker --stack=") + or else Is_Prefix (Linker_Options.Table (J).all, "-Wl,--stack=") then if Stack_Op then Linker_Options.Table (J .. Linker_Options.Last - 1) := diff --git a/gcc/ada/rtinit.c b/gcc/ada/rtinit.c index 6a13552..598550c 100644 --- a/gcc/ada/rtinit.c +++ b/gcc/ada/rtinit.c @@ -419,6 +419,7 @@ __gnat_runtime_initialize (int install_handler) int last; int argc_expanded = 0; TCHAR result [MAX_PATH]; + int arglen; int quoted; __gnat_get_argw (GetCommandLineW (), &wargv, &wargc); @@ -436,7 +437,10 @@ __gnat_runtime_initialize (int install_handler) for (k=1; k<wargc; k++) { - quoted = (wargv[k][0] == _T('\'')); + arglen = _tcslen (wargv[k]); + quoted = wargv[k][0] == _T('\'') + && arglen > 1 + && wargv[k][arglen - 1] == _T('\''); /* Check for wildcard expansion if the argument is not quoted. */ if (!quoted && __gnat_do_argv_expansion diff --git a/gcc/ada/s-oscons-tmplt.c b/gcc/ada/s-oscons-tmplt.c index 6b21905..8391f1f 100644 --- a/gcc/ada/s-oscons-tmplt.c +++ b/gcc/ada/s-oscons-tmplt.c @@ -1882,6 +1882,7 @@ CND(IF_NAMESIZE, "Max size of interface name with 0 terminator"); #endif #elif defined(_WIN32) +#undef POLLPRI #define POLLPRI 0 /* If the POLLPRI flag is set on a socket for the Microsoft Winsock provider, * the WSAPoll function will fail. */ diff --git a/gcc/ada/styleg.adb b/gcc/ada/styleg.adb index 20945fb..46499ff 100644 --- a/gcc/ada/styleg.adb +++ b/gcc/ada/styleg.adb @@ -330,7 +330,7 @@ package body Styleg is -- Do we need to worry about UTF_32 line terminators here ??? S := Scan_Ptr + 3; - while Source (S) not in Line_Terminator loop + while Source (S) not in EOF | Line_Terminator loop S := S + 1; end loop; diff --git a/gcc/ada/terminals.c b/gcc/ada/terminals.c index 89f8875..85a5c0d 100644 --- a/gcc/ada/terminals.c +++ b/gcc/ada/terminals.c @@ -724,13 +724,16 @@ __gnat_setup_child_communication if (bRet == FALSE) { cpid = -1; } - - dwRet = buf[0] | (buf[1] << 8) | (buf[2] << 16) | (buf[3] << 24); - if (dwRet != 0) { - cpid = -1; + else { + dwRet = buf[0] | (buf[1] << 8) | (buf[2] << 16) | (buf[3] << 24); + if (dwRet != 0) { + cpid = -1; + } + else { + cpid = buf[4] | (buf[5] << 8) | (buf[6] << 16) | (buf[7] << 24); + } } - cpid = buf[4] | (buf[5] << 8) | (buf[6] << 16) | (buf[7] << 24); process->pid = cpid; } diff --git a/gcc/attr-callback.cc b/gcc/attr-callback.cc index 83d2754..ee39ef6 100644 --- a/gcc/attr-callback.cc +++ b/gcc/attr-callback.cc @@ -48,7 +48,7 @@ callback_build_attr (unsigned fn_idx, unsigned arg_count...) { int num = va_arg (args, int); tree tnum = build_int_cst (integer_type_node, num); - *pp = build_tree_list (NULL, tnum PASS_MEM_STAT); + *pp = build_tree_list (NULL, tnum); pp = &TREE_CHAIN (*pp); } cblist diff --git a/gcc/c/c-parser.cc b/gcc/c/c-parser.cc index 56fb0be..0cf3f92 100644 --- a/gcc/c/c-parser.cc +++ b/gcc/c/c-parser.cc @@ -675,14 +675,15 @@ c_token_starts_typename (c_token *token) } } -/* Return true if the next token from PARSER can start a type name, - false otherwise. LA specifies how to do lookahead in order to +/* Return true if the next token from PARSER, starting from token N, can start + a type name, false otherwise. LA specifies how to do lookahead in order to detect unknown type names. If unsure, pick CLA_PREFER_ID. */ static inline bool -c_parser_next_tokens_start_typename (c_parser *parser, enum c_lookahead_kind la) +c_parser_next_tokens_start_typename (c_parser *parser, enum c_lookahead_kind la, + unsigned int n = 1) { - c_token *token = c_parser_peek_token (parser); + c_token *token = c_parser_peek_nth_token (parser, n); if (c_token_starts_typename (token)) return true; @@ -695,8 +696,8 @@ c_parser_next_tokens_start_typename (c_parser *parser, enum c_lookahead_kind la) && !parser->objc_could_be_foreach_context && (la == cla_prefer_type - || c_parser_peek_2nd_token (parser)->type == CPP_NAME - || c_parser_peek_2nd_token (parser)->type == CPP_MULT) + || c_parser_peek_nth_token (parser, n + 1)->type == CPP_NAME + || c_parser_peek_nth_token (parser, n + 1)->type == CPP_MULT) /* Only unknown identifiers. */ && !lookup_name (token->value)) @@ -892,30 +893,47 @@ c_parser_next_token_starts_declspecs (c_parser *parser) return c_token_starts_declspecs (token); } -/* Return true if the next tokens from PARSER can start declaration - specifiers (not including standard attributes) or a static - assertion, false otherwise. */ +static bool c_parser_check_balanced_raw_token_sequence (c_parser *, + unsigned int *); + +/* Return true if the next tokens from PARSER (starting with token N, 1-based) + can start declaration specifiers (not including standard attributes) or a + static assertion, false otherwise. */ bool -c_parser_next_tokens_start_declaration (c_parser *parser) +c_parser_next_tokens_start_declaration (c_parser *parser, unsigned int n) { - c_token *token = c_parser_peek_token (parser); + c_token *token = c_parser_peek_nth_token (parser, n); /* Same as above. */ if (c_dialect_objc () && token->type == CPP_NAME && token->id_kind == C_ID_CLASSNAME - && c_parser_peek_2nd_token (parser)->type == CPP_DOT) + && c_parser_peek_nth_token (parser, n + 1)->type == CPP_DOT) return false; /* Labels do not start declarations. */ if (token->type == CPP_NAME - && c_parser_peek_2nd_token (parser)->type == CPP_COLON) + && c_parser_peek_nth_token (parser, n + 1)->type == CPP_COLON) return false; + /* A static assertion is only a declaration if followed by a semicolon; + otherwise, it may be an expression in C2Y. */ + if (token->keyword == RID_STATIC_ASSERT + && c_parser_peek_nth_token (parser, n + 1)->type == CPP_OPEN_PAREN) + { + n += 2; + if (!c_parser_check_balanced_raw_token_sequence (parser, &n) + || c_parser_peek_nth_token_raw (parser, n)->type != CPP_CLOSE_PAREN) + /* Invalid static assertion syntax; treat as a declaration and report a + syntax error there. */ + return true; + return c_parser_peek_nth_token_raw (parser, n + 1)->type == CPP_SEMICOLON; + } + if (c_token_starts_declaration (token)) return true; - if (c_parser_next_tokens_start_typename (parser, cla_nonabstract_decl)) + if (c_parser_next_tokens_start_typename (parser, cla_nonabstract_decl, n)) return true; return false; @@ -5855,9 +5873,6 @@ c_parser_balanced_token_sequence (c_parser *parser) } } -static bool c_parser_check_balanced_raw_token_sequence (c_parser *, - unsigned int *); - /* Parse arguments of omp::directive or omp::decl attribute. directive-name ,[opt] clause-list[opt] @@ -7724,7 +7739,7 @@ c_parser_compound_statement_nostart (c_parser *parser) == RID_EXTENSION)) c_parser_consume_token (parser); if (!have_std_attrs - && (c_token_starts_declaration (c_parser_peek_2nd_token (parser)) + && (c_parser_next_tokens_start_declaration (parser, 2) || c_parser_nth_token_starts_std_attributes (parser, 2))) { int ext; @@ -9132,7 +9147,7 @@ c_parser_for_statement (c_parser *parser, bool ivdep, unsigned short unroll, && (c_parser_peek_2nd_token (parser)->keyword == RID_EXTENSION)) c_parser_consume_token (parser); - if (c_token_starts_declaration (c_parser_peek_2nd_token (parser)) + if (c_parser_next_tokens_start_declaration (parser, 2) || c_parser_nth_token_starts_std_attributes (parser, 2)) { int ext; @@ -10513,8 +10528,9 @@ c_parser_cast_expression (c_parser *parser, struct c_expr *after) _Countof ( type-name ) sizeof unary-expression sizeof ( type-name ) + static-assert-declaration-no-semi - (_Countof is new in C2y.) + (_Countof and the use of static assertions in expressions are new in C2y.) unary-operator: one of & * + - ~ ! @@ -10679,6 +10695,15 @@ c_parser_unary_expression (c_parser *parser) case RID_TRANSACTION_RELAXED: return c_parser_transaction_expression (parser, c_parser_peek_token (parser)->keyword); + case RID_STATIC_ASSERT: + c_parser_static_assert_declaration_no_semi (parser); + pedwarn_c23 (op_loc, OPT_Wpedantic, + "ISO C does not support static assertions in " + "expressions before C2Y"); + ret.value = void_node; + set_c_expr_source_range (&ret, op_loc, op_loc); + ret.m_decimal = 0; + return ret; default: return c_parser_postfix_expression (parser); } diff --git a/gcc/c/c-parser.h b/gcc/c/c-parser.h index a84779b..46713d7 100644 --- a/gcc/c/c-parser.h +++ b/gcc/c/c-parser.h @@ -156,7 +156,8 @@ extern void c_parser_skip_until_found (c_parser *parser, enum cpp_ttype type, const char *msgid, location_t = UNKNOWN_LOCATION); extern bool c_parser_next_token_starts_declspecs (c_parser *parser); -bool c_parser_next_tokens_start_declaration (c_parser *parser); +bool c_parser_next_tokens_start_declaration (c_parser *parser, + unsigned int n = 1); bool c_token_starts_typename (c_token *token); /* Abstraction to avoid defining c_parser here which messes up gengtype diff --git a/gcc/cobol/ChangeLog b/gcc/cobol/ChangeLog index 8a0a3db..e1595a0 100644 --- a/gcc/cobol/ChangeLog +++ b/gcc/cobol/ChangeLog @@ -1,3 +1,78 @@ +2025-10-23 Robert Dubner <rdubner@symas.com> + + * genapi.cc (parser_alphabet): Alphabet encoding. + (parser_alphabet_use): Likewise. + (parser_xml_parse): Use correct debugging macro; encoding. + (parser_xml_on_exception): Likewise. + (parser_xml_not_exception): Likewise. + (parser_xml_end): Likewise. + (initialize_the_data): Encoding. + (parser_label_label): Debugging macros. + (parser_label_goto): Likewise. + (parser_file_add): Encoding. + (parser_intrinsic_call_1): Special handling for __gg__char. + (parser_intrinsic_call_2): Formatting. + * parse.y: Response from FUNCTION ORD is flagged "unsigned". + * symbols.cc (cbl_alphabet_t::reencode): Establish + low_char & high_char. + * symbols.h (struct cbl_alphabet_t): Likewise. + +2025-10-23 Robert Dubner <rdubner@symas.com> + James K. Lowden <jklowden@cobolworx.com> + + * Make-lang.in: Incorporate new token_names.h file. + * cdf.y: Modify tokens. + * gcobol.1: Document XML PARSE statement + * genapi.cc (parser_enter_program): Verify that every goto has a + matching label. + (parser_end_program): Likewise. + (parser_alphabet): Refine handling codeset encodings. + (parser_alphabet_use): Likewise. + (label_fetch): Moved from later in the source code. + (parser_xml_parse): New routine for XML PARSE. + (parser_xml_on_exception): Likewise. + (parser_xml_not_exception): Likewise. + (parser_xml_end): Likewise. + (parser_label_label): Verify goto/label matching. + (parser_label_goto): Likewise. + (parser_entry): Minor change to SHOW_PARSE report. + * genapi.h (parser_alphabet): Set parameter to const. + (parser_xml_parse): Declare new function. + (parser_xml_on_exception): Likewise. + (parser_xml_not_exception): Likewise. + (parser_xml_end): Likewise. + (parser_label_addr): Likewise. + * parse.y: label_pair_t structure; locale processing; new token + processing for alphabets and XML PARSE. + * parse_ante.h (name_of): Return field->name when initial is NULL. + (new_tempnumeric): Make signable_e optional. + (ast_save_locale): New function. + (data_division_ready): Warning for "no alphabet". + * scan.l: Repair interpretation of BINARY, COMP, COMP-4, and + COMP-5. + * scan_ante.h (struct bint_t): Likewise. + * scan_post.h (current_tokens_t::tokenset_t::tokenset_t): + Include token_names.h. + * symbols.cc (symbols_alphabet_set): Revert to prior alphabet + determination. + (symbol_table_init): New XML special registers. + (new_temporary): Make signable_e controllable, not fixed. + * symbols.h (__gg__encoding_iconv_valid): New declaration. + (enum cbl_label_type_t): New LblXml label type. + (struct cbl_xml_parse_t): + (struct cbl_label_t): Implement XML PARSE. + (new_temporary): Incorporate boolean for signable_e. + (symbol_elem_of): Change label field type handling. + (cbl_section_of): Likewise. + (cbl_field_of): Likewise. + (cbl_label_of): Likewise. + (cbl_special_name_of): Likewise. + (cbl_alphabet_of): Likewise. + (cbl_file_of): Likewise. + * token_names.h: New file. + * util.cc (gcc_location_set_impl): Improve location_t calculations + when entering and leaving COPYBOOKs. + 2025-10-19 Robert Dubner <rdubner@symas.com> * genapi.cc (move_tree): Formatting. diff --git a/gcc/cobol/Make-lang.in b/gcc/cobol/Make-lang.in index 0e2a773..1f9995f 100644 --- a/gcc/cobol/Make-lang.in +++ b/gcc/cobol/Make-lang.in @@ -225,6 +225,7 @@ cobol/scan.o: cobol/scan.cc \ $(srcdir)/cobol/scan_post.h \ $(srcdir)/cobol/symbols.h \ $(srcdir)/cobol/util.h \ + $(srcdir)/cobol/token_names.h \ $(srcdir)/hwint.h \ $(srcdir)/system.h \ $(srcdir)/../include/ansidecl.h \ @@ -241,6 +242,15 @@ cobol/scan.o: cobol/scan.cc \ cobol/cdf.cc \ cobol/parse.cc +# Update token names if the generator script is installed +# (by a developer) and there's been a change. +$(srcdir)/cobol/token_names.h: cobol/parse.cc + if [ -f $@.gen ]; then \ + $@.gen $(subst .cc,.h,$^) \ + | diff -u $@ - \ + | patch -t --set-time $@ ; \ + fi + # # The src<foo> targets are executed if # ‘--enable-generated-files-in-srcdir’ was specified as a configure diff --git a/gcc/cobol/cdf.y b/gcc/cobol/cdf.y index f01c8f6..f72ed77 100644 --- a/gcc/cobol/cdf.y +++ b/gcc/cobol/cdf.y @@ -244,21 +244,21 @@ apply_cdf_turn( const exception_turn_t& turn ) { %type <boolean> DEFINED %token OTHER 699 PARAMETER_kw 369 "PARAMETER" %token OFF 688 OVERRIDE 370 -%token THRU 952 -%token TRUE_kw 815 "True" +%token THRU 949 +%token TRUE_kw 814 "True" %token CALL_COBOL 393 "CALL" %token CALL_VERBATIM 394 "CALL (as C)" -%token TURN 817 CHECKING 497 LOCATION 650 ON 690 WITH 844 +%token TURN 816 CHECKING 497 LOCATION 650 ON 690 WITH 843 -%left OR 953 -%left AND 954 -%right NOT 955 -%left '<' '>' '=' NE 956 LE 957 GE 958 +%left OR 950 +%left AND 951 +%right NOT 952 +%left '<' '>' '=' NE 953 LE 954 GE 955 %left '-' '+' %left '*' '/' -%right NEG 960 +%right NEG 957 %define api.prefix {ydf} %define api.token.prefix{YDF_} diff --git a/gcc/cobol/gcobol.1 b/gcc/cobol/gcobol.1 index 9ea9bfd..0de86df 100644 --- a/gcc/cobol/gcobol.1 +++ b/gcc/cobol/gcobol.1 @@ -778,6 +778,30 @@ resolution of .Ar filename is deferred until runtime, when the name must appear in the program's environment. +.Ss XML PARSE +.Nm +emulates the IBM +.Sy "XML PARSE" +statement. The following values for +.Sy XML-EVENT +are defined: +.Bl -tag -compact +.It Sy COMMENT +Text of a comment between "<!--" and "-->" +.It Sy CONTENT-CHARACTERS +Some or all of the character content of the element between start and end tags. +.It Sy END-OF-ELEMENT +End-element tag, with name if present in the input. +.It Sy PROCESSING-INSTRUCTION-DATA +Processing instruction (after the target name), excluding "?>". +.It Sy PROCESSING-INSTRUCTION-TARGET +The processing instruction target name appears in +.Sy XML-TEXT +or +.Sy XML-NTEXT . +.It Sy START-OF-ELEMENT +Name of the start element tag or empty element tag. +.El . .Sh ISO \*[lang] Implementation Status .Ss USAGE Data Types @@ -1480,6 +1504,18 @@ error. This feature is meant to help diagnose mysterious copybook errors. .El . +.Ss Variables for Developers +.Bl -tag -compact +.It Ev GCOBOL_SHOW +produces a trace of the internal calls made by the parser to prepare +the GENERIC tree. +.It Ev GCOBOL_TRACE +used at compile time, produces an executable that traces the +execution, mapping it back the same code-creation functions as +.Ev GCOBOL_SHOW , +as well as the values of data items and branch conditions. +.El +. .Sh FILES Executables produced by .Nm diff --git a/gcc/cobol/genapi.cc b/gcc/cobol/genapi.cc index 6fc4770..9d30dde 100644 --- a/gcc/cobol/genapi.cc +++ b/gcc/cobol/genapi.cc @@ -3988,6 +3988,37 @@ parser_enter_program( const char *funcname_, free(funcname); } +static class label_verify_t { + std::set<size_t> lain, dangling; + static inline size_t index_of( const cbl_label_t *label ) { + return symbol_index(symbol_elem_of(label)); + } +public: + void go_to( const cbl_label_t *label ) { + auto p = lain.find(index_of(label)); + if( p == lain.end() ) { + dangling.insert(index_of(label)); + } + } + bool 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(); + } + void dump() const { + fprintf(stderr, "%u nonexistent labels called\n", unsigned(dangling.size()) ); + for( auto sym : dangling ) { + const cbl_label_t *label = cbl_label_of(symbol_at(sym)); + fprintf(stderr, "\t %s\n", label->name); + } + } +} label_verify; + void parser_end_program(const char *prog_name ) { @@ -4014,6 +4045,13 @@ parser_end_program(const char *prog_name ) TRACE1_END } + if( ! label_verify.vet() ) + { + label_verify.dump(); + gcc_unreachable(); + } + + if( gg_trans_unit.function_stack.size() ) { // The body has been created by various parser calls. It's time @@ -5035,7 +5073,7 @@ parser_accept_date_hhmmssff( struct cbl_field_t *target ) */ void -parser_alphabet( cbl_alphabet_t& alphabet ) +parser_alphabet( const cbl_alphabet_t& alphabet ) { Analyze(); SHOW_PARSE @@ -5046,6 +5084,9 @@ parser_alphabet( cbl_alphabet_t& alphabet ) free(psz); switch(alphabet.encoding) { + case iconv_CP1252_e: + psz = xasprintf("CP1252"); + break; case ASCII_e: psz = xasprintf("ASCII"); break; @@ -5074,6 +5115,7 @@ parser_alphabet( cbl_alphabet_t& alphabet ) switch(alphabet.encoding) { + case iconv_CP1252_e: case ASCII_e: case iso646_e: case EBCDIC_e: @@ -5082,6 +5124,7 @@ parser_alphabet( cbl_alphabet_t& alphabet ) case custom_encoding_e: { +#pragma message "Use program-id to disambiguate" size_t alphabet_index = symbol_index(symbol_elem_of(&alphabet)); unsigned char ach[256]; @@ -5097,23 +5140,28 @@ parser_alphabet( cbl_alphabet_t& alphabet ) gg_assign( gg_array_value(table256, ch), build_int_cst_type(UCHAR, (alphabet.alphabet[i])) ); } + + unsigned int low_char = alphabet.low_char; + unsigned int high_char = alphabet.high_char; __gg__alphabet_create(alphabet.encoding, alphabet_index, ach, - alphabet.low_index, - alphabet.high_index); + low_char, + high_char); gg_call(VOID, "__gg__alphabet_create", build_int_cst_type(INT, alphabet.encoding), build_int_cst_type(SIZE_T, alphabet_index), gg_get_address_of(table256), - build_int_cst_type(INT, alphabet.low_index), - build_int_cst_type(INT, alphabet.high_index), - + build_int_cst_type(INT, low_char), + build_int_cst_type(INT, high_char), NULL_TREE ); break; } default: + fprintf(stderr, "%s: Program ID %s:\n", + cobol_filename(), + cbl_label_of(symbol_at(current_program_index()))->name); gcc_unreachable(); } } @@ -5130,6 +5178,9 @@ parser_alphabet_use( cbl_alphabet_t& alphabet ) free(psz); switch(alphabet.encoding) { + case iconv_CP1252_e: + psz = xasprintf("CP1252"); + break; case ASCII_e: psz = xasprintf("ASCII"); break; @@ -5159,6 +5210,7 @@ parser_alphabet_use( cbl_alphabet_t& alphabet ) { default: gcc_unreachable(); + case iconv_CP1252_e: case ASCII_e: case iso646_e: case EBCDIC_e: @@ -5167,7 +5219,8 @@ parser_alphabet_use( cbl_alphabet_t& alphabet ) __gg__high_value_character = DEGENERATE_HIGH_VALUE; gg_call(VOID, "__gg__alphabet_use", - build_int_cst_type(INT, current_encoding(encoding_display_e)), + build_int_cst_type(INT, current_encoding(display_encoding_e)), + build_int_cst_type(INT, current_encoding(national_encoding_e)), build_int_cst_type(INT, alphabet.encoding), null_pointer_node, NULL_TREE); @@ -5183,7 +5236,8 @@ parser_alphabet_use( cbl_alphabet_t& alphabet ) gg_call(VOID, "__gg__alphabet_use", - build_int_cst_type(INT, current_encoding(encoding_display_e)), + build_int_cst_type(INT, current_encoding(display_encoding_e)), + build_int_cst_type(INT, current_encoding(national_encoding_e)), build_int_cst_type(INT, alphabet.encoding), build_int_cst_type(SIZE_T, alphabet_index), NULL_TREE); @@ -6802,6 +6856,160 @@ parser_free( size_t n, cbl_refer_t refers[] ) } } +static +cbl_label_addresses_t * +label_fetch(struct cbl_label_t *label) + { + if( !label->structs.goto_trees ) + { + label->structs.goto_trees + = static_cast<cbl_label_addresses_t *> + (xmalloc(sizeof(struct cbl_label_addresses_t))); + gcc_assert(label->structs.goto_trees); + + gg_create_goto_pair(&label->structs.goto_trees->go_to, + &label->structs.goto_trees->label); + } + return label->structs.goto_trees; + } + +void +parser_xml_parse( cbl_label_t *instance, + cbl_refer_t input, + cbl_field_t *encoding, + cbl_field_t *validating, + bool returns_national, + cbl_label_t *from_proc, + cbl_label_t *to_proc ) + { + SHOW_PARSE + { + SHOW_PARSE_HEADER + SHOW_PARSE_LABEL_OK("", instance) + SHOW_PARSE_REF(" ", input) + SHOW_PARSE_END + } + + TRACE1 + { + TRACE1_HEADER + TRACE1_END + } + + // We know that this routine comes first in the sequence, so we can + // create the goto/label pairs here: + + instance->structs.xml_parse = static_cast<struct cbl_xml_parse_t *> + (xmalloc(sizeof(struct cbl_xml_parse_t))); + gcc_assert(instance->structs.xml_parse); + + gg_create_goto_pair(&instance->structs.xml_parse->over.go_to, + &instance->structs.xml_parse->over.label); + gg_create_goto_pair(&instance->structs.xml_parse->exception.go_to, + &instance->structs.xml_parse->exception.label); + gg_create_goto_pair(&instance->structs.xml_parse->no_exception.go_to, + &instance->structs.xml_parse->no_exception.label); + + // We need to create a COBOL ENTRY point into this function. That entry + // point will be used by __gg__xml_parse to perform from_proc through to_proc + // as part of processing the libxml2 callbacks. + + char ach[64]; + static int instance_counter = 1; + sprintf(ach, + "_%s_xml_callback_%d", + current_function->our_name, + instance_counter++); + + cbl_field_t for_entry = {}; + for_entry.type = FldAlphanumeric; + for_entry.data.capacity = strlen(ach); + for_entry.data.initial = ach; + for_entry.codeset.encoding = iconv_CP1252_e; + + // build an island for the callback: + tree island_goto; + tree island_label; + gg_create_goto_pair(&island_goto, + &island_label); + + gg_append_statement(island_goto); + // This creates the separate _xml_callback function + parser_entry(&for_entry, 0, nullptr); + // When invoked, the callback performs the processing procedures + parser_perform(from_proc, to_proc); + // And then returns back to the caller + gg_return(0); + gg_append_statement(island_label); + + // With the callback in place, we are ready to call the library: + tree pcallback = gg_get_function_address(VOID, ach); + + tree erc = gg_define_int(); + gg_assign(erc, gg_call_expr(INT, + "__gg__xml_parse", + gg_get_address_of(input.field->var_decl_node), + refer_offset(input), + refer_size_source(input), + encoding ? + gg_get_address_of(encoding->var_decl_node) + : null_pointer_node, + validating ? + gg_get_address_of(validating->var_decl_node) + : null_pointer_node, + build_int_cst_type(INT, returns_national), + pcallback, + NULL_TREE)); + IF( erc, ne_op, integer_zero_node ) + { + //gg_printf("__gg__xml_parse() failed with erc %d\n", erc, NULL_TREE); + gg_append_statement(instance->structs.xml_parse->exception.go_to); + } + ELSE + { + //gg_printf("__gg__xml_parse() apparently succeeded\n", NULL_TREE); + gg_append_statement(instance->structs.xml_parse->no_exception.go_to); + } + ENDIF + } + +void +parser_xml_on_exception( cbl_label_t *instance ) + { + SHOW_PARSE + { + SHOW_PARSE_HEADER + SHOW_PARSE_LABEL_OK(" ", instance) + SHOW_PARSE_END + } + gg_append_statement(instance->structs.xml_parse->over.go_to); + gg_append_statement(instance->structs.xml_parse->exception.label); + } + +void +parser_xml_not_exception( cbl_label_t *instance ) +{ + SHOW_PARSE + { + SHOW_PARSE_HEADER + SHOW_PARSE_LABEL_OK(" ", instance) + SHOW_PARSE_END + } + gg_append_statement(instance->structs.xml_parse->over.go_to); + gg_append_statement(instance->structs.xml_parse->no_exception.label); + } + +void parser_xml_end( cbl_label_t *instance ) + { + SHOW_PARSE + { + SHOW_PARSE_HEADER + SHOW_PARSE_LABEL_OK(" ", instance) + SHOW_PARSE_END + } + gg_append_statement(instance->structs.xml_parse->over.label); + } + void parser_arith_error(cbl_label_t *arithmetic_label) { @@ -6933,7 +7141,8 @@ initialize_the_data() // This is one-time initialization of the libgcobol program state stack gg_call(VOID, "__gg__init_program_state", - build_int_cst_type(INT, current_encoding(encoding_display_e)), + build_int_cst_type(INT, current_encoding(display_encoding_e)), + build_int_cst_type(INT, current_encoding(national_encoding_e)), NULL_TREE); __gg__currency_signs = __gg__ct_currency_signs; @@ -7962,23 +8171,6 @@ parser_see_stop_run(struct cbl_refer_t exit_status, gg_exit(returned_value); } -static -cbl_label_addresses_t * -label_fetch(struct cbl_label_t *label) - { - if( !label->structs.goto_trees ) - { - label->structs.goto_trees - = static_cast<cbl_label_addresses_t *> - (xmalloc(sizeof(struct cbl_label_addresses_t))); - gcc_assert(label->structs.goto_trees); - - gg_create_goto_pair(&label->structs.goto_trees->go_to, - &label->structs.goto_trees->label); - } - return label->structs.goto_trees; - } - void parser_label_label(struct cbl_label_t *label) { @@ -8009,6 +8201,18 @@ 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 ) { @@ -8048,6 +8252,10 @@ parser_label_goto(struct cbl_label_t *label) } CHECK_LABEL(label); + + label_verify.go_to(label); + + label_verify.go_to(label); if( strcmp(label->name, "_end_declaratives") == 0 ) { @@ -9682,6 +9890,7 @@ parser_file_add(struct cbl_file_t *file) __func__); } +#pragma message "Use program-id to disambiguate" size_t symbol_table_index = symbol_index(symbol_elem_of(file)); gg_call(VOID, @@ -9708,7 +9917,7 @@ parser_file_add(struct cbl_file_t *file) /* Right now, file->codeset.encoding is not being set properly. Remove this comment and fix the following code when that's repaired. */ // build_int_cst_type(INT, (int)file->codeset.encoding), - build_int_cst_type(INT, current_encoding(encoding_display_e)), + build_int_cst_type(INT, current_encoding(display_encoding_e)), build_int_cst_type(INT, (int)file->codeset.alphabet), NULL_TREE); file->var_decl_node = new_var_decl; @@ -11138,6 +11347,16 @@ parser_intrinsic_call_1( cbl_field_t *tgt, } } } + else if( strcmp(function_name, "__gg__char") == 0 ) + { + gg_call(VOID, + function_name, + gg_get_address_of(tgt->var_decl_node), + gg_get_address_of(ref1.field->var_decl_node), + refer_offset(ref1), + refer_size_source(ref1), + NULL_TREE); + } else { TRACE1 @@ -11192,13 +11411,15 @@ parser_intrinsic_call_2( cbl_field_t *tgt, TRACE1_REFER("parameter 2: ", ref2, "") } store_location_stuff(function_name); + gg_call(VOID, function_name, gg_get_address_of(tgt->var_decl_node), gg_get_address_of(ref1.field->var_decl_node), refer_offset(ref1), refer_size_source(ref1), - ref2.field ? gg_get_address_of(ref2.field->var_decl_node) : null_pointer_node, + ref2.field ? gg_get_address_of(ref2.field->var_decl_node) + : null_pointer_node, refer_offset(ref2), refer_size_source(ref2), NULL_TREE); @@ -13525,7 +13746,8 @@ parser_entry( const cbl_field_t *name, size_t nusing, cbl_ffi_arg_t *args ) SHOW_PARSE { SHOW_PARSE_HEADER - SHOW_PARSE_FIELD( " ENTRY ", name) + SHOW_PARSE_TEXT(" ") + SHOW_PARSE_TEXT(name->data.initial) SHOW_PARSE_END } diff --git a/gcc/cobol/genapi.h b/gcc/cobol/genapi.h index 1aafc65..6582d2e 100644 --- a/gcc/cobol/genapi.h +++ b/gcc/cobol/genapi.h @@ -81,7 +81,7 @@ void parser_accept_date_dow( cbl_field_t *tgt ); void parser_accept_date_hhmmssff( cbl_field_t *tgt ); void -parser_alphabet( cbl_alphabet_t& alphabet ); +parser_alphabet( const cbl_alphabet_t& alphabet ); void parser_alphabet_use( cbl_alphabet_t& alphabet ); @@ -90,6 +90,18 @@ parser_allocate( cbl_refer_t size_or_based, cbl_refer_t returning, bool initiali void parser_free( size_t n, cbl_refer_t refers[] ); +void parser_xml_parse( cbl_label_t *stmt, + cbl_refer_t input, + cbl_field_t *encoding, + cbl_field_t *validating, + bool returns_national, + cbl_label_t *from_proc, + cbl_label_t *to_proc ); + +void parser_xml_on_exception( cbl_label_t *name ); +void parser_xml_not_exception( cbl_label_t *name ); +void parser_xml_end( cbl_label_t *name ); + void parser_add( size_t nC, cbl_num_result_t *C, size_t nA, cbl_refer_t *A, @@ -322,6 +334,9 @@ parser_label_label( struct cbl_label_t *label ); void parser_label_goto( struct cbl_label_t *label ); +callback_t * +parser_label_addr( struct cbl_label_t *label ); + void parser_goto( cbl_refer_t value, size_t narg, cbl_label_t * const labels[] ); diff --git a/gcc/cobol/parse.y b/gcc/cobol/parse.y index c497b8f..9187a59 100644 --- a/gcc/cobol/parse.y +++ b/gcc/cobol/parse.y @@ -55,6 +55,41 @@ const char *alpha, *national; }; + struct label_pair_t { + cbl_label_t *from, *to; + }; + +class locale_tgt_t { + char user_system_default; + std::vector<int> categories; + public: + locale_tgt_t() : user_system_default('\0') {} + locale_tgt_t( int category ) + : user_system_default('\0') + , categories(1, category) + {} + locale_tgt_t operator=( int ch ) { + assert(categories.empty()); + switch(ch) { + case 'S': case 'U': + user_system_default = ch; + return *this; + } + gcc_unreachable(); + } + locale_tgt_t push_back( int token ) { + categories.push_back(token); + return *this; + } + + bool is_default() const { return 0 < user_system_default; } + char default_of() const { + assert(categories.empty()); + return user_system_default; + } + const std::vector<int>& lc_categories() const { return categories; } +}; + class literal_t { size_t isym; public: @@ -65,9 +100,7 @@ bool empty() const { return data == NULL; } size_t isymbol() const { return isym; } - const char * symbol_name() const { - return isym? cbl_field_of(symbol_at(isym))->name : ""; - } + const char * symbol_name() const; literal_t& set( size_t len, char *data, const char prefix[] ) { @@ -76,17 +109,8 @@ return *this; } - literal_t& - set( const cbl_field_t * field ) { - assert(field->has_attr(constant_e)); - assert(is_literal(field)); - - set_prefix( "", 0 ); - set_data( field->data.capacity, - const_cast<char*>(field->data.initial), - field_index(field) ); - return *this; - } + literal_t& set( const cbl_field_t * field ); + literal_t& set_data( size_t len, char *data, size_t isym = 0 ) { this->isym = isym; @@ -99,36 +123,8 @@ } return *this; } - literal_t& - set_prefix( const char *input, size_t len ) { - encoding = current_encoding('A'); - assert(len < sizeof(prefix)); - std::fill(prefix, prefix + sizeof(prefix), '\0'); - std::transform(input, input + len, prefix, toupper); - switch(prefix[0]) { - case '\0': case 'Z': - encoding = current_encoding('A'); - break; - case 'N': - encoding = current_encoding('N'); - if( 'X' == prefix[1] ) { - cbl_unimplemented("NX literals"); - } - break; - case 'G': - cbl_unimplemented("DBCS encoding not supported"); - break; - case 'U': - encoding = UTF8_e; - break; - case 'X': - break; - default: - gcc_unreachable(); - } - assert(encoding <= iconv_YU_e); - return *this; - } + literal_t& set_prefix( const char *input, size_t len ); + bool compatible_prefix( const literal_t& that ) const { if( prefix[0] != that.prefix[0] ) { @@ -456,7 +452,7 @@ CF CH CHANGED CHAR CHAR_NATIONAL "CHAR-NATIONAL" CHARACTER CHARACTERS CHECKING CLASS - COBOL CODE CODESET COLLATING + COBOL CODE CODESET "CODE-SET" COLLATING COLUMN COMBINED_DATETIME "COMBINED-DATETIME" COMMA COMMAND_LINE "COMMAND-LINE" COMMAND_LINE_COUNT "COMMAND-LINE-COUNT" @@ -524,7 +520,7 @@ INTEGER_OF_DAY "INTEGER-OF-DAY" INTEGER_OF_FORMATTED_DATE "INTEGER-OF-FORMATTED-DATE" INTEGER_PART "INTEGER-PART" - INTO INTRINSIC INVOKE IO IO_CONTROL "IO-CONTROL" + INTO INTRINSIC INVOKE IO "I-O" IO_CONTROL "I-O-CONTROL" IS ISNT "IS NOT" KANJI KEY @@ -600,7 +596,7 @@ STATUS STRONG SUBSTITUTE SUM SYMBOL SYMBOLIC SYNCHRONIZED - TALLY TALLYING TAN TERMINATE TEST + TALLYING TAN TERMINATE TEST TEST_DATE_YYYYMMDD "TEST-DATE-YYYYMMDD" TEST_DAY_YYYYDDD "TEST-DAY-YYYYDDD" TEST_FORMATTED_DATETIME "TEST-FORMATTED-DATETIME" @@ -663,6 +659,8 @@ UNDERLINE UNSIGNED_kw UTF_16 "UTF-16" UTF_8 "UTF-8" + XMLGENERATE "XML GENERATE" + XMLPARSE "XML PARSE" ADDRESS END_ACCEPT "END-ACCEPT" @@ -814,6 +812,7 @@ %type <error> on_overflow on_overflows %type <error> arith_err arith_errs %type <error> accept_except accept_excepts call_except call_excepts + %type <compute_body_t> compute_body %type <refer> ffi_name set_operand set_tgt scalar_arg unstring_src @@ -837,6 +836,12 @@ %type <number> mistake globally first_last %type <io_mode> io_mode +%type <label_pair> xmlprocs +%type <error> xmlexcept xmlexcepts +%type <field> xmlencoding xmlvalidating +%type <number> xmlreturning +%type <label> xmlparse_body + %type <labels> labels %type <label> label_1 section_name @@ -868,6 +873,8 @@ %type <opt_init_sects> opt_init_sects %type <opt_init_sect> opt_init_sect %type <number> opt_init_value +%type <number> locale_current loc_category user_default +%type <token_list> loc_categories locale_tgt %type <opt_round> rounded round_between rounded_type rounded_mode %type <opt_arith> opt_arith_type %type <module_type> module_type @@ -944,7 +951,9 @@ struct { cbl_refer_t *input, *delimiter; } delimited_1; struct { cbl_refer_t *from, *len; } refmod_parts; struct refer_collection_t *delimiteds; + struct { cbl_label_t *on_error, *not_error; } error; + label_pair_t label_pair; struct { unsigned int nclause; bool tf; } error_clauses; struct refer_pair_t { cbl_refer_t *first, *second; } refer2; struct { refer_collection_t *inputs; refer_pair_t into; } str_body; @@ -977,6 +986,7 @@ substitution_t substitution; substitutions_t *substitutions; struct { bool is_locale; cbl_refer_t *arg2; } numval_locale_t; + locale_tgt_t *token_list; cbl_options_t::arith_t opt_arith; cbl_round_t opt_round; @@ -1064,8 +1074,7 @@ SEARCH SET SELECT SORT SORT_MERGE STRING_kw STOP SUBTRACT START UNSTRING WRITE WHEN INVALID - XMLGENERATE "XML GENERATE" - XMLPARSE "XML PARSE" + XMLGENERATE XMLPARSE %left ABS ACCESS ACOS ACTUAL ADVANCING AFP_5A AFTER ALL ALLOCATE @@ -1241,7 +1250,7 @@ LITERAL SUBSTITUTE SUM SWITCH SYMBOL SYMBOLIC SYNCHRONIZED SYSIN SYSIPT SYSLST SYSOUT SYSPCH SYSPUNCH - TALLY TALLYING TAN TERMINATE TEST + TALLYING TAN TERMINATE TEST TEST_DATE_YYYYMMDD TEST_DAY_YYYYDDD TEST_FORMATTED_DATETIME @@ -1589,8 +1598,8 @@ function_id: FUNCTION NAME program_as program_attrs[attr] '.' if( !current.new_program(@NAME, LblFunction, $NAME, $program_as.data, $attr.common, $attr.initial) ) { - auto L = symbol_program(current_program_index(), $NAME); - assert(L); + auto e = symbol_function(current_program_index(), $NAME); + auto L = cbl_label_of(e); error_msg(@NAME, "FUNCTION %s already defined on line %d", $NAME, L->line); YYERROR; @@ -2734,9 +2743,18 @@ device_name: SYSIN { $$.token = SYSIN; $$.id = SYSIN_e; } /* ENVIRONMENT_VALUE { $$.token=0; $$.id = ENV_VALUE_e; } */ ; -alphabet_name: STANDARD_ALPHABET { $$ = alphabet_add(@1, ASCII_e); } +alphabet_name: STANDARD_ALPHABET { $$ = alphabet_add(@1, CP1252_e); } | NATIVE { $$ = alphabet_add(@1, EBCDIC_e); } | EBCDIC { $$ = alphabet_add(@1, EBCDIC_e); } + | LOCALE ctx_name + { + auto e = symbol_alphabet(PROGRAM, $ctx_name); + if( !e ) { + error_msg(@ctx_name, "no such ALPHABET %qs", $ctx_name); + YYERROR; + } + $$ = cbl_alphabet_of(e); + } | alphabet_seqs { $1->reencode(); @@ -4208,16 +4226,17 @@ picture_clause: PIC signed nps[fore] nines nps[aft] { cbl_field_t *field = current_field(); field->data.digits = $left + $rdigits; + field->attr |= $signed; if( field->is_binary_integer() ) { field->data.capacity = type_capacity(field->type, field->data.digits); + field->data.rdigits = $rdigits; } else { if( !field_type_update(field, FldNumericDisplay, @$) ) { YYERROR; } ERROR_IF_CAPACITY(@PIC, field); - field->attr |= $signed; field->data.capacity = field->data.digits; field->data.rdigits = $rdigits; } @@ -4487,8 +4506,8 @@ usage_clause1: usage BIT field->clear_attr(signable_e); } else { error_msg(@comp, "numeric USAGE invalid " - "with Alpnanumeric PICTURE"); - dialect_error(@1, "Alpnanumeric COMP-5 or COMP-X", "mf or gnu"); + "with Alphanumeric PICTURE"); + dialect_error(@1, "Alphanumeric COMP-5 or COMP-X", "mf or gnu"); YYERROR; } break; @@ -4568,8 +4587,8 @@ usage_clause1: usage BIT field->clear_attr(signable_e); } else { error_msg(@comp, "numeric USAGE invalid " - "with Alpnanumeric PICTURE"); - dialect_error(@1, "Alpnanumeric COMP-5 or COMP-X", "mf or gnu"); + "with Alphanumeric PICTURE"); + dialect_error(@1, "Alphanumeric COMP-5 or COMP-X", "mf or gnu"); YYERROR; } break; @@ -7341,8 +7360,7 @@ num_value: scalar // might actually be a string | DETAIL OF scalar {$$ = $scalar; } | LENGTH_OF binary_type[size] { location_set(@1); - $$ = new cbl_refer_t( new_tempnumeric() ); - $$->field->clear_attr(signable_e); + $$ = new cbl_refer_t( new_tempnumeric(none_e) ); if( dialect_gcc() ) { dialect_error(@1, "LENGTH OF", "ibm"); } @@ -7350,8 +7368,7 @@ num_value: scalar // might actually be a string } | LENGTH_OF name[val] { location_set(@1); - $$ = new cbl_refer_t( new_tempnumeric() ); - $$->field->clear_attr(signable_e); + $$ = new cbl_refer_t( new_tempnumeric(none_e) ); if( dialect_gcc() ) { dialect_error(@1, "LENGTH OF", "ibm"); } @@ -7359,8 +7376,7 @@ num_value: scalar // might actually be a string } | LENGTH_OF name[val] subscripts[subs] { location_set(@1); - $$ = new cbl_refer_t( new_tempnumeric() ); - $$->field->clear_attr(signable_e); + $$ = new cbl_refer_t( new_tempnumeric(none_e) ); if( dialect_gcc() ) { dialect_error(@1, "LENGTH OF", "ibm"); } @@ -7576,8 +7592,7 @@ signed_literal: num_literal } | LENGTH_OF binary_type[size] { location_set(@1); - $$ = new_tempnumeric(); - $$->clear_attr(signable_e); + $$ = new_tempnumeric(none_e); if( dialect_gcc() ) { dialect_error(@1, "LENGTH OF", "ibm"); } @@ -7585,8 +7600,7 @@ signed_literal: num_literal } | LENGTH_OF name[val] { location_set(@1); - $$ = new_tempnumeric(); - $$->clear_attr(signable_e); + $$ = new_tempnumeric(none_e); if( dialect_gcc() ) { dialect_error(@1, "LENGTH OF", "ibm"); } @@ -7594,8 +7608,7 @@ signed_literal: num_literal } | LENGTH_OF name[val] subscripts[subs] { location_set(@1); - $$ = new_tempnumeric(); - $$->clear_attr(signable_e); + $$ = new_tempnumeric(none_e); if( dialect_gcc() ) { dialect_error(@1, "LENGTH OF", "ibm"); } @@ -8146,8 +8159,7 @@ varg1a: ADDRESS OF scalar { } | LENGTH_OF binary_type[size] { location_set(@1); - $$ = new cbl_refer_t( new_tempnumeric() ); - $$->field->clear_attr(signable_e); + $$ = new cbl_refer_t( new_tempnumeric(none_e) ); if( dialect_gcc() ) { dialect_error(@1, "LENGTH OF", "ibm"); } @@ -8155,8 +8167,7 @@ varg1a: ADDRESS OF scalar { } | LENGTH_OF name[val] { location_set(@1); - $$ = new cbl_refer_t( new_tempnumeric() ); - $$->field->clear_attr(signable_e); + $$ = new cbl_refer_t( new_tempnumeric(none_e) ); if( dialect_gcc() ) { dialect_error(@1, "LENGTH OF", "ibm"); } @@ -8164,8 +8175,7 @@ varg1a: ADDRESS OF scalar { } | LENGTH_OF name[val] subscripts[subs] { location_set(@1); - $$ = new cbl_refer_t( new_tempnumeric() ); - $$->field->clear_attr(signable_e); + $$ = new cbl_refer_t( new_tempnumeric(none_e) ); if( dialect_gcc() ) { dialect_error(@1, "LENGTH OF", "ibm"); } @@ -8881,6 +8891,23 @@ set: SET set_tgts[tgts] TO set_operand[src] new_literal($src, quoted_e); ast_set_pointers($tgts->targets, literal); } + // Format 12 (save-locale): + | SET set_tgts[tgts] TO LOCALE locale_current + { + if( $tgts->targets.size() > 1 ) { + error_msg(@tgts, "only 1 save-locale data-item is valid"); + } + switch($locale_current) { + case LC_ALL_kw: + case DEFAULT: + ast_save_locale($tgts->targets.front().refer, $locale_current); + break; + default: + gcc_unreachable(); + } + cbl_unimplementedw("unimplemented: SET TO LOCALE"); + } + ; | SET set_tgts[tgts] UP BY num_operand[src] { statement_begin(@1, SET); @@ -8939,6 +8966,42 @@ set: SET set_tgts[tgts] TO set_operand[src] set_conditional($yn)); } | SET { statement_begin(@1, SET); } many_switches + + // Format 11 (set-locale): + | SET LOCALE locale_tgt[tgt] TO locale_src + { + if( $tgt->is_default() ) { + // do something $tgt->default_of() + } else { + // do something $tgt->lc_categories() + } + cbl_unimplementedw("unimplemented: SET LOCALE"); + } + ; + +locale_tgt: user_default { $$ = new locale_tgt_t(); *$$ = $1; } + | loc_categories + ; +loc_categories: loc_category { $$ = new locale_tgt_t($1); } + | loc_categories loc_category { + $$ = $1; + $$->push_back($2); + } + ; +loc_category: LC_ALL_kw { $$ = LC_ALL_kw; } + | LC_COLLATE_kw { $$ = LC_COLLATE_kw; } + | LC_CTYPE_kw { $$ = LC_CTYPE_kw; } + | LC_MESSAGES_kw { $$ = LC_MESSAGES_kw; } + | LC_MONETARY_kw { $$ = LC_MONETARY_kw; } + | LC_NUMERIC_kw { $$ = LC_NUMERIC_kw; } + | LC_TIME_kw { $$ = LC_TIME_kw; } + ; +locale_src: scalar + | DEFAULT { assert($1 == 'U' || $1 == 'S'); } + ; + +locale_current: LC_ALL_kw { $$ = LC_ALL_kw; } // locale to be saved by SET Format 12. + | user_default { $$ = DEFAULT; } ; many_switches: set_switches @@ -9273,16 +9336,20 @@ sort_target: label_name release: RELEASE NAME[record] FROM scalar[name] { - statement_begin(@1, RELEASE); - symbol_elem_t *record = symbol_find(@record, $record); - parser_move(cbl_field_of(record), *$name); - parser_release(cbl_field_of(record)); + if( ! mode_syntax_only() ) { + statement_begin(@1, RELEASE); + symbol_elem_t *record = symbol_find(@record, $record); + parser_move(cbl_field_of(record), *$name); + parser_release(cbl_field_of(record)); + } } | RELEASE NAME[record] { - statement_begin(@1, RELEASE); - symbol_elem_t *record = symbol_find(@record, $record); - parser_release(cbl_field_of(record)); + if( ! mode_syntax_only() ) { + statement_begin(@1, RELEASE); + symbol_elem_t *record = symbol_find(@record, $record); + parser_release(cbl_field_of(record)); + } } ; @@ -10705,15 +10772,13 @@ intrinsic: function_udf } | LENGTH '(' tableish[val] ')' { location_set(@1); - $$ = new_tempnumeric("LENGTH"); - $$->clear_attr(signable_e); + $$ = new_tempnumeric("LENGTH", none_e); parser_set_numeric($$, $val->field->size()); if( ! intrinsic_call_1($$, LENGTH, $val, @val)) YYERROR; } | LENGTH '(' varg1a[val] ')' { location_set(@1); - $$ = new_tempnumeric("LENGTH"); - $$->clear_attr(signable_e); + $$ = new_tempnumeric("LENGTH", none_e); parser_set_numeric($$, $val->field->data.capacity); if( ! intrinsic_call_1($$, LENGTH, $val, @val)) YYERROR; } @@ -10738,7 +10803,7 @@ intrinsic: function_udf | ORD '(' alpha_val[r1] ')' { location_set(@1); - $$ = new_tempnumeric("ORD"); + $$ = new_tempnumeric("ORD", none_e); if( ! intrinsic_call_1($$, ORD, $r1, @r1)) YYERROR; } | RANDOM @@ -11436,6 +11501,20 @@ usage: %empty | USAGE IS ; +user_default: DEFAULT + { // cannot be empty + switch( $1 ) { + case 'U': break; + case 'S': + error_msg(@1, "invalid syntax: SYSTEM-DEFAULT"); + break; + default: + error_msg(@1, "invalid syntax: DEFAULT"); + gcc_unreachable(); + } + } + ; + with: %empty | WITH ; @@ -11689,40 +11768,115 @@ xml_generic_numeric: ; xmlparse: xmlparse_impl end_xml { - cbl_unimplemented("XML PARSE"); + auto xml_stmt = xml_statements.top(); + parser_xml_end(xml_stmt); + xml_statements.pop(); + current.declaratives_evaluate(); } | xmlparse_cond end_xml { - cbl_unimplemented("XML PARSE"); + auto xml_stmt = xml_statements.top(); + parser_xml_end(xml_stmt); + xml_statements.pop(); + current.declaratives_evaluate(); } ; -xmlparse_impl: XMLPARSE xmlparse_body +xmlparse_impl: XMLPARSE xmlparse_body[body] + { + parser_xml_on_exception($body); + parser_xml_not_exception($body); + } ; xmlparse_cond: XMLPARSE xmlparse_body[body] xmlexcepts[err] + { + if( ! $err.on_error ) parser_xml_on_exception($body); + if( ! $err.not_error ) parser_xml_not_exception($body); + } ; -xmlparse_body: XMLPARSE name xmlencoding xmlreturning xmlvalidating - PROCESSING PROCEDURE is xmlprocs +xmlparse_body: scalar xmlencoding xmlreturning xmlvalidating + PROCESSING PROCEDURE is xmlprocs[procs] + { + $$ = label_add(@$, LblXml, uniq_label("xml")); + xml_statements.push($$); + statement_begin(@$, XMLPARSE); + parser_xml_parse( $$, + *$scalar, + $xmlencoding, + $xmlvalidating, + $xmlreturning == NATIONAL, + $procs.from, + $procs.to ); + } ; -xmlencoding: %empty %prec NAME - | with ENCODING name [codepage] +xmlencoding: %empty %prec NAME { $$ = nullptr; } + | with ENCODING name [codepage] { $$ = $codepage; } ; -xmlreturning: %empty - | RETURNING NATIONAL +xmlreturning: %empty { $$ = 0; } + | RETURNING NATIONAL { $$ = NATIONAL; } ; -xmlvalidating: %empty - | VALIDATING with name - | VALIDATING with FILE_KW name +xmlvalidating: %empty { $$ = nullptr; } + | VALIDATING with name { $$ = $name; } + | VALIDATING with FILE_KW name { $$ = $name; } ; -xmlprocs: label_1[proc] - | label_1[proc1] THRU label_1[proc2] +xmlprocs: label_1 { + $$ = label_pair_t{$1}; + } + | label_1[from] THRU label_1[to] { + $$ = label_pair_t{$from, $to}; + } ; xmlexcepts: xmlexcept[a] statements %prec XMLPARSE + { + assert( $a.on_error || $a.not_error ); + assert( ! ($a.on_error && $a.not_error) ); + $$ = $a; + } | xmlexcepts[a] xmlexcept[b] statements %prec XMLPARSE - ; + { + if( $a.on_error && $a.not_error ) { + error_msg(@1, "too many ON ERROR clauses"); + YYERROR; + } + // "ON" and "NOT ON" could be reversed, but not duplicated. + if( $a.on_error && $b.on_error ) { + error_msg(@1, "duplicate ON ERROR clauses"); + YYERROR; + } + if( $a.not_error && $b.not_error ) { + error_msg(@1, "duplicate NOT ON ERROR clauses"); + YYERROR; + } + $$ = $a; + if( $$.on_error ) { + assert($b.not_error); + $$.not_error = $b.not_error; + } else { + assert($b.on_error); + $$.on_error = $b.on_error; + } + } + ; xmlexcept: EXCEPTION + { + auto xml_stmt = xml_statements.top(); + // The value of the pointer no longer matters, only NULL or not. + $$.on_error = $$.not_error = nullptr; + switch($1) { + case EXCEPTION: + $$.on_error = xml_stmt; + parser_xml_on_exception(xml_stmt); + break; + case NOT: + $$.not_error = xml_stmt; + parser_xml_not_exception(xml_stmt); + break; + default: + gcc_unreachable(); + } + } ; end_xml: %empty %prec XMLPARSE @@ -11864,12 +12018,6 @@ bool iso_cobol_word( const std::string& name, bool include_context ); * REPOSITORY names. */ -// tokens.h is generated as needed from parse.h with tokens.h.gen -current_tokens_t::tokenset_t::tokenset_t() { -#include "token_names.h" -} - - // Look up the lowercase form of a keyword, excluding some CDF names. int current_tokens_t::tokenset_t::find( const cbl_name_t name, bool include_intrinsics ) { @@ -13391,6 +13539,54 @@ cbl_figconst_field_of( const char *value ) { return token == 0 ? nullptr : constant_of(constant_index(token)); } +const char * +literal_t::symbol_name() const { + return isym? cbl_field_of(symbol_at(isym))->name : ""; +} + +literal_t& +literal_t::set( const cbl_field_t * field ) { + assert(field->has_attr(constant_e)); + assert(is_literal(field)); + + set_prefix( "", 0 ); + set_data( field->data.capacity, + const_cast<char*>(field->data.initial), + field_index(field) ); + return *this; +} + +literal_t& +literal_t::set_prefix( const char *input, size_t len ) { + encoding = current_encoding('A'); + assert(len < sizeof(prefix)); + std::fill(prefix, prefix + sizeof(prefix), '\0'); + std::transform(input, input + len, prefix, toupper); + switch(prefix[0]) { + case '\0': case 'Z': + encoding = current_encoding('A'); + break; + case 'N': + encoding = current_encoding('N'); + if( 'X' == prefix[1] ) { + cbl_unimplemented("NX literals"); + } + break; + case 'G': + cbl_unimplemented("DBCS encoding not supported"); + break; + case 'U': + encoding = UTF8_e; + break; + case 'X': + break; + default: + gcc_unreachable(); + } + assert(encoding <= iconv_YU_e); + return *this; +} + cbl_field_attr_t literal_attr( const char prefix[] ) { @@ -13766,3 +13962,4 @@ eval_subject_t::compare( const cbl_refer_t& object, parser_relop(result, subject, eq_op, object); return result; } + diff --git a/gcc/cobol/parse_ante.h b/gcc/cobol/parse_ante.h index c3e3495..1fbc8f5 100644 --- a/gcc/cobol/parse_ante.h +++ b/gcc/cobol/parse_ante.h @@ -278,6 +278,9 @@ name_of( cbl_field_t *field ) { // associated with returning a static. I don't actually know. -- RJD. static size_t static_length = 0; static char * static_buffer = nullptr; + + if( field->data.initial == nullptr ) return field->name; + if( field->name[0] == '_' ) { // Make a copy of .initial @@ -757,6 +760,8 @@ class eval_subject_t { } }; +static std::stack<cbl_label_t *> xml_statements; + class evaluate_t : private std::stack<eval_subject_t> { public: size_t depth() const { return size(); } @@ -2366,8 +2371,13 @@ char * normalize_picture( char picture[] ); static inline cbl_field_t * -new_tempnumeric(const cbl_name_t name = nullptr) { - return new_temporary(FldNumericBin5, name); +new_tempnumeric(const cbl_name_t name = nullptr, cbl_field_attr_t attr = signable_e ) { + return new_temporary(FldNumericBin5, name, attr == signable_e); +} + +static inline cbl_field_t * +new_tempnumeric(const cbl_field_attr_t attr ) { + return new_temporary(FldNumericBin5, nullptr, attr == signable_e); } static inline cbl_field_t * @@ -3183,6 +3193,16 @@ ast_set_pointers( const list<cbl_num_result_t>& tgts, cbl_refer_t src ) { parser_set_pointers(nptr, ptrs.data(), src); } +static void +ast_save_locale( cbl_refer_t refer, int /* token */ ) { + assert( ! refer.addr_of && ! refer.is_reference() ); + if( ! refer.is_pointer() ) { + error_msg(refer.loc, "%s must be USAGE POINTER", refer.name()); + return; + } + cbl_unimplemented("SET identifier-11 TO LOCALE"); +} + void stringify( refer_collection_t *inputs, const cbl_refer_t& into, const cbl_refer_t& pointer, @@ -3269,7 +3289,11 @@ data_division_ready() { const char *name = current.collating_sequence(); if( ! symbols_alphabet_set(PROGRAM, name) ) { - error_msg(yylloc, "no alphabet '%s' defined", name); + if( name ) { + error_msg(yylloc, "no alphabet '%s' defined", name); + } else { + error_msg(yylloc, "no alphabet defined"); + } return false; } } diff --git a/gcc/cobol/scan.l b/gcc/cobol/scan.l index 53d88cb..07aa76d 100644 --- a/gcc/cobol/scan.l +++ b/gcc/cobol/scan.l @@ -517,7 +517,6 @@ THAN { return THAN; } TEST { return TEST; } TERMINATE { return TERMINATE; } TALLYING { return TALLYING; } -TALLY { return TALLY; } SYSPUNCH { return SYSPUNCH; } SYSOUT { return SYSOUT; } SYSIN { return SYSIN; } @@ -997,12 +996,12 @@ USE({SPC}FOR)? { return USE; } COMP(UTATIONAL)?-X { return ucomputable(FldNumericBin5, 0xFF); } COMP(UTATIONAL)?-6 { return ucomputable(FldPacked, 0); } COMP(UTATIONAL)?-5 { return ucomputable(FldNumericBin5, 0); } - COMP(UTATIONAL)?-4 { return scomputable(FldNumericBinary, 0); } + COMP(UTATIONAL)?-4 { return ucomputable(FldNumericBinary, 0); } COMP(UTATIONAL)?-3 { return PACKED_DECIMAL; } COMP(UTATIONAL)?-2 { return ucomputable(FldFloat, 8); } COMP(UTATIONAL)?-1 { return ucomputable(FldFloat, 4); } COMP(UTATIONAL)? { return ucomputable(FldNumericBinary, 0); } - BINARY { return scomputable(FldNumericBinary, 0); } + BINARY { return ucomputable(FldNumericBinary, 0); } BINARY-CHAR { return bcomputable(FldNumericBin5, 1); } BINARY-SHORT { return bcomputable(FldNumericBin5, 2); } @@ -2262,7 +2261,7 @@ BASIS { yy_push_state(basis); return BASIS; } DE { return DE; } DECIMAL-POINT { return DECIMAL_POINT; } DECLARATIVES { return DECLARATIVES; } - DEFAULT { return DEFAULT; } + DEFAULT { yylval.number = 'D'; return DEFAULT; } DELETE { return DELETE; } DELIMITED { return DELIMITED; } DELIMITER { return DELIMITER; } diff --git a/gcc/cobol/scan_ante.h b/gcc/cobol/scan_ante.h index c00826d..a6ec99b 100644 --- a/gcc/cobol/scan_ante.h +++ b/gcc/cobol/scan_ante.h @@ -575,36 +575,41 @@ keyword_alias_add( const std::string& keyword, const std::string& alias ) { struct bint_t { int token; cbl_field_type_t type; - uint32_t capacity; + uint32_t capacity; // zero means capacity depends on PICTURE bool signable; }; static const std::map <std::string, bint_t > binary_integers { - { "COMP-X", { COMPUTATIONAL, FldNumericBin5, 0xFF, false } }, - { "COMP-6", { COMPUTATIONAL, FldPacked, 0, false } }, - { "COMP-5", { COMPUTATIONAL, FldNumericBin5, 0, false } }, - { "COMP-4", { COMPUTATIONAL, FldNumericBinary, 0, true } }, - { "COMP-2", { COMPUTATIONAL, FldFloat, 8, false } }, - { "COMP-1", { COMPUTATIONAL, FldFloat, 4, false } }, - { "COMP", { COMPUTATIONAL, FldNumericBinary, 0, false } }, - { "COMPUTATIONAL-X", { COMPUTATIONAL, FldNumericBin5, 0xFF, false } }, - { "COMPUTATIONAL-6", { COMPUTATIONAL, FldPacked, 0, false } }, - { "COMPUTATIONAL-5", { COMPUTATIONAL, FldNumericBin5, 0, false } }, - { "COMPUTATIONAL-4", { COMPUTATIONAL, FldNumericBinary, 0, true } }, - { "COMPUTATIONAL-2", { COMPUTATIONAL, FldFloat, 8, false } }, - { "COMPUTATIONAL-1", { COMPUTATIONAL, FldFloat, 4, false } }, - { "COMPUTATIONAL", { COMPUTATIONAL, FldNumericBinary, 0, false } }, - { "BINARY", { BINARY_INTEGER, FldNumericBinary, 0, true } }, - { "BINARY-CHAR", { BINARY_INTEGER, FldNumericBin5, 1, true } }, - { "BINARY-SHORT", { BINARY_INTEGER, FldNumericBin5, 2, true } }, - { "BINARY-LONG", { BINARY_INTEGER, FldNumericBin5, 4, true } }, - { "BINARY-DOUBLE", { BINARY_INTEGER, FldNumericBin5, 8, true } }, - { "BINARY-LONG-LONG", { BINARY_INTEGER, FldNumericBin5, 8, true } }, - { "FLOAT-BINARY-32", { COMPUTATIONAL, FldFloat, 4, false } }, - { "FLOAT-BINARY-64", { COMPUTATIONAL, FldFloat, 8, false } }, + { "BINARY", { COMPUTATIONAL, FldNumericBinary, 0, false } }, + { "COMP", { COMPUTATIONAL, FldNumericBinary, 0, false } }, + { "COMPUTATIONAL", { COMPUTATIONAL, FldNumericBinary, 0, false } }, + { "COMP-4", { COMPUTATIONAL, FldNumericBinary, 0, false } }, + { "COMPUTATIONAL-4", { COMPUTATIONAL, FldNumericBinary, 0, false } }, + + { "BINARY-CHAR", { BINARY_INTEGER, FldNumericBin5, 1, true } }, + { "BINARY-SHORT", { BINARY_INTEGER, FldNumericBin5, 2, true } }, + { "BINARY-LONG", { BINARY_INTEGER, FldNumericBin5, 4, true } }, + { "BINARY-DOUBLE", { BINARY_INTEGER, FldNumericBin5, 8, true } }, + { "BINARY-LONG-LONG", { BINARY_INTEGER, FldNumericBin5, 8, true } }, + + { "COMP-5", { COMPUTATIONAL, FldNumericBin5, 0, false } }, + { "COMPUTATIONAL-5", { COMPUTATIONAL, FldNumericBin5, 0, false } }, + { "COMP-X", { COMPUTATIONAL, FldNumericBin5, 0xFF, false } }, + { "COMPUTATIONAL-X", { COMPUTATIONAL, FldNumericBin5, 0xFF, false } }, + + { "COMP-1", { COMPUTATIONAL, FldFloat, 4, false } }, + { "COMPUTATIONAL-1", { COMPUTATIONAL, FldFloat, 4, false } }, + { "FLOAT-BINARY-32", { COMPUTATIONAL, FldFloat, 4, false } }, + { "FLOAT-SHORT", { COMPUTATIONAL, FldFloat, 4, false } }, + + { "COMP-2", { COMPUTATIONAL, FldFloat, 8, false } }, + { "COMPUTATIONAL-2", { COMPUTATIONAL, FldFloat, 8, false } }, + { "FLOAT-BINARY-64", { COMPUTATIONAL, FldFloat, 8, false } }, + { "FLOAT-LONG", { COMPUTATIONAL, FldFloat, 8, false } }, { "FLOAT-BINARY-128", { COMPUTATIONAL, FldFloat, 16, false } }, - { "FLOAT-EXTENDED", { COMPUTATIONAL, FldFloat, 16, false } }, - { "FLOAT-LONG", { COMPUTATIONAL, FldFloat, 8, false } }, - { "FLOAT-SHORT", { COMPUTATIONAL, FldFloat, 4, false } }, + { "FLOAT-EXTENDED", { COMPUTATIONAL, FldFloat, 16, false } }, + + { "COMP-6", { COMPUTATIONAL, FldPacked, 0, false } }, + { "COMPUTATIONAL-6", { COMPUTATIONAL, FldPacked, 0, false } }, }; static int diff --git a/gcc/cobol/scan_post.h b/gcc/cobol/scan_post.h index 7cf2b98..01c863e 100644 --- a/gcc/cobol/scan_post.h +++ b/gcc/cobol/scan_post.h @@ -401,3 +401,12 @@ yylex(void) { return token; } + +/* + * Token name<->string utilities + */ + +// tokens.h is generated as needed from parse.h with tokens.h.gen +current_tokens_t::tokenset_t::tokenset_t() { +#include "token_names.h" +}; diff --git a/gcc/cobol/symbols.cc b/gcc/cobol/symbols.cc index b6f4a37..2a299ce 100644 --- a/gcc/cobol/symbols.cc +++ b/gcc/cobol/symbols.cc @@ -1634,6 +1634,9 @@ extend_66_capacity( cbl_field_t *alias ) { bool symbols_alphabet_set( size_t program, const char name[]) { + +//////// +// Older version struct alpha { void operator()( symbol_elem_t& elem ) const { if( elem.type == SymAlphabet ) { @@ -1654,6 +1657,38 @@ symbols_alphabet_set( size_t program, const char name[]) { parser_alphabet_use(*cbl_alphabet_of(e)); } return true; +// End older version +//////// + +//// // Define alphabets for codegen. +//// const cbl_alphabet_t *alphabet = nullptr; +//// bool supported = true; +//// +//// std::for_each( symbols_begin(program), symbols_end(), +//// [&alphabet, &supported]( const auto& sym ) { +//// if( sym.type == SymAlphabet ) { +//// alphabet = cbl_alphabet_of(&sym); +//// supported = __gg__encoding_iconv_valid(alphabet->encoding); +//// if( supported ) { +//// parser_alphabet( *alphabet ); +//// } +//// } +//// } ); +//// if( ! supported ) { +//// const char *encoding = __gg__encoding_iconv_name(alphabet->encoding); +//// cbl_unimplemented("alphabet %qs (as %qs)", alphabet->name, encoding); +//// return false; +//// } +//// +//// // Set collation sequence before parser_symbol_add.` +//// if( name ) { +//// symbol_elem_t *e = symbol_alphabet(program, name); +//// if( !e ) { +//// return false; +//// } +//// parser_alphabet_use(*cbl_alphabet_of(e)); +//// } +//// return true; } static std::ostream& @@ -2352,6 +2387,7 @@ symbol_table_init(void) { assert(table.nelem < table.capacity); std::for_each(debug_start+1, p, parent_elem_set(debug_start - table.elems)); + // special registers static cbl_field_t special_registers[] = { { FldNumericDisplay, register_e, {2,2,2,0, NULL}, 0, "_FILE_STATUS" }, { FldNumericBin5, register_e, {2,2,4,0, NULL}, 0, "UPSI-0" }, @@ -2363,7 +2399,6 @@ symbol_table_init(void) { { FldLiteralA, constq|register_e, {0,0,0,0, "/dev/null"}, 0, "_dev_null" }, }; - // special registers assert(table.nelem + COUNT_OF(special_registers) < table.capacity); p = table.elems + table.nelem; @@ -2373,6 +2408,26 @@ symbol_table_init(void) { table.nelem = p - table.elems; assert(table.nelem < table.capacity); + // xml registers + static cbl_field_t xml_registers[] = { + { FldNumericBin5, register_e, {4,4,9,0, "0"}, 1, "XML-CODE" }, + { FldAlphanumeric, register_e, {30,30,0,0, " "}, 1, "XML-EVENT" }, + { FldNumericBin5, register_e, {4,4,9,0, "0"}, 1, "XML-INFORMATION" }, + { FldAlphanumeric, register_e | based_e | any_length_e, {1,1,0,0, nullptr}, 1, "XML-NAMESPACE" }, + { FldAlphanumeric, register_e | based_e | any_length_e, {1,1,0,0, nullptr}, 1, "XML-NNAMESPACE" }, + { FldAlphanumeric, register_e | based_e | any_length_e, {1,1,0,0, nullptr}, 1, "XML-NAMESPACE-PREFIX" }, + { FldAlphanumeric, register_e | based_e | any_length_e, {1,1,0,0, nullptr}, 1, "XML-NNAMESPACE-PREFIX" }, + { FldAlphanumeric, register_e | based_e | any_length_e, {1,1,0,0, nullptr}, 1, "XML-TEXT" }, + { FldAlphanumeric, register_e | based_e | any_length_e, {1,1,0,0, nullptr}, 1, "XML-NTEXT" }, + }, * const eoxml = xml_registers + COUNT_OF(xml_registers); + + assert(table.nelem + COUNT_OF(xml_registers) < table.capacity); + + p = table.elems + table.nelem; + p = std::transform(xml_registers, eoxml, p, elementize); + table.nelem = p - table.elems; + assert(table.nelem < table.capacity); + // Initialize symbol table. symbols = table; @@ -3162,6 +3217,13 @@ cbl_alphabet_t::reencode() { const unsigned char * const pend = alphabet + sizeof(alphabet); std::vector<char> tgt(256, (char)0xFF); + /* Keep copies of low_index and last_index for use in run-time as LOW-VALUE + and HIGH-VALUE, which are kept as globals in the source-code codeset + and converted to the display encoding as necessary. */ + + low_char = low_index; + high_char = last_index; + /* * For now, assume CP1252 source-code encoding because we're not capturing it * anywhere except in cbl_field_t::internalize(). The only known examples of @@ -3533,12 +3595,16 @@ new_alphanumeric( size_t capacity, const cbl_name_t name = nullptr ) { extern os_locale_t os_locale; -const encodings_t cbl_field_t::codeset_t::standard_internal = { iconv_CP1252_e, "CP1252" }; +const encodings_t cbl_field_t::codeset_t::standard_internal = { + true, iconv_CP1252_e, "CP1252" +}; #define standard_internal cbl_field_t::codeset_t::standard_internal cbl_field_t * -new_temporary( enum cbl_field_type_t type, const char *initial ) { - if( ! initial ) { +new_temporary( enum cbl_field_type_t type, const char *initial, bool is_signed ) { + const bool force_unsigned = type == FldNumericBin5 && ! is_signed; + + if( ! initial && ! force_unsigned ) { assert( ! is_literal(type) ); // Literal type must have literal value. return temporaries.acquire(type, initial); } @@ -3549,7 +3615,14 @@ new_temporary( enum cbl_field_type_t type, const char *initial ) { return field; } cbl_field_t *field = new_temporary_impl(type, initial); - temporaries.add(field); + + // don't reuse unsigned numeric + if( force_unsigned ) { + field->clear_attr(signable_e); + } else { + temporaries.add(field); + } + parser_symbol_add(field); return field; diff --git a/gcc/cobol/symbols.h b/gcc/cobol/symbols.h index b24283a..66fb2fd 100644 --- a/gcc/cobol/symbols.h +++ b/gcc/cobol/symbols.h @@ -500,6 +500,7 @@ struct cbl_subtable_t { }; const char * __gg__encoding_iconv_name( cbl_encoding_t encoding ); +bool __gg__encoding_iconv_valid( cbl_encoding_t encoding ); bool is_elementary( enum cbl_field_type_t type ); @@ -507,8 +508,8 @@ bool is_elementary( enum cbl_field_type_t type ); // current_encoding('A') and current_encoding('N') enum { - encoding_display_e = 'A', - encoding_national_e = 'N' + display_encoding_e = 'A', + national_encoding_e = 'N' }; cbl_encoding_t current_encoding( char a_or_n ); @@ -964,6 +965,7 @@ enum cbl_label_type_t { LblString, LblArith, LblCompute, + LblXml, }; struct cbl_proc_addresses_t { @@ -1188,6 +1190,12 @@ struct cbl_compute_error_t { tree compute_error_code; }; +struct cbl_xml_parse_t { + cbl_label_addresses_t over; + cbl_label_addresses_t exception; + cbl_label_addresses_t no_exception; +}; + struct cbl_label_t { enum cbl_label_type_t type; size_t parent; @@ -1221,6 +1229,10 @@ struct cbl_label_t { // for parser_op/parser_assign error tracking struct cbl_compute_error_t *compute_error; + + // for parse_xml processing: + struct cbl_xml_parse_t *xml_parse; + } structs; bool is_function() const { return type == LblFunction; } @@ -1239,6 +1251,7 @@ struct cbl_label_t { case LblString: return "LblString"; case LblArith: return "LblArith"; case LblCompute: return "LblCompute"; + case LblXml: return "LblXml"; } gcc_unreachable(); } @@ -1293,7 +1306,9 @@ struct label_cmp_lessthan { size_t field_index( const cbl_field_t *f ); -cbl_field_t * new_temporary( enum cbl_field_type_t type, const char initial[] = NULL ); +cbl_field_t * new_temporary( enum cbl_field_type_t type, + const char initial[] = NULL, + bool attr = false ); cbl_field_t * new_temporary_like( cbl_field_t skel ); cbl_field_t * new_temporary_clone( const cbl_field_t *orig); cbl_field_t * keep_temporary( cbl_field_type_t type ); @@ -1532,6 +1547,7 @@ struct cbl_alphabet_t { cbl_name_t name; cbl_encoding_t encoding; unsigned char low_index, high_index, last_index, alphabet[256]; + unsigned char low_char, high_char; cbl_alphabet_t() : loc { 1,1, 1,1 } @@ -1539,6 +1555,8 @@ struct cbl_alphabet_t { , low_index(0) , high_index(255) , last_index(0) + , low_char(0) + , high_char(0) { memset(name, '\0', sizeof(name)); memset(alphabet, 0xFF, sizeof(alphabet)); @@ -1550,6 +1568,8 @@ struct cbl_alphabet_t { , low_index(0) , high_index(255) , last_index(0) + , low_char(0) + , high_char(0) { memset(name, '\0', sizeof(name)); memset(alphabet, 0xFF, sizeof(alphabet)); @@ -1562,6 +1582,8 @@ struct cbl_alphabet_t { , encoding(custom_encoding_e) , low_index(low_index), high_index(high_index) , last_index(high_index) + , low_char(low_index) + , high_char(high_index) { assert(strlen(name) < sizeof(this->name)); strcpy(this->name, name); @@ -1953,6 +1975,14 @@ symbol_elem_of( cbl_alphabet_t *alphabet ) { reinterpret_cast<symbol_elem_t *>((char*)alphabet - n); } +static inline const symbol_elem_t * +symbol_elem_of( const cbl_alphabet_t *alphabet ) { + size_t n = offsetof(symbol_elem_t, elem.alphabet); + return + // cppcheck-suppress cstyleCast + reinterpret_cast<const symbol_elem_t *>((const char*)alphabet - n); +} + static inline symbol_elem_t * symbol_elem_of( cbl_file_t *file ) { size_t n = offsetof(struct symbol_elem_t, elem.file); @@ -2027,14 +2057,14 @@ const cbl_field_t * symbol_unresolved_file_key( const cbl_file_t * file, const cbl_name_t key_field_name ); -static inline struct cbl_section_t * -cbl_section_of( struct symbol_elem_t *e ) { +static inline cbl_section_t * +cbl_section_of( symbol_elem_t *e ) { assert(e && e->type == SymDataSection); return &e->elem.section; } -static inline struct cbl_field_t * -cbl_field_of( struct symbol_elem_t *e ) { +static inline cbl_field_t * +cbl_field_of( symbol_elem_t *e ) { assert(e && e->type == SymField); return &e->elem.field; } @@ -2044,8 +2074,8 @@ cbl_field_of( const symbol_elem_t *e ) { return &e->elem.field; } -static inline struct cbl_label_t * -cbl_label_of( struct symbol_elem_t *e ) { +static inline cbl_label_t * +cbl_label_of( symbol_elem_t *e ) { assert(e && e->type == SymLabel); return &e->elem.label; } @@ -2056,20 +2086,26 @@ cbl_label_of( const symbol_elem_t *e ) { return &e->elem.label; } -static inline struct cbl_special_name_t * -cbl_special_name_of( struct symbol_elem_t *e ) { +static inline cbl_special_name_t * +cbl_special_name_of( symbol_elem_t *e ) { assert(e && e->type == SymSpecial); return &e->elem.special; } -static inline struct cbl_alphabet_t * -cbl_alphabet_of( struct symbol_elem_t *e ) { +static inline cbl_alphabet_t * +cbl_alphabet_of( symbol_elem_t *e ) { + assert(e && e->type == SymAlphabet); + return &e->elem.alphabet; +} + +static inline const cbl_alphabet_t * +cbl_alphabet_of( const symbol_elem_t *e ) { assert(e && e->type == SymAlphabet); return &e->elem.alphabet; } -static inline struct cbl_file_t * -cbl_file_of( struct symbol_elem_t *e ) { +static inline cbl_file_t * +cbl_file_of( symbol_elem_t *e ) { assert(e && e->type == SymFile); return &e->elem.file; } diff --git a/gcc/cobol/token_names.h b/gcc/cobol/token_names.h index 77029f7..6d3de71 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 -// Mon Sep 15 22:47:12 EDT 2025 +// generated by /home/jklowden/projects/3rd/gcc/parser/gcc/cobol/token_names.h.gen cobol/parse.h +// Mon Oct 20 14:11:39 EDT 2025 tokens = { { "identification", IDENTIFICATION_DIV }, // 258 { "environment", ENVIRONMENT_DIV }, // 259 @@ -541,171 +541,170 @@ tokens = { { "symbol", SYMBOL }, // 790 { "symbolic", SYMBOLIC }, // 791 { "synchronized", SYNCHRONIZED }, // 792 - { "tally", TALLY }, // 793 - { "tallying", TALLYING }, // 794 - { "tan", TAN }, // 795 - { "terminate", TERMINATE }, // 796 - { "test", TEST }, // 797 - { "test-date-yyyymmdd", TEST_DATE_YYYYMMDD }, // 798 - { "test-day-yyyyddd", TEST_DAY_YYYYDDD }, // 799 - { "test-formatted-datetime", TEST_FORMATTED_DATETIME }, // 800 - { "test-numval", TEST_NUMVAL }, // 801 - { "test-numval-c", TEST_NUMVAL_C }, // 802 - { "test-numval-f", TEST_NUMVAL_F }, // 803 - { "than", THAN }, // 804 - { "time", TIME }, // 805 - { "times", TIMES }, // 806 - { "to", TO }, // 807 - { "top", TOP }, // 808 - { "top-level", TOP_LEVEL }, // 809 - { "tracks", TRACKS }, // 810 - { "track-area", TRACK_AREA }, // 811 - { "trailing", TRAILING }, // 812 - { "transform", TRANSFORM }, // 813 - { "trim", TRIM }, // 814 - { "true", TRUE_kw }, // 815 - { "try", TRY }, // 816 - { "turn", TURN }, // 817 - { "type", TYPE }, // 818 - { "typedef", TYPEDEF }, // 819 - { "ulength", ULENGTH }, // 820 - { "unbounded", UNBOUNDED }, // 821 - { "unit", UNIT }, // 822 - { "units", UNITS }, // 823 - { "unit-record", UNIT_RECORD }, // 824 - { "until", UNTIL }, // 825 - { "up", UP }, // 826 - { "upon", UPON }, // 827 - { "upos", UPOS }, // 828 - { "upper-case", UPPER_CASE }, // 829 - { "usage", USAGE }, // 830 - { "using", USING }, // 831 - { "usubstr", USUBSTR }, // 832 - { "usupplementary", USUPPLEMENTARY }, // 833 - { "utility", UTILITY }, // 834 - { "uuid4", UUID4 }, // 835 - { "uvalid", UVALID }, // 836 - { "uwidth", UWIDTH }, // 837 - { "validating", VALIDATING }, // 838 - { "value", VALUE }, // 839 - { "variance", VARIANCE }, // 840 - { "varying", VARYING }, // 841 - { "volatile", VOLATILE }, // 842 - { "when-compiled", WHEN_COMPILED }, // 843 - { "with", WITH }, // 844 - { "working-storage", WORKING_STORAGE }, // 845 - { "year-to-yyyy", YEAR_TO_YYYY }, // 846 - { "yyyyddd", YYYYDDD }, // 847 - { "yyyymmdd", YYYYMMDD }, // 848 - { "arithmetic", ARITHMETIC }, // 849 - { "attribute", ATTRIBUTE }, // 850 - { "auto", AUTO }, // 851 - { "automatic", AUTOMATIC }, // 852 - { "away-from-zero", AWAY_FROM_ZERO }, // 853 - { "background-color", BACKGROUND_COLOR }, // 854 - { "bell", BELL }, // 855 - { "binary-encoding", BINARY_ENCODING }, // 856 - { "blink", BLINK }, // 857 - { "capacity", CAPACITY }, // 858 - { "center", CENTER }, // 859 - { "classification", CLASSIFICATION }, // 860 - { "cycle", CYCLE }, // 861 - { "decimal-encoding", DECIMAL_ENCODING }, // 862 - { "entry-convention", ENTRY_CONVENTION }, // 863 - { "eol", EOL }, // 864 - { "eos", EOS }, // 865 - { "erase", ERASE }, // 866 - { "expands", EXPANDS }, // 867 - { "float-binary", FLOAT_BINARY }, // 868 - { "float-decimal", FLOAT_DECIMAL }, // 869 - { "foreground-color", FOREGROUND_COLOR }, // 870 - { "forever", FOREVER }, // 871 - { "full", FULL }, // 872 - { "highlight", HIGHLIGHT }, // 873 - { "high-order-left", HIGH_ORDER_LEFT }, // 874 - { "high-order-right", HIGH_ORDER_RIGHT }, // 875 - { "ignoring", IGNORING }, // 876 - { "implements", IMPLEMENTS }, // 877 - { "initialized", INITIALIZED }, // 878 - { "intermediate", INTERMEDIATE }, // 879 - { "lc-all", LC_ALL_kw }, // 880 - { "lc-collate", LC_COLLATE_kw }, // 881 - { "lc-ctype", LC_CTYPE_kw }, // 882 - { "lc-messages", LC_MESSAGES_kw }, // 883 - { "lc-monetary", LC_MONETARY_kw }, // 884 - { "lc-numeric", LC_NUMERIC_kw }, // 885 - { "lc-time", LC_TIME_kw }, // 886 - { "lowlight", LOWLIGHT }, // 887 - { "nearest-away-from-zero", NEAREST_AWAY_FROM_ZERO }, // 888 - { "nearest-even", NEAREST_EVEN }, // 889 - { "nearest-toward-zero", NEAREST_TOWARD_ZERO }, // 890 - { "none", NONE }, // 891 - { "normal", NORMAL }, // 892 - { "numbers", NUMBERS }, // 893 - { "prefixed", PREFIXED }, // 894 - { "previous", PREVIOUS }, // 895 - { "prohibited", PROHIBITED }, // 896 - { "relation", RELATION }, // 897 - { "required", REQUIRED }, // 898 - { "reverse-video", REVERSE_VIDEO }, // 899 - { "rounding", ROUNDING }, // 900 - { "seconds", SECONDS }, // 901 - { "secure", SECURE }, // 902 - { "short", SHORT }, // 903 - { "signed", SIGNED_kw }, // 904 - { "standard-binary", STANDARD_BINARY }, // 905 - { "standard-decimal", STANDARD_DECIMAL }, // 906 - { "statement", STATEMENT }, // 907 - { "step", STEP }, // 908 - { "structure", STRUCTURE }, // 909 - { "toward-greater", TOWARD_GREATER }, // 910 - { "toward-lesser", TOWARD_LESSER }, // 911 - { "truncation", TRUNCATION }, // 912 - { "ucs-4", UCS_4 }, // 913 - { "underline", UNDERLINE }, // 914 - { "unsigned", UNSIGNED_kw }, // 915 - { "utf-16", UTF_16 }, // 916 - { "utf-8", UTF_8 }, // 917 - { "address", ADDRESS }, // 918 - { "end-accept", END_ACCEPT }, // 919 - { "end-add", END_ADD }, // 920 - { "end-call", END_CALL }, // 921 - { "end-compute", END_COMPUTE }, // 922 - { "end-delete", END_DELETE }, // 923 - { "end-display", END_DISPLAY }, // 924 - { "end-divide", END_DIVIDE }, // 925 - { "end-evaluate", END_EVALUATE }, // 926 - { "end-multiply", END_MULTIPLY }, // 927 - { "end-perform", END_PERFORM }, // 928 - { "end-read", END_READ }, // 929 - { "end-return", END_RETURN }, // 930 - { "end-rewrite", END_REWRITE }, // 931 - { "end-search", END_SEARCH }, // 932 - { "end-start", END_START }, // 933 - { "end-string", END_STRING }, // 934 - { "end-subtract", END_SUBTRACT }, // 935 - { "end-unstring", END_UNSTRING }, // 936 - { "end-write", END_WRITE }, // 937 - { "end-xml", END_XML }, // 938 - { "end-if", END_IF }, // 939 - { "xmlgenerate", XMLGENERATE }, // 940 - { "xmlparse", XMLPARSE }, // 942 - { "attributes", ATTRIBUTES }, // 944 - { "element", ELEMENT }, // 945 - { "namespace", NAMESPACE }, // 946 - { "namespace-prefix", NAMESPACE_PREFIX }, // 947 - { "nonnumeric", NONNUMERIC }, // 949 - { "xml-declaration", XML_DECLARATION }, // 950 - { "thru", THRU }, // 952 - { "through", THRU }, // 952 - { "or", OR }, // 953 - { "and", AND }, // 954 - { "not", NOT }, // 955 - { "ne", NE }, // 956 - { "le", LE }, // 957 - { "ge", GE }, // 958 - { "pow", POW }, // 959 - { "neg", NEG }, // 960 + { "tallying", TALLYING }, // 793 + { "tan", TAN }, // 794 + { "terminate", TERMINATE }, // 795 + { "test", TEST }, // 796 + { "test-date-yyyymmdd", TEST_DATE_YYYYMMDD }, // 797 + { "test-day-yyyyddd", TEST_DAY_YYYYDDD }, // 798 + { "test-formatted-datetime", TEST_FORMATTED_DATETIME }, // 799 + { "test-numval", TEST_NUMVAL }, // 800 + { "test-numval-c", TEST_NUMVAL_C }, // 801 + { "test-numval-f", TEST_NUMVAL_F }, // 802 + { "than", THAN }, // 803 + { "time", TIME }, // 804 + { "times", TIMES }, // 805 + { "to", TO }, // 806 + { "top", TOP }, // 807 + { "top-level", TOP_LEVEL }, // 808 + { "tracks", TRACKS }, // 809 + { "track-area", TRACK_AREA }, // 810 + { "trailing", TRAILING }, // 811 + { "transform", TRANSFORM }, // 812 + { "trim", TRIM }, // 813 + { "true", TRUE_kw }, // 814 + { "try", TRY }, // 815 + { "turn", TURN }, // 816 + { "type", TYPE }, // 817 + { "typedef", TYPEDEF }, // 818 + { "ulength", ULENGTH }, // 819 + { "unbounded", UNBOUNDED }, // 820 + { "unit", UNIT }, // 821 + { "units", UNITS }, // 822 + { "unit-record", UNIT_RECORD }, // 823 + { "until", UNTIL }, // 824 + { "up", UP }, // 825 + { "upon", UPON }, // 826 + { "upos", UPOS }, // 827 + { "upper-case", UPPER_CASE }, // 828 + { "usage", USAGE }, // 829 + { "using", USING }, // 830 + { "usubstr", USUBSTR }, // 831 + { "usupplementary", USUPPLEMENTARY }, // 832 + { "utility", UTILITY }, // 833 + { "uuid4", UUID4 }, // 834 + { "uvalid", UVALID }, // 835 + { "uwidth", UWIDTH }, // 836 + { "validating", VALIDATING }, // 837 + { "value", VALUE }, // 838 + { "variance", VARIANCE }, // 839 + { "varying", VARYING }, // 840 + { "volatile", VOLATILE }, // 841 + { "when-compiled", WHEN_COMPILED }, // 842 + { "with", WITH }, // 843 + { "working-storage", WORKING_STORAGE }, // 844 + { "year-to-yyyy", YEAR_TO_YYYY }, // 845 + { "yyyyddd", YYYYDDD }, // 846 + { "yyyymmdd", YYYYMMDD }, // 847 + { "arithmetic", ARITHMETIC }, // 848 + { "attribute", ATTRIBUTE }, // 849 + { "auto", AUTO }, // 850 + { "automatic", AUTOMATIC }, // 851 + { "away-from-zero", AWAY_FROM_ZERO }, // 852 + { "background-color", BACKGROUND_COLOR }, // 853 + { "bell", BELL }, // 854 + { "binary-encoding", BINARY_ENCODING }, // 855 + { "blink", BLINK }, // 856 + { "capacity", CAPACITY }, // 857 + { "center", CENTER }, // 858 + { "classification", CLASSIFICATION }, // 859 + { "cycle", CYCLE }, // 860 + { "decimal-encoding", DECIMAL_ENCODING }, // 861 + { "entry-convention", ENTRY_CONVENTION }, // 862 + { "eol", EOL }, // 863 + { "eos", EOS }, // 864 + { "erase", ERASE }, // 865 + { "expands", EXPANDS }, // 866 + { "float-binary", FLOAT_BINARY }, // 867 + { "float-decimal", FLOAT_DECIMAL }, // 868 + { "foreground-color", FOREGROUND_COLOR }, // 869 + { "forever", FOREVER }, // 870 + { "full", FULL }, // 871 + { "highlight", HIGHLIGHT }, // 872 + { "high-order-left", HIGH_ORDER_LEFT }, // 873 + { "high-order-right", HIGH_ORDER_RIGHT }, // 874 + { "ignoring", IGNORING }, // 875 + { "implements", IMPLEMENTS }, // 876 + { "initialized", INITIALIZED }, // 877 + { "intermediate", INTERMEDIATE }, // 878 + { "lc-all", LC_ALL_kw }, // 879 + { "lc-collate", LC_COLLATE_kw }, // 880 + { "lc-ctype", LC_CTYPE_kw }, // 881 + { "lc-messages", LC_MESSAGES_kw }, // 882 + { "lc-monetary", LC_MONETARY_kw }, // 883 + { "lc-numeric", LC_NUMERIC_kw }, // 884 + { "lc-time", LC_TIME_kw }, // 885 + { "lowlight", LOWLIGHT }, // 886 + { "nearest-away-from-zero", NEAREST_AWAY_FROM_ZERO }, // 887 + { "nearest-even", NEAREST_EVEN }, // 888 + { "nearest-toward-zero", NEAREST_TOWARD_ZERO }, // 889 + { "none", NONE }, // 890 + { "normal", NORMAL }, // 891 + { "numbers", NUMBERS }, // 892 + { "prefixed", PREFIXED }, // 893 + { "previous", PREVIOUS }, // 894 + { "prohibited", PROHIBITED }, // 895 + { "relation", RELATION }, // 896 + { "required", REQUIRED }, // 897 + { "reverse-video", REVERSE_VIDEO }, // 898 + { "rounding", ROUNDING }, // 899 + { "seconds", SECONDS }, // 900 + { "secure", SECURE }, // 901 + { "short", SHORT }, // 902 + { "signed", SIGNED_kw }, // 903 + { "standard-binary", STANDARD_BINARY }, // 904 + { "standard-decimal", STANDARD_DECIMAL }, // 905 + { "statement", STATEMENT }, // 906 + { "step", STEP }, // 907 + { "structure", STRUCTURE }, // 908 + { "toward-greater", TOWARD_GREATER }, // 909 + { "toward-lesser", TOWARD_LESSER }, // 910 + { "truncation", TRUNCATION }, // 911 + { "ucs-4", UCS_4 }, // 912 + { "underline", UNDERLINE }, // 913 + { "unsigned", UNSIGNED_kw }, // 914 + { "utf-16", UTF_16 }, // 915 + { "utf-8", UTF_8 }, // 916 + { "xmlgenerate", XMLGENERATE }, // 917 + { "xmlparse", XMLPARSE }, // 918 + { "address", ADDRESS }, // 919 + { "end-accept", END_ACCEPT }, // 920 + { "end-add", END_ADD }, // 921 + { "end-call", END_CALL }, // 922 + { "end-compute", END_COMPUTE }, // 923 + { "end-delete", END_DELETE }, // 924 + { "end-display", END_DISPLAY }, // 925 + { "end-divide", END_DIVIDE }, // 926 + { "end-evaluate", END_EVALUATE }, // 927 + { "end-multiply", END_MULTIPLY }, // 928 + { "end-perform", END_PERFORM }, // 929 + { "end-read", END_READ }, // 930 + { "end-return", END_RETURN }, // 931 + { "end-rewrite", END_REWRITE }, // 932 + { "end-search", END_SEARCH }, // 933 + { "end-start", END_START }, // 934 + { "end-string", END_STRING }, // 935 + { "end-subtract", END_SUBTRACT }, // 936 + { "end-unstring", END_UNSTRING }, // 937 + { "end-write", END_WRITE }, // 938 + { "end-xml", END_XML }, // 939 + { "end-if", END_IF }, // 940 + { "attributes", ATTRIBUTES }, // 941 + { "element", ELEMENT }, // 942 + { "namespace", NAMESPACE }, // 943 + { "namespace-prefix", NAMESPACE_PREFIX }, // 944 + { "nonnumeric", NONNUMERIC }, // 946 + { "xml-declaration", XML_DECLARATION }, // 947 + { "thru", THRU }, // 949 + { "through", THRU }, // 949 + { "or", OR }, // 950 + { "and", AND }, // 951 + { "not", NOT }, // 952 + { "ne", NE }, // 953 + { "le", LE }, // 954 + { "ge", GE }, // 955 + { "pow", POW }, // 956 + { "neg", NEG }, // 957 }; // cppcheck-suppress useInitializationList @@ -1245,168 +1244,167 @@ token_names = { "SYMBOL", // 532 (790) "SYMBOLIC", // 533 (791) "SYNCHRONIZED", // 534 (792) - "TALLY", // 535 (793) - "TALLYING", // 536 (794) - "TAN", // 537 (795) - "TERMINATE", // 538 (796) - "TEST", // 539 (797) - "TEST-DATE-YYYYMMDD", // 540 (798) - "TEST-DAY-YYYYDDD", // 541 (799) - "TEST-FORMATTED-DATETIME", // 542 (800) - "TEST-NUMVAL", // 543 (801) - "TEST-NUMVAL-C", // 544 (802) - "TEST-NUMVAL-F", // 545 (803) - "THAN", // 546 (804) - "TIME", // 547 (805) - "TIMES", // 548 (806) - "TO", // 549 (807) - "TOP", // 550 (808) - "TOP-LEVEL", // 551 (809) - "TRACKS", // 552 (810) - "TRACK-AREA", // 553 (811) - "TRAILING", // 554 (812) - "TRANSFORM", // 555 (813) - "TRIM", // 556 (814) - "TRUE", // 557 (815) - "TRY", // 558 (816) - "TURN", // 559 (817) - "TYPE", // 560 (818) - "TYPEDEF", // 561 (819) - "ULENGTH", // 562 (820) - "UNBOUNDED", // 563 (821) - "UNIT", // 564 (822) - "UNITS", // 565 (823) - "UNIT-RECORD", // 566 (824) - "UNTIL", // 567 (825) - "UP", // 568 (826) - "UPON", // 569 (827) - "UPOS", // 570 (828) - "UPPER-CASE", // 571 (829) - "USAGE", // 572 (830) - "USING", // 573 (831) - "USUBSTR", // 574 (832) - "USUPPLEMENTARY", // 575 (833) - "UTILITY", // 576 (834) - "UUID4", // 577 (835) - "UVALID", // 578 (836) - "UWIDTH", // 579 (837) - "VALIDATING", // 580 (838) - "VALUE", // 581 (839) - "VARIANCE", // 582 (840) - "VARYING", // 583 (841) - "VOLATILE", // 584 (842) - "WHEN-COMPILED", // 585 (843) - "WITH", // 586 (844) - "WORKING-STORAGE", // 587 (845) - "YEAR-TO-YYYY", // 588 (846) - "YYYYDDD", // 589 (847) - "YYYYMMDD", // 590 (848) - "ARITHMETIC", // 591 (849) - "ATTRIBUTE", // 592 (850) - "AUTO", // 593 (851) - "AUTOMATIC", // 594 (852) - "AWAY-FROM-ZERO", // 595 (853) - "BACKGROUND-COLOR", // 596 (854) - "BELL", // 597 (855) - "BINARY-ENCODING", // 598 (856) - "BLINK", // 599 (857) - "CAPACITY", // 600 (858) - "CENTER", // 601 (859) - "CLASSIFICATION", // 602 (860) - "CYCLE", // 603 (861) - "DECIMAL-ENCODING", // 604 (862) - "ENTRY-CONVENTION", // 605 (863) - "EOL", // 606 (864) - "EOS", // 607 (865) - "ERASE", // 608 (866) - "EXPANDS", // 609 (867) - "FLOAT-BINARY", // 610 (868) - "FLOAT-DECIMAL", // 611 (869) - "FOREGROUND-COLOR", // 612 (870) - "FOREVER", // 613 (871) - "FULL", // 614 (872) - "HIGHLIGHT", // 615 (873) - "HIGH-ORDER-LEFT", // 616 (874) - "HIGH-ORDER-RIGHT", // 617 (875) - "IGNORING", // 618 (876) - "IMPLEMENTS", // 619 (877) - "INITIALIZED", // 620 (878) - "INTERMEDIATE", // 621 (879) - "LC-ALL", // 622 (880) - "LC-COLLATE", // 623 (881) - "LC-CTYPE", // 624 (882) - "LC-MESSAGES", // 625 (883) - "LC-MONETARY", // 626 (884) - "LC-NUMERIC", // 627 (885) - "LC-TIME", // 628 (886) - "LOWLIGHT", // 629 (887) - "NEAREST-AWAY-FROM-ZERO", // 630 (888) - "NEAREST-EVEN", // 631 (889) - "NEAREST-TOWARD-ZERO", // 632 (890) - "NONE", // 633 (891) - "NORMAL", // 634 (892) - "NUMBERS", // 635 (893) - "PREFIXED", // 636 (894) - "PREVIOUS", // 637 (895) - "PROHIBITED", // 638 (896) - "RELATION", // 639 (897) - "REQUIRED", // 640 (898) - "REVERSE-VIDEO", // 641 (899) - "ROUNDING", // 642 (900) - "SECONDS", // 643 (901) - "SECURE", // 644 (902) - "SHORT", // 645 (903) - "SIGNED", // 646 (904) - "STANDARD-BINARY", // 647 (905) - "STANDARD-DECIMAL", // 648 (906) - "STATEMENT", // 649 (907) - "STEP", // 650 (908) - "STRUCTURE", // 651 (909) - "TOWARD-GREATER", // 652 (910) - "TOWARD-LESSER", // 653 (911) - "TRUNCATION", // 654 (912) - "UCS-4", // 655 (913) - "UNDERLINE", // 656 (914) - "UNSIGNED", // 657 (915) - "UTF-16", // 658 (916) - "UTF-8", // 659 (917) - "ADDRESS", // 660 (918) - "END-ACCEPT", // 661 (919) - "END-ADD", // 662 (920) - "END-CALL", // 663 (921) - "END-COMPUTE", // 664 (922) - "END-DELETE", // 665 (923) - "END-DISPLAY", // 666 (924) - "END-DIVIDE", // 667 (925) - "END-EVALUATE", // 668 (926) - "END-MULTIPLY", // 669 (927) - "END-PERFORM", // 670 (928) - "END-READ", // 671 (929) - "END-RETURN", // 672 (930) - "END-REWRITE", // 673 (931) - "END-SEARCH", // 674 (932) - "END-START", // 675 (933) - "END-STRING", // 676 (934) - "END-SUBTRACT", // 677 (935) - "END-UNSTRING", // 678 (936) - "END-WRITE", // 679 (937) - "END-XML", // 680 (938) - "END-IF", // 681 (939) - "XMLGENERATE", // 682 (940) - "XMLPARSE", // 684 (942) - "ATTRIBUTES", // 686 (944) - "ELEMENT", // 687 (945) - "NAMESPACE", // 688 (946) - "NAMESPACE-PREFIX", // 689 (947) - "NONNUMERIC", // 691 (949) - "XML-DECLARATION", // 692 (950) - "THRU", // 694 (952) - "OR", // 695 (953) - "AND", // 696 (954) - "NOT", // 697 (955) - "NE", // 698 (956) - "LE", // 699 (957) - "GE", // 700 (958) - "POW", // 701 (959) - "NEG", // 702 (960) + "TALLYING", // 535 (793) + "TAN", // 536 (794) + "TERMINATE", // 537 (795) + "TEST", // 538 (796) + "TEST-DATE-YYYYMMDD", // 539 (797) + "TEST-DAY-YYYYDDD", // 540 (798) + "TEST-FORMATTED-DATETIME", // 541 (799) + "TEST-NUMVAL", // 542 (800) + "TEST-NUMVAL-C", // 543 (801) + "TEST-NUMVAL-F", // 544 (802) + "THAN", // 545 (803) + "TIME", // 546 (804) + "TIMES", // 547 (805) + "TO", // 548 (806) + "TOP", // 549 (807) + "TOP-LEVEL", // 550 (808) + "TRACKS", // 551 (809) + "TRACK-AREA", // 552 (810) + "TRAILING", // 553 (811) + "TRANSFORM", // 554 (812) + "TRIM", // 555 (813) + "TRUE", // 556 (814) + "TRY", // 557 (815) + "TURN", // 558 (816) + "TYPE", // 559 (817) + "TYPEDEF", // 560 (818) + "ULENGTH", // 561 (819) + "UNBOUNDED", // 562 (820) + "UNIT", // 563 (821) + "UNITS", // 564 (822) + "UNIT-RECORD", // 565 (823) + "UNTIL", // 566 (824) + "UP", // 567 (825) + "UPON", // 568 (826) + "UPOS", // 569 (827) + "UPPER-CASE", // 570 (828) + "USAGE", // 571 (829) + "USING", // 572 (830) + "USUBSTR", // 573 (831) + "USUPPLEMENTARY", // 574 (832) + "UTILITY", // 575 (833) + "UUID4", // 576 (834) + "UVALID", // 577 (835) + "UWIDTH", // 578 (836) + "VALIDATING", // 579 (837) + "VALUE", // 580 (838) + "VARIANCE", // 581 (839) + "VARYING", // 582 (840) + "VOLATILE", // 583 (841) + "WHEN-COMPILED", // 584 (842) + "WITH", // 585 (843) + "WORKING-STORAGE", // 586 (844) + "YEAR-TO-YYYY", // 587 (845) + "YYYYDDD", // 588 (846) + "YYYYMMDD", // 589 (847) + "ARITHMETIC", // 590 (848) + "ATTRIBUTE", // 591 (849) + "AUTO", // 592 (850) + "AUTOMATIC", // 593 (851) + "AWAY-FROM-ZERO", // 594 (852) + "BACKGROUND-COLOR", // 595 (853) + "BELL", // 596 (854) + "BINARY-ENCODING", // 597 (855) + "BLINK", // 598 (856) + "CAPACITY", // 599 (857) + "CENTER", // 600 (858) + "CLASSIFICATION", // 601 (859) + "CYCLE", // 602 (860) + "DECIMAL-ENCODING", // 603 (861) + "ENTRY-CONVENTION", // 604 (862) + "EOL", // 605 (863) + "EOS", // 606 (864) + "ERASE", // 607 (865) + "EXPANDS", // 608 (866) + "FLOAT-BINARY", // 609 (867) + "FLOAT-DECIMAL", // 610 (868) + "FOREGROUND-COLOR", // 611 (869) + "FOREVER", // 612 (870) + "FULL", // 613 (871) + "HIGHLIGHT", // 614 (872) + "HIGH-ORDER-LEFT", // 615 (873) + "HIGH-ORDER-RIGHT", // 616 (874) + "IGNORING", // 617 (875) + "IMPLEMENTS", // 618 (876) + "INITIALIZED", // 619 (877) + "INTERMEDIATE", // 620 (878) + "LC-ALL", // 621 (879) + "LC-COLLATE", // 622 (880) + "LC-CTYPE", // 623 (881) + "LC-MESSAGES", // 624 (882) + "LC-MONETARY", // 625 (883) + "LC-NUMERIC", // 626 (884) + "LC-TIME", // 627 (885) + "LOWLIGHT", // 628 (886) + "NEAREST-AWAY-FROM-ZERO", // 629 (887) + "NEAREST-EVEN", // 630 (888) + "NEAREST-TOWARD-ZERO", // 631 (889) + "NONE", // 632 (890) + "NORMAL", // 633 (891) + "NUMBERS", // 634 (892) + "PREFIXED", // 635 (893) + "PREVIOUS", // 636 (894) + "PROHIBITED", // 637 (895) + "RELATION", // 638 (896) + "REQUIRED", // 639 (897) + "REVERSE-VIDEO", // 640 (898) + "ROUNDING", // 641 (899) + "SECONDS", // 642 (900) + "SECURE", // 643 (901) + "SHORT", // 644 (902) + "SIGNED", // 645 (903) + "STANDARD-BINARY", // 646 (904) + "STANDARD-DECIMAL", // 647 (905) + "STATEMENT", // 648 (906) + "STEP", // 649 (907) + "STRUCTURE", // 650 (908) + "TOWARD-GREATER", // 651 (909) + "TOWARD-LESSER", // 652 (910) + "TRUNCATION", // 653 (911) + "UCS-4", // 654 (912) + "UNDERLINE", // 655 (913) + "UNSIGNED", // 656 (914) + "UTF-16", // 657 (915) + "UTF-8", // 658 (916) + "XMLGENERATE", // 659 (917) + "XMLPARSE", // 660 (918) + "ADDRESS", // 661 (919) + "END-ACCEPT", // 662 (920) + "END-ADD", // 663 (921) + "END-CALL", // 664 (922) + "END-COMPUTE", // 665 (923) + "END-DELETE", // 666 (924) + "END-DISPLAY", // 667 (925) + "END-DIVIDE", // 668 (926) + "END-EVALUATE", // 669 (927) + "END-MULTIPLY", // 670 (928) + "END-PERFORM", // 671 (929) + "END-READ", // 672 (930) + "END-RETURN", // 673 (931) + "END-REWRITE", // 674 (932) + "END-SEARCH", // 675 (933) + "END-START", // 676 (934) + "END-STRING", // 677 (935) + "END-SUBTRACT", // 678 (936) + "END-UNSTRING", // 679 (937) + "END-WRITE", // 680 (938) + "END-XML", // 681 (939) + "END-IF", // 682 (940) + "ATTRIBUTES", // 683 (941) + "ELEMENT", // 684 (942) + "NAMESPACE", // 685 (943) + "NAMESPACE-PREFIX", // 686 (944) + "NONNUMERIC", // 688 (946) + "XML-DECLARATION", // 689 (947) + "THRU", // 691 (949) + "OR", // 692 (950) + "AND", // 693 (951) + "NOT", // 694 (952) + "NE", // 695 (953) + "LE", // 696 (954) + "GE", // 697 (955) + "POW", // 698 (956) + "NEG", // 699 (957) }; diff --git a/gcc/cobol/util.cc b/gcc/cobol/util.cc index d3a4b01..9615987 100644 --- a/gcc/cobol/util.cc +++ b/gcc/cobol/util.cc @@ -2107,28 +2107,35 @@ void current_location_minus_one_clear() first_line_minus_1 = 0; } +/* + * Update global token_location with a location_t expressing a source range + * with start and caret at the first line/column of LOC, and finishing at the + * last line/column of LOC. + */ template <typename LOC> static void gcc_location_set_impl( const LOC& loc ) { // Set the position to the first line & column in the location. static location_t loc_m_1 = 0; - - token_location = linemap_line_start( line_table, loc.first_line, 80 ); - token_location = linemap_position_for_column( line_table, loc.first_column); - - if( loc.first_line > first_line_minus_1 ) - { - // In order for GDB-COBOL to be able to step through COBOL code properly, - // it is sometimes necessary for the code at the beginning of a COBOL - // line to be using the location_t of the previous line. This is true, for - // example, when laying down the infrastructure code between the last - // statement of a paragraph and the code created at the beginning of the - // following paragragh. This code assumes that token_location values of - // interest are monotonic, and stores that prior value. - first_line_minus_1 = loc.first_line; - token_location_minus_1 = loc_m_1; - loc_m_1 = token_location; - } + const location_t + start_line = linemap_line_start( line_table, loc.first_line, 80 ), + token_start = linemap_position_for_column( line_table, loc.first_column), + finish_line = linemap_line_start( line_table, loc.last_line, 80 ), + token_finish = linemap_position_for_column( line_table, loc.last_column); + token_location = make_location (token_start, token_start, token_finish); + + if( loc.first_line > first_line_minus_1 ) { + // In order for GDB-COBOL to be able to step through COBOL code properly, + // it is sometimes necessary for the code at the beginning of a COBOL + // line to be using the location_t of the previous line. This is true, for + // example, when laying down the infrastructure code between the last + // statement of a paragraph and the code created at the beginning of the + // following paragragh. This code assumes that token_location values of + // interest are monotonic, and stores that prior value. + first_line_minus_1 = loc.first_line; + token_location_minus_1 = loc_m_1; + loc_m_1 = token_location; + } location_dump(__func__, __LINE__, "parser", loc); } diff --git a/gcc/config/aarch64/aarch64-c.cc b/gcc/config/aarch64/aarch64-c.cc index a8ff58e..c3957c7 100644 --- a/gcc/config/aarch64/aarch64-c.cc +++ b/gcc/config/aarch64/aarch64-c.cc @@ -296,6 +296,10 @@ aarch64_update_cpp_builtins (cpp_reader *pfile) "__ARM_FEATURE_SME2p1", pfile); aarch64_def_or_undef (TARGET_FAMINMAX, "__ARM_FEATURE_FAMINMAX", pfile); + // Function multi-versioning defines + aarch64_def_or_undef (targetm.has_ifunc_p (), + "__HAVE_FUNCTION_MULTI_VERSIONING", pfile); + /* Not for ACLE, but required to keep "float.h" correct if we switch target between implementations that do or do not support ARMv8.2-A 16-bit floating-point extensions. */ diff --git a/gcc/config/aarch64/aarch64.cc b/gcc/config/aarch64/aarch64.cc index b860641..6f6dea6 100644 --- a/gcc/config/aarch64/aarch64.cc +++ b/gcc/config/aarch64/aarch64.cc @@ -20607,14 +20607,8 @@ static int compare_feature_masks (aarch64_fmv_feature_mask mask1, aarch64_fmv_feature_mask mask2) { - int pop1 = popcount_hwi (mask1); - int pop2 = popcount_hwi (mask2); - if (pop1 > pop2) - return 1; - if (pop2 > pop1) - return -1; - auto diff_mask = mask1 ^ mask2; + /* If there is no difference. */ if (diff_mask == 0ULL) return 0; int num_features = ARRAY_SIZE (aarch64_fmv_feature_data); @@ -21029,45 +21023,16 @@ dispatch_function_versions (tree dispatch_decl, unsigned int num_versions = fndecls->length (); gcc_assert (num_versions >= 2); - struct function_version_info - { - tree version_decl; - aarch64_fmv_feature_mask feature_mask; - } *function_versions; - - function_versions = (struct function_version_info *) - XNEWVEC (struct function_version_info, (num_versions)); - - unsigned int actual_versions = 0; - - for (tree version_decl : *fndecls) + int i; + tree version_decl; + FOR_EACH_VEC_ELT_REVERSE ((*fndecls), i, version_decl) { - aarch64_fmv_feature_mask feature_mask; - /* Get attribute string, parse it and find the right features. */ - feature_mask = get_feature_mask_for_version (version_decl); - function_versions [actual_versions].version_decl = version_decl; - function_versions [actual_versions].feature_mask = feature_mask; - actual_versions++; + aarch64_fmv_feature_mask feature_mask + = get_feature_mask_for_version (version_decl); + *empty_bb = add_condition_to_bb (dispatch_decl, version_decl, + feature_mask, mask_var, *empty_bb); } - auto compare_feature_version_info = [](const void *p1, const void *p2) { - const function_version_info v1 = *(const function_version_info *)p1; - const function_version_info v2 = *(const function_version_info *)p2; - return - compare_feature_masks (v1.feature_mask, v2.feature_mask); - }; - - /* Sort the versions according to descending order of dispatch priority. */ - qsort (function_versions, actual_versions, - sizeof (struct function_version_info), compare_feature_version_info); - - for (unsigned int i = 0; i < actual_versions; ++i) - *empty_bb = add_condition_to_bb (dispatch_decl, - function_versions[i].version_decl, - function_versions[i].feature_mask, - mask_var, - *empty_bb); - - free (function_versions); return 0; } @@ -21109,6 +21074,9 @@ aarch64_generate_version_dispatcher_body (void *node_p) auto_vec<tree, 2> fn_ver_vec; + if (dump_enabled_p ()) + dump_printf (MSG_NOTE, "Version order for %s:\n", node->dump_asm_name ()); + for (versn_info = node_version_info->next; versn_info; versn_info = versn_info->next) { @@ -21121,6 +21089,9 @@ aarch64_generate_version_dispatcher_body (void *node_p) if (DECL_VINDEX (versn->decl)) sorry ("virtual function multiversioning not supported"); + if (dump_enabled_p ()) + dump_printf (MSG_NOTE, "%s\n", versn->dump_asm_name ()); + fn_ver_vec.safe_push (versn->decl); } diff --git a/gcc/config/i386/sse.md b/gcc/config/i386/sse.md index b1918c4..5eba992 100644 --- a/gcc/config/i386/sse.md +++ b/gcc/config/i386/sse.md @@ -569,6 +569,18 @@ (V16SI "TARGET_AVX512F") (V8SI "TARGET_AVX2") V4SI (V8DI "TARGET_AVX512F") (V4DI "TARGET_AVX2") V2DI]) +(define_mode_iterator VI_AVX + [(V32QI "TARGET_AVX") V16QI + (V16HI "TARGET_AVX") V8HI + (V8SI "TARGET_AVX") V4SI + (V4DI "TARGET_AVX") V2DI]) + +(define_mode_iterator VI_AVX2_CMP + [(V32QI "TARGET_AVX2") V16QI + (V16HI "TARGET_AVX2") V8HI + (V8SI "TARGET_AVX2") V4SI + (V4DI "TARGET_AVX2") V2DI]) + (define_mode_iterator VI_AVX_AVX512F [(V64QI "TARGET_AVX512F") (V32QI "TARGET_AVX") V16QI (V32HI "TARGET_AVX512F") (V16HI "TARGET_AVX") V8HI @@ -896,7 +908,8 @@ (define_mode_attr ssebytemode [(V8DI "V64QI") (V4DI "V32QI") (V2DI "V16QI") (V16SI "V64QI") (V8SI "V32QI") (V4SI "V16QI") - (V8HI "V16QI")]) + (V16HI "V32QI") (V8HI "V16QI") + (V32QI "V32QI") (V16QI "V16QI")]) (define_mode_attr sseintconvert [(V32HI "w") (V16HI "w") (V8HI "w") @@ -4095,6 +4108,88 @@ DONE; }) +(define_expand "reduc_sbool_and_scal_<mode>" + [(match_operand:QI 0 "register_operand") + (match_operand:VI_AVX 1 "register_operand")] + "TARGET_SSE4_1" +{ + rtx flags = gen_rtx_REG (CCZmode, FLAGS_REG); + rtx op2, tmp; + if (TARGET_AVX2 || <MODE_SIZE> != 32) + { + op2 = force_reg (<MODE>mode, CONST0_RTX (<MODE>mode)); + tmp = gen_reg_rtx (<MODE>mode); + rtx op1 = gen_rtx_EQ (<MODE>mode, operands[1], op2); + emit_insn (gen_vec_cmp<mode><mode> (tmp, op1, operands[1], op2)); + } + else + { + op2 = force_reg (<MODE>mode, CONSTM1_RTX (<MODE>mode)); + tmp = gen_reg_rtx (<MODE>mode); + rtx ops[3] = { tmp, operands[1], op2 }; + ix86_expand_vector_logical_operator (XOR, <MODE>mode, ops); + } + + tmp = gen_rtx_UNSPEC (CCZmode, gen_rtvec(2, tmp, tmp), UNSPEC_PTEST); + emit_insn (gen_rtx_SET (flags, tmp)); + rtx ret = gen_rtx_fmt_ee (EQ, VOIDmode, flags, const0_rtx); + PUT_MODE (ret, QImode); + emit_insn (gen_rtx_SET (operands[0], ret)); + DONE; + +}) + +(define_expand "reduc_sbool_ior_scal_<mode>" + [(match_operand:QI 0 "register_operand") + (match_operand:VI_AVX 1 "register_operand")] + "TARGET_SSE4_1" +{ + rtx flags = gen_rtx_REG (CCZmode, FLAGS_REG); + rtx tmp = gen_rtx_UNSPEC (CCZmode, gen_rtvec(2, operands[1], operands[1]), UNSPEC_PTEST); + emit_insn (gen_rtx_SET (flags, tmp)); + rtx ret = gen_rtx_fmt_ee (NE, VOIDmode, flags, const0_rtx); + PUT_MODE (ret, QImode); + emit_insn (gen_rtx_SET (operands[0], ret)); + DONE; +}) + +(define_expand "reduc_sbool_xor_scal_<mode>" + [(match_operand:QI 0 "register_operand") + (match_operand:VI1_AVX2 1 "register_operand")] + "TARGET_SSE2 && TARGET_POPCNT" +{ + rtx popcnt1 = gen_reg_rtx (SImode); + emit_insn (gen_<sse2_avx2>_pmovmskb (popcnt1,operands[1])); + + emit_insn (gen_popcountsi2 (popcnt1, popcnt1)); + emit_insn (gen_andsi3 (popcnt1, popcnt1, GEN_INT (0x1))); + + emit_move_insn (operands[0], gen_lowpart (QImode, popcnt1)); + DONE; +}) + +(define_mode_attr ssefltvecmode + [(V2DI "V2DF") (V4DI "V4DF") (V4SI "V4SF") (V8SI "V8SF")]) + +(define_expand "reduc_sbool_xor_scal_<mode>" + [(match_operand:QI 0 "register_operand") + (match_operand:VI48_AVX 1 "register_operand")] + "TARGET_SSE2 && TARGET_POPCNT" +{ + rtx popcnt1 = gen_reg_rtx (SImode); + rtx tmp = gen_rtx_UNSPEC (SImode, gen_rtvec(1, + gen_lowpart (<ssefltvecmode>mode, + operands[1])), + UNSPEC_MOVMSK); + emit_insn (gen_rtx_SET (popcnt1, tmp)); + + emit_insn (gen_popcountsi2 (popcnt1, popcnt1)); + emit_insn (gen_andsi3 (popcnt1, popcnt1, GEN_INT (0x1))); + + emit_move_insn (operands[0], gen_lowpart (QImode, popcnt1)); + DONE; +}) + (define_insn "<mask_codefor>reducep<mode><mask_name><round_saeonly_name>" [(set (match_operand:VFH_AVX512VL 0 "register_operand" "=v") (unspec:VFH_AVX512VL @@ -18084,6 +18179,24 @@ (set_attr "prefix" "vex") (set_attr "mode" "OI")]) +(define_insn_and_split "*eq<mode>3_2_negate" + [(set (match_operand:VI_AVX2_CMP 0 "register_operand") + (eq:VI_AVX2_CMP + (eq:VI_AVX2_CMP + (eq: VI_AVX2_CMP + (match_operand:VI_AVX2_CMP 1 "nonimmediate_operand") + (match_operand:VI_AVX2_CMP 2 "general_operand")) + (match_operand:VI_AVX2_CMP 3 "const0_operand")) + (match_operand:VI_AVX2_CMP 4 "const0_operand")))] + "TARGET_SSE4_1 && ix86_pre_reload_split ()" + "#" + "&& 1" + [(set (match_dup 0) + (eq:VI_AVX2_CMP (match_dup 1) + (match_dup 5)))] + "operands[5] = force_reg (<MODE>mode, operands[2]);") + + (define_insn_and_split "*avx2_pcmp<mode>3_1" [(set (match_operand:VI_128_256 0 "register_operand") (vec_merge:VI_128_256 @@ -23774,9 +23887,6 @@ (set_attr "btver2_decode" "vector,vector,vector") (set_attr "mode" "<MODE>")]) -(define_mode_attr ssefltvecmode - [(V2DI "V2DF") (V4DI "V4DF") (V4SI "V4SF") (V8SI "V8SF")]) - (define_insn_and_split "*<sse4_1>_blendv<ssefltmodesuffix><avxsizesuffix>_ltint" [(set (match_operand:<ssebytemode> 0 "register_operand" "=Yr,*x,x") (unspec:<ssebytemode> @@ -25591,6 +25701,36 @@ (match_dup 0) (pc)))]) + +;; (unspec:ccz [(eq (eq op0 const0) const0)] unspec_ptest) +;; is equal to (unspec:ccz [op0 op0] unspec_ptest). +(define_insn_and_split "*ptest<mode>_ccz" + [(set (reg:CCZ FLAGS_REG) + (unspec:CCZ + [(eq:VI_AVX + (eq:VI_AVX + (match_operand:VI_AVX 0 "vector_operand") + (match_operand:VI_AVX 1 "const0_operand")) + (match_operand:VI_AVX 2 "const0_operand")) + (eq:VI_AVX + (eq:VI_AVX (match_dup 0) (match_dup 1)) + (match_dup 2))] + UNSPEC_PTEST))] + "TARGET_SSE4_1 + && ix86_pre_reload_split ()" + "#" + "&& 1" + [(set (reg:CCZ FLAGS_REG) + (unspec:CCZ + [(match_dup 3) (match_dup 3)] + UNSPEC_PTEST))] +{ + if (MEM_P (operands[0])) + operands[3] = force_reg (<MODE>mode, operands[0]); + else + operands[3] = operands[0]; +}) + (define_expand "nearbyint<mode>2" [(set (match_operand:VFH 0 "register_operand") (unspec:VFH diff --git a/gcc/config/rs6000/vxworks.h b/gcc/config/rs6000/vxworks.h index 13c706b..f4a778d 100644 --- a/gcc/config/rs6000/vxworks.h +++ b/gcc/config/rs6000/vxworks.h @@ -270,6 +270,7 @@ along with GCC; see the file COPYING3. If not see /* Allow code model to be selected. */ #undef TARGET_CMODEL #define TARGET_CMODEL rs6000_current_cmodel +#undef SET_CMODEL #define SET_CMODEL(opt) rs6000_current_cmodel = opt /* For link specs, we leverage the linux configuration bits through diff --git a/gcc/config/xtensa/xtensa.md b/gcc/config/xtensa/xtensa.md index aa64808..374288d 100644 --- a/gcc/config/xtensa/xtensa.md +++ b/gcc/config/xtensa/xtensa.md @@ -190,7 +190,7 @@ [(set (match_operand:SI 0 "register_operand" "=a") (match_operator:SI 4 "addsub_operator" [(ashift:SI (match_operand:SI 1 "register_operand" "r") - (match_operand:SI 3 "addsubx_operand" "i")) + (match_operand:SI 3 "addsubx_operand" "")) (match_operand:SI 2 "register_operand" "r")]))] "TARGET_ADDX" { @@ -270,7 +270,7 @@ (define_insn_and_split "*subsi3_from_const" [(set (match_operand:SI 0 "register_operand" "=a") - (minus:SI (match_operand:SI 1 "const_int_operand" "i") + (minus:SI (match_operand:SI 1 "const_int_operand" "") (match_operand:SI 2 "register_operand" "r")))] "xtensa_simm8 (-INTVAL (operands[1])) || xtensa_simm8x256 (-INTVAL (operands[1]))" @@ -545,8 +545,8 @@ (match_operator:SI 5 "xtensa_sminmax_operator" [(match_operator:SI 4 "xtensa_sminmax_operator" [(match_operand:SI 1 "register_operand" "r") - (match_operand:SI 2 "const_int_operand" "i")]) - (match_operand:SI 3 "const_int_operand" "i")]))] + (match_operand:SI 2 "const_int_operand" "")]) + (match_operand:SI 3 "const_int_operand" "")]))] "TARGET_MINMAX && TARGET_CLAMPS && INTVAL (operands[2]) + INTVAL (operands[3]) == -1 && ((GET_CODE (operands[5]) == SMIN && GET_CODE (operands[4]) == SMAX @@ -747,7 +747,7 @@ (define_insn_and_split "*andsi3_const_pow2_minus_one" [(set (match_operand:SI 0 "register_operand" "=a") (and:SI (match_operand:SI 1 "register_operand" "r") - (match_operand:SI 2 "const_int_operand" "i")))] + (match_operand:SI 2 "const_int_operand" "")))] "IN_RANGE (exact_log2 (INTVAL (operands[2]) + 1), 17, 31)" "#" "&& 1" @@ -771,7 +771,7 @@ (define_insn_and_split "*andsi3_const_negative_pow2" [(set (match_operand:SI 0 "register_operand" "=a") (and:SI (match_operand:SI 1 "register_operand" "r") - (match_operand:SI 2 "const_int_operand" "i")))] + (match_operand:SI 2 "const_int_operand" "")))] "IN_RANGE (exact_log2 (-INTVAL (operands[2])), 12, 31)" "#" "&& 1" @@ -791,7 +791,7 @@ (define_insn_and_split "*andsi3_const_shifted_mask" [(set (match_operand:SI 0 "register_operand" "=a") (and:SI (match_operand:SI 1 "register_operand" "r") - (match_operand:SI 2 "shifted_mask_operand" "i")))] + (match_operand:SI 2 "shifted_mask_operand" "")))] "! xtensa_simm12b (INTVAL (operands[2]))" "#" "&& 1" @@ -868,9 +868,9 @@ (define_insn_and_split "*splice_bits" [(set (match_operand:SI 0 "register_operand" "=a") (ior:SI (and:SI (match_operand:SI 1 "register_operand" "r") - (match_operand:SI 3 "const_int_operand" "i")) + (match_operand:SI 3 "const_int_operand" "")) (and:SI (match_operand:SI 2 "register_operand" "r") - (match_operand:SI 4 "const_int_operand" "i"))))] + (match_operand:SI 4 "const_int_operand" ""))))] "!optimize_debug && optimize && INTVAL (operands[3]) + INTVAL (operands[4]) == -1 @@ -997,8 +997,8 @@ (define_insn "extvsi_internal" [(set (match_operand:SI 0 "register_operand" "=a") (sign_extract:SI (match_operand:SI 1 "register_operand" "r") - (match_operand:SI 2 "sext_fldsz_operand" "i") - (match_operand:SI 3 "lsbitnum_operand" "i")))] + (match_operand:SI 2 "sext_fldsz_operand" "") + (match_operand:SI 3 "lsbitnum_operand" "")))] "TARGET_SEXT" { int fldsz = INTVAL (operands[2]); @@ -1026,8 +1026,8 @@ (define_insn "extzvsi_internal" [(set (match_operand:SI 0 "register_operand" "=a") (zero_extract:SI (match_operand:SI 1 "register_operand" "r") - (match_operand:SI 2 "extui_fldsz_operand" "i") - (match_operand:SI 3 "const_int_operand" "i")))] + (match_operand:SI 2 "extui_fldsz_operand" "") + (match_operand:SI 3 "const_int_operand" "")))] "" { int shift; @@ -1046,8 +1046,8 @@ [(set (match_operand:SI 0 "register_operand" "=a") (and:SI (match_operator:SI 4 "logical_shift_operator" [(match_operand:SI 1 "register_operand" "r") - (match_operand:SI 2 "const_int_operand" "i")]) - (match_operand:SI 3 "const_int_operand" "i")))] + (match_operand:SI 2 "const_int_operand" "")]) + (match_operand:SI 3 "const_int_operand" "")))] "exact_log2 (INTVAL (operands[3])) > 0" "#" "&& 1" @@ -1078,8 +1078,8 @@ (match_operator:SI 5 "addsub_operator" [(and:SI (match_operator:SI 6 "logical_shift_operator" [(match_operand:SI 1 "register_operand" "r0") - (match_operand:SI 3 "const_int_operand" "i")]) - (match_operand:SI 4 "const_int_operand" "i")) + (match_operand:SI 3 "const_int_operand" "")]) + (match_operand:SI 4 "const_int_operand" "")) (match_operand:SI 2 "register_operand" "r")]))] "TARGET_ADDX && IN_RANGE (exact_log2 (INTVAL (operands[4])), 1, 3)" @@ -1108,8 +1108,8 @@ (define_insn "insvsi" [(set (zero_extract:SI (match_operand:SI 0 "register_operand" "+a") - (match_operand:SI 1 "extui_fldsz_operand" "i") - (match_operand:SI 2 "const_int_operand" "i")) + (match_operand:SI 1 "extui_fldsz_operand" "") + (match_operand:SI 2 "const_int_operand" "")) (match_operand:SI 3 "register_operand" "r"))] "TARGET_DEPBITS" { @@ -1430,7 +1430,7 @@ (define_insn "*lsiu" [(set (match_operand:SF 0 "register_operand" "=f") (mem:SF (plus:SI (match_operand:SI 1 "register_operand" "+a") - (match_operand:SI 2 "fpmem_offset_operand" "i")))) + (match_operand:SI 2 "fpmem_offset_operand" "")))) (set (match_dup 1) (plus:SI (match_dup 1) (match_dup 2)))] "TARGET_HARD_FLOAT && !TARGET_HARD_FLOAT_POSTINC" @@ -1445,7 +1445,7 @@ (define_insn "*ssiu" [(set (mem:SF (plus:SI (match_operand:SI 0 "register_operand" "+a") - (match_operand:SI 1 "fpmem_offset_operand" "i"))) + (match_operand:SI 1 "fpmem_offset_operand" ""))) (match_operand:SF 2 "register_operand" "f")) (set (match_dup 0) (plus:SI (match_dup 0) (match_dup 1)))] @@ -1464,7 +1464,7 @@ (mem:SF (match_operand:SI 1 "register_operand" "+a"))) (set (match_dup 1) (plus:SI (match_dup 1) - (match_operand:SI 2 "fpmem_offset_operand" "i")))] + (match_operand:SI 2 "fpmem_offset_operand" "")))] "TARGET_HARD_FLOAT && TARGET_HARD_FLOAT_POSTINC" { if (TARGET_SERIALIZE_VOLATILE && volatile_refs_p (PATTERN (insn))) @@ -1480,7 +1480,7 @@ (match_operand:SF 1 "register_operand" "f")) (set (match_dup 0) (plus:SI (match_dup 0) - (match_operand:SI 2 "fpmem_offset_operand" "i")))] + (match_operand:SI 2 "fpmem_offset_operand" "")))] "TARGET_HARD_FLOAT && TARGET_HARD_FLOAT_POSTINC" { if (TARGET_SERIALIZE_VOLATILE && volatile_refs_p (PATTERN (insn))) @@ -1637,7 +1637,7 @@ [(match_operand:SI 1 "register_operand" "r") (and:SI (ashift:SI (match_operand:SI 2 "register_operand" "r") (const_int 3)) - (match_operand:SI 3 "const_int_operand" "i"))]))] + (match_operand:SI 3 "const_int_operand" ""))]))] "!optimize_debug && optimize && (INTVAL (operands[3]) & 0x1f) == 3 << 3" "#" @@ -1658,7 +1658,7 @@ [(match_operand:SI 1 "register_operand" "r") (neg:SI (and:SI (ashift:SI (match_operand:SI 2 "register_operand" "r") (const_int 3)) - (match_operand:SI 3 "const_int_operand" "i")))]))] + (match_operand:SI 3 "const_int_operand" "")))]))] "!optimize_debug && optimize && (INTVAL (operands[3]) & 0x1f) == 3 << 3" "#" @@ -1732,10 +1732,10 @@ (match_operator:SI 7 "xtensa_bit_join_operator" [(match_operator:SI 5 "logical_shift_operator" [(match_operand:SI 1 "register_operand" "r") - (match_operand:SI 3 "const_int_operand" "i")]) + (match_operand:SI 3 "const_int_operand" "")]) (match_operator:SI 6 "logical_shift_operator" [(match_operand:SI 2 "register_operand" "r") - (match_operand:SI 4 "const_int_operand" "i")])]))] + (match_operand:SI 4 "const_int_operand" "")])]))] "!optimize_debug && optimize && xtensa_shlrd_which_direction (operands[5], operands[6]) != UNKNOWN && IN_RANGE (INTVAL (operands[3]), 1, 31) @@ -1785,7 +1785,7 @@ [(match_operand:SI 1 "register_operand" "r") (and:SI (ashift:SI (match_operand:SI 2 "register_operand" "r") (const_int 3)) - (match_operand:SI 4 "const_int_operand" "i"))]) + (match_operand:SI 4 "const_int_operand" ""))]) (match_operator:SI 6 "logical_shift_operator" [(match_operand:SI 3 "register_operand" "r") (neg:SI (and:SI (ashift:SI (match_dup 2) @@ -2007,7 +2007,7 @@ [(set (pc) (if_then_else (match_operator 3 "boolean_operator" [(and:SI (not:SI (match_operand:SI 0 "register_operand" "r")) - (match_operand:SI 1 "const_int_operand" "i")) + (match_operand:SI 1 "const_int_operand" "")) (const_int 0)]) (label_ref (match_operand 2 "" "")) (pc)))] @@ -2060,8 +2060,8 @@ [(set (pc) (if_then_else (match_operator 4 "boolean_operator" [(and:SI (match_operand:SI 0 "register_operand" "r") - (match_operand:SI 1 "const_int_operand" "i")) - (match_operand:SI 2 "const_int_operand" "i")]) + (match_operand:SI 1 "const_int_operand" "")) + (match_operand:SI 2 "const_int_operand" "")]) (label_ref (match_operand 3 "" "")) (pc)))] "IN_RANGE (exact_log2 (INTVAL (operands[1]) + 1), 17, 31) @@ -2100,8 +2100,8 @@ [(set (pc) (if_then_else (match_operator 4 "boolean_operator" [(and:SI (match_operand:SI 0 "register_operand" "r") - (match_operand:SI 1 "const_int_operand" "i")) - (match_operand:SI 2 "const_int_operand" "i")]) + (match_operand:SI 1 "const_int_operand" "")) + (match_operand:SI 2 "const_int_operand" "")]) (label_ref (match_operand 3 "" "")) (pc)))] "IN_RANGE (exact_log2 (-INTVAL (operands[1])), 1, 30) @@ -2135,8 +2135,8 @@ [(set (pc) (if_then_else (match_operator 4 "boolean_operator" [(and:SI (match_operand:SI 0 "register_operand" "r") - (match_operand:SI 1 "shifted_mask_operand" "i")) - (match_operand:SI 2 "const_int_operand" "i")]) + (match_operand:SI 1 "shifted_mask_operand" "")) + (match_operand:SI 2 "const_int_operand" "")]) (label_ref (match_operand 3 "" "")) (pc)))] "/* (INTVAL (operands[2]) & ((1 << ctz_hwi (INTVAL (operands[1]))) - 1)) == 0 // can be omitted @@ -2516,8 +2516,8 @@ }) (define_insn "call_internal" - [(call (mem (match_operand:SI 0 "call_insn_operand" "nir")) - (match_operand 1 "" "i"))] + [(call (mem (match_operand:SI 0 "call_insn_operand" "ir")) + (match_operand 1 "" ""))] "!SIBLING_CALL_P (insn)" { return xtensa_emit_call (0, operands); @@ -2538,8 +2538,8 @@ (define_insn "call_value_internal" [(set (match_operand 0 "register_operand" "=a") - (call (mem (match_operand:SI 1 "call_insn_operand" "nir")) - (match_operand 2 "" "i")))] + (call (mem (match_operand:SI 1 "call_insn_operand" "ir")) + (match_operand 2 "" "")))] "!SIBLING_CALL_P (insn)" { return xtensa_emit_call (1, operands); @@ -2558,8 +2558,8 @@ }) (define_insn "sibcall_internal" - [(call (mem:SI (match_operand:SI 0 "call_insn_operand" "nic")) - (match_operand 1 "" "i"))] + [(call (mem:SI (match_operand:SI 0 "call_insn_operand" "ic")) + (match_operand 1 "" ""))] "!TARGET_WINDOWED_ABI && SIBLING_CALL_P (insn)" { return xtensa_emit_sibcall (0, operands); @@ -2580,8 +2580,8 @@ (define_insn "sibcall_value_internal" [(set (match_operand 0 "register_operand" "=a") - (call (mem:SI (match_operand:SI 1 "call_insn_operand" "nic")) - (match_operand 2 "" "i")))] + (call (mem:SI (match_operand:SI 1 "call_insn_operand" "ic")) + (match_operand 2 "" "")))] "!TARGET_WINDOWED_ABI && SIBLING_CALL_P (insn)" { return xtensa_emit_sibcall (1, operands); @@ -2613,7 +2613,7 @@ (define_insn "entry" [(set (reg:SI A1_REG) - (unspec_volatile:SI [(match_operand:SI 0 "const_int_operand" "i")] + (unspec_volatile:SI [(match_operand:SI 0 "const_int_operand" "")] UNSPECV_ENTRY))] "" "entry\tsp, %0" @@ -3179,7 +3179,7 @@ [(set (match_operand:SI 0 "register_operand" "=a") (match_operator:SI 3 "boolean_operator" [(and:SI (match_operand:SI 1 "register_operand" "r") - (match_operand:SI 2 "const_int_operand" "i")) + (match_operand:SI 2 "const_int_operand" "")) (const_int 0)]))] "IN_RANGE (exact_log2 (INTVAL (operands[2]) + 1), 17, 31) || IN_RANGE (exact_log2 (-INTVAL (operands[2])), 1, 30)" @@ -3237,8 +3237,8 @@ [(set (pc) (if_then_else (match_operator 4 "alt_ubranch_operator" [(plus:SI (match_operand:SI 0 "register_operand" "r") - (match_operand:SI 1 "const_int_operand" "i")) - (match_operand:SI 2 "const_int_operand" "i")]) + (match_operand:SI 1 "const_int_operand" "")) + (match_operand:SI 2 "const_int_operand" "")]) (label_ref (match_operand 3 "")) (pc))) (clobber (match_scratch:SI 5 "=&a"))] diff --git a/gcc/fold-const.cc b/gcc/fold-const.cc index e8cfee8..1311c6e 100644 --- a/gcc/fold-const.cc +++ b/gcc/fold-const.cc @@ -151,74 +151,89 @@ static tree fold_view_convert_expr (tree, tree); static tree fold_negate_expr (location_t, tree); /* This is a helper function to detect min/max for some operands of COND_EXPR. + The form is "(exp0 CMP cst1) ? exp0 : cst2". */ +tree_code +minmax_from_comparison (tree_code cmp, tree exp0, + const widest_int cst1, + const widest_int cst2) +{ + if (cst1 == cst2) + { + if (cmp == LE_EXPR || cmp == LT_EXPR) + return MIN_EXPR; + if (cmp == GT_EXPR || cmp == GE_EXPR) + return MAX_EXPR; + } + if (cst1 == cst2 - 1) + { + /* X <= Y - 1 equals to X < Y. */ + if (cmp == LE_EXPR) + return MIN_EXPR; + /* X > Y - 1 equals to X >= Y. */ + if (cmp == GT_EXPR) + return MAX_EXPR; + /* a != MIN_RANGE<a> ? a : MIN_RANGE<a>+1 -> MAX_EXPR<MIN_RANGE<a>+1, a> */ + if (cmp == NE_EXPR && TREE_CODE (exp0) == SSA_NAME) + { + int_range_max r; + get_range_query (cfun)->range_of_expr (r, exp0); + if (r.undefined_p ()) + r.set_varying (TREE_TYPE (exp0)); + + widest_int min = widest_int::from (r.lower_bound (), + TYPE_SIGN (TREE_TYPE (exp0))); + if (min == cst1) + return MAX_EXPR; + } + } + if (cst1 == cst2 + 1) + { + /* X < Y + 1 equals to X <= Y. */ + if (cmp == LT_EXPR) + return MIN_EXPR; + /* X >= Y + 1 equals to X > Y. */ + if (cmp == GE_EXPR) + return MAX_EXPR; + /* a != MAX_RANGE<a> ? a : MAX_RANGE<a>-1 -> MIN_EXPR<MIN_RANGE<a>-1, a> */ + if (cmp == NE_EXPR && TREE_CODE (exp0) == SSA_NAME) + { + int_range_max r; + get_range_query (cfun)->range_of_expr (r, exp0); + if (r.undefined_p ()) + r.set_varying (TREE_TYPE (exp0)); + + widest_int max = widest_int::from (r.upper_bound (), + TYPE_SIGN (TREE_TYPE (exp0))); + if (max == cst1) + return MIN_EXPR; + } + } + return ERROR_MARK; +} + + +/* This is a helper function to detect min/max for some operands of COND_EXPR. The form is "(EXP0 CMP EXP1) ? EXP2 : EXP3". */ tree_code minmax_from_comparison (tree_code cmp, tree exp0, tree exp1, tree exp2, tree exp3) { - enum tree_code code = ERROR_MARK; - if (HONOR_NANS (exp0) || HONOR_SIGNED_ZEROS (exp0)) return ERROR_MARK; if (!operand_equal_p (exp0, exp2)) return ERROR_MARK; - if (TREE_CODE (exp3) == INTEGER_CST && TREE_CODE (exp1) == INTEGER_CST) - { - if (wi::to_widest (exp1) == (wi::to_widest (exp3) - 1)) - { - /* X <= Y - 1 equals to X < Y. */ - if (cmp == LE_EXPR) - code = LT_EXPR; - /* X > Y - 1 equals to X >= Y. */ - if (cmp == GT_EXPR) - code = GE_EXPR; - /* a != MIN_RANGE<a> ? a : MIN_RANGE<a>+1 -> MAX_EXPR<MIN_RANGE<a>+1, a> */ - if (cmp == NE_EXPR && TREE_CODE (exp0) == SSA_NAME) - { - int_range_max r; - get_range_query (cfun)->range_of_expr (r, exp0); - if (r.undefined_p ()) - r.set_varying (TREE_TYPE (exp0)); - - widest_int min = widest_int::from (r.lower_bound (), - TYPE_SIGN (TREE_TYPE (exp0))); - if (min == wi::to_widest (exp1)) - code = MAX_EXPR; - } - } - if (wi::to_widest (exp1) == (wi::to_widest (exp3) + 1)) - { - /* X < Y + 1 equals to X <= Y. */ - if (cmp == LT_EXPR) - code = LE_EXPR; - /* X >= Y + 1 equals to X > Y. */ - if (cmp == GE_EXPR) - code = GT_EXPR; - /* a != MAX_RANGE<a> ? a : MAX_RANGE<a>-1 -> MIN_EXPR<MIN_RANGE<a>-1, a> */ - if (cmp == NE_EXPR && TREE_CODE (exp0) == SSA_NAME) - { - int_range_max r; - get_range_query (cfun)->range_of_expr (r, exp0); - if (r.undefined_p ()) - r.set_varying (TREE_TYPE (exp0)); - - widest_int max = widest_int::from (r.upper_bound (), - TYPE_SIGN (TREE_TYPE (exp0))); - if (max == wi::to_widest (exp1)) - code = MIN_EXPR; - } - } - } - if (code != ERROR_MARK - || operand_equal_p (exp1, exp3)) + if (operand_equal_p (exp1, exp3)) { if (cmp == LT_EXPR || cmp == LE_EXPR) - code = MIN_EXPR; + return MIN_EXPR; if (cmp == GT_EXPR || cmp == GE_EXPR) - code = MAX_EXPR; + return MAX_EXPR; } - return code; + if (TREE_CODE (exp3) == INTEGER_CST + && TREE_CODE (exp1) == INTEGER_CST) + return minmax_from_comparison (cmp, exp0, wi::to_widest (exp1), wi::to_widest (exp3)); + return ERROR_MARK; } /* Return EXPR_LOCATION of T if it is not UNKNOWN_LOCATION. diff --git a/gcc/fold-const.h b/gcc/fold-const.h index e95cf48..00975dc 100644 --- a/gcc/fold-const.h +++ b/gcc/fold-const.h @@ -254,6 +254,9 @@ extern tree fold_build_pointer_plus_hwi_loc (location_t loc, tree ptr, HOST_WIDE #define fold_build_pointer_plus_hwi(p,o) \ fold_build_pointer_plus_hwi_loc (UNKNOWN_LOCATION, p, o) +extern tree_code minmax_from_comparison (tree_code, tree, + const widest_int, + const widest_int); extern tree_code minmax_from_comparison (tree_code, tree, tree, tree, tree); diff --git a/gcc/fortran/dependency.cc b/gcc/fortran/dependency.cc index aa8a57a..57c0c49 100644 --- a/gcc/fortran/dependency.cc +++ b/gcc/fortran/dependency.cc @@ -944,12 +944,8 @@ gfc_ref_needs_temporary_p (gfc_ref *ref) types), not in characters. */ return subarray_p; - case REF_INQUIRY: - /* Within an array reference, inquiry references of complex - variables generally need a temporary. */ - return subarray_p; - case REF_COMPONENT: + case REF_INQUIRY: break; } diff --git a/gcc/fortran/openmp.cc b/gcc/fortran/openmp.cc index 8cea724..357e6a7f 100644 --- a/gcc/fortran/openmp.cc +++ b/gcc/fortran/openmp.cc @@ -12150,7 +12150,8 @@ resolve_omp_do (gfc_code *code) name, i, &code->loc); goto fail; } - else if (next != do_code->block->next || next->next) + else if (next != do_code->block->next + || (next->next && next->next->op != EXEC_CONTINUE)) /* Imperfectly nested loop found. */ { /* Only diagnose violation of imperfect nesting constraints once. */ diff --git a/gcc/fortran/trans-intrinsic.cc b/gcc/fortran/trans-intrinsic.cc index d1c2a80..05017d0 100644 --- a/gcc/fortran/trans-intrinsic.cc +++ b/gcc/fortran/trans-intrinsic.cc @@ -8728,13 +8728,18 @@ gfc_conv_intrinsic_transfer (gfc_se * se, gfc_expr * expr) } else { + bool simply_contiguous = gfc_is_simply_contiguous (arg->expr, + false, true); argse.want_pointer = 0; + /* A non-contiguous SOURCE needs packing. */ + if (!simply_contiguous) + argse.force_tmp = 1; gfc_conv_expr_descriptor (&argse, arg->expr); source = gfc_conv_descriptor_data_get (argse.expr); source_type = gfc_get_element_type (TREE_TYPE (argse.expr)); /* Repack the source if not simply contiguous. */ - if (!gfc_is_simply_contiguous (arg->expr, false, true)) + if (!simply_contiguous) { tmp = gfc_build_addr_expr (NULL_TREE, argse.expr); diff --git a/gcc/m2/Make-lang.in b/gcc/m2/Make-lang.in index cd4dc9f..110a8a1 100644 --- a/gcc/m2/Make-lang.in +++ b/gcc/m2/Make-lang.in @@ -671,6 +671,7 @@ GM2-LIBS-BOOT-DEFS = \ ASCII.def \ Args.def \ Assertion.def \ + BinDict.def \ Break.def \ CmdArgs.def \ Debug.def \ @@ -718,6 +719,7 @@ GM2-LIBS-BOOT-MODS = \ ASCII.mod \ Args.mod \ Assertion.mod \ + BinDict.mod \ Break.mod \ CmdArgs.mod \ Debug.mod \ @@ -769,6 +771,7 @@ GM2-LIBS-BOOT-CC = \ # Definition modules for the front end found in gm2-compiler. GM2-COMP-BOOT-DEFS = \ + FilterError.def \ FifoQueue.def \ Lists.def \ M2ALU.def \ @@ -845,6 +848,7 @@ GM2-COMP-BOOT-DEFS = \ # Implementation modules for the front end found in gm2-compiler. GM2-COMP-BOOT-MODS = \ + FilterError.mod \ FifoQueue.mod \ Lists.mod \ Lists.mod \ @@ -946,6 +950,7 @@ GM2-LIBS-DEFS = \ ASCII.def \ Args.def \ Assertion.def \ + BinDict.def \ Break.def \ Builtins.def \ COROUTINES.def \ @@ -1000,6 +1005,7 @@ GM2-LIBS-MODS = \ ASCII.mod \ Args.mod \ Assertion.mod \ + BinDict.mod \ Break.mod \ Builtins.mod \ COROUTINES.mod \ @@ -1062,6 +1068,7 @@ GM2-LIBS-CC = \ # cc1gm2$(exeext) uses these definition modules found in the gm2-compiler directory. GM2-COMP-DEFS = \ + FilterError.def \ FifoQueue.def \ Lists.def \ M2ALU.def \ @@ -1135,6 +1142,7 @@ GM2-COMP-DEFS = \ # cc1gm2$(exeext) uses these implementation modules found in the gm2-compiler directory. GM2-COMP-MODS = \ + FilterError.mod \ FifoQueue.mod \ Lists.mod \ M2ALU.mod \ diff --git a/gcc/m2/gm2-compiler/FilterError.def b/gcc/m2/gm2-compiler/FilterError.def new file mode 100644 index 0000000..ef84aef --- /dev/null +++ b/gcc/m2/gm2-compiler/FilterError.def @@ -0,0 +1,61 @@ +(* FilterError.def provides a filter for token and symbol. + +Copyright (C) 2025 Free Software Foundation, Inc. +Contributed by Gaius Mulley <gaius.mulley@southwales.ac.uk>. + +This file is part of GNU Modula-2. + +GNU Modula-2 is free software; you can redistribute it and/or modify +it under the terms of the GNU General Public License as published by +the Free Software Foundation; either version 3, or (at your option) +any later version. + +GNU Modula-2 is distributed in the hope that it will be useful, but +WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +<http://www.gnu.org/licenses/>. *) + +DEFINITION MODULE FilterError ; + +TYPE + Filter ; + + +(* + Init - return a new empty Filter. +*) + +PROCEDURE Init () : Filter ; + + +(* + AddSymError - adds the pair sym token to the filter. +*) + +PROCEDURE AddSymError (filter: Filter; + sym: CARDINAL; token: CARDINAL) ; + +(* + IsSymError - return TRUE if the pair sym token have been entered in the filter. +*) + +PROCEDURE IsSymError (filter: Filter; sym: CARDINAL; token: CARDINAL) : BOOLEAN ; + + +(* + Kill - deletes the entire filter tree. +*) + +PROCEDURE Kill (VAR filter: Filter) ; + + +END FilterError. diff --git a/gcc/m2/gm2-compiler/FilterError.mod b/gcc/m2/gm2-compiler/FilterError.mod new file mode 100644 index 0000000..b2070de --- /dev/null +++ b/gcc/m2/gm2-compiler/FilterError.mod @@ -0,0 +1,229 @@ +(* FilterError.def implements a filter for token and symbol. + +Copyright (C) 2025 Free Software Foundation, Inc. +Contributed by Gaius Mulley <gaius.mulley@southwales.ac.uk>. + +This file is part of GNU Modula-2. + +GNU Modula-2 is free software; you can redistribute it and/or modify +it under the terms of the GNU General Public License as published by +the Free Software Foundation; either version 3, or (at your option) +any later version. + +GNU Modula-2 is distributed in the hope that it will be useful, but +WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +<http://www.gnu.org/licenses/>. *) + +IMPLEMENTATION MODULE FilterError ; + +(* The purpose of this module is to be able to filter out multiple error + reports refering to the same symbol and token. This is achieved by + maintaining a dictionary of symbols each pointing to a dictionary of + tokens. *) + +FROM SYSTEM IMPORT ADDRESS, ADR ; +FROM Storage IMPORT DEALLOCATE, ALLOCATE ; +FROM BinDict IMPORT Node ; +FROM Assertion IMPORT Assert ; +FROM libc IMPORT printf ; + +IMPORT BinDict ; + +CONST + Debugging = FALSE ; + +TYPE + Filter = POINTER TO RECORD + Sym2Dict: BinDict.Dictionary ; + END ; + + PtrToCardinal = POINTER TO CARDINAL ; + PtrToBoolean = POINTER TO BOOLEAN ; + + +(* + Init - return a new empty Filter. +*) + +PROCEDURE Init () : Filter ; +VAR + filter: Filter ; +BEGIN + NEW (filter) ; + WITH filter^ DO + Sym2Dict := BinDict.Init (CompareCardinal, DeleteCardinal, DeleteTree) ; + END ; + RETURN filter +END Init ; + + +(* + Kill - deletes the entire filter tree and all contents. +*) + +PROCEDURE Kill (VAR filter: Filter) ; +BEGIN + BinDict.Kill (filter^.Sym2Dict) ; + DISPOSE (filter) +END Kill ; + + +(* + CompareCardinal - return an INTEGER representing the comparison + between left and right. + 0 if left == right, -1 if left < right, + +1 if left > right. +*) + +PROCEDURE CompareCardinal (left, right: PtrToCardinal) : INTEGER ; +BEGIN + IF left^ = right^ + THEN + RETURN 0 + ELSIF left^ < right^ + THEN + RETURN -1 + ELSE + RETURN 1 + END +END CompareCardinal ; + + +(* + DeleteCardinal - deallocate the cardinal key. +*) + +PROCEDURE DeleteCardinal (card: PtrToCardinal) ; +BEGIN + DISPOSE (card) +END DeleteCardinal ; + + +(* + DeleteBoolean - deallocate the boolean value. +*) + +PROCEDURE DeleteBoolean (boolean: PtrToBoolean) ; +BEGIN + DISPOSE (boolean) +END DeleteBoolean ; + + +(* + DeleteTree - delete tree and all its contents. +*) + +PROCEDURE DeleteTree (ErrorTree: BinDict.Dictionary) ; +BEGIN + BinDict.Kill (ErrorTree) +END DeleteTree ; + + +(* + AddSymError - adds the pair sym token to the filter. +*) + +PROCEDURE AddSymError (filter: Filter; + sym: CARDINAL; token: CARDINAL) ; +BEGIN + IF NOT IsSymError (filter, sym, token) + THEN + AddNewEntry (filter, sym, token, TRUE) + END +END AddSymError ; + + +(* + AddNewEntry - adds a new value to the sym token pair. +*) + +PROCEDURE AddNewEntry (filter: Filter; sym: CARDINAL; + token: CARDINAL; value: BOOLEAN) ; +VAR + TokenTree : BinDict.Dictionary ; + ptrToToken, + ptrToCard : PtrToCardinal ; + ptrToBool : PtrToBoolean ; +BEGIN + TokenTree := BinDict.Get (filter^.Sym2Dict, ADR (sym)) ; + IF TokenTree = NIL + THEN + TokenTree := BinDict.Init (CompareCardinal, DeleteCardinal, DeleteBoolean) ; + NEW (ptrToCard) ; + ptrToCard^ := sym ; + BinDict.Insert (filter^.Sym2Dict, ptrToCard, TokenTree) ; + Assert (BinDict.Get (filter^.Sym2Dict, ptrToCard) = TokenTree) + END ; + NEW (ptrToBool) ; + ptrToBool^ := value ; + NEW (ptrToToken) ; + ptrToToken^ := token ; + IF Debugging + THEN + printf ("adding sym %d: key = 0x%x, value = 0x%x (%d, %d)\n", + sym, ptrToToken, ptrToBool, ptrToToken^, ptrToBool^) + END ; + BinDict.Insert (TokenTree, ptrToToken, ptrToBool) ; + Assert (BinDict.Get (TokenTree, ptrToToken) = ptrToBool) ; + IF Debugging + THEN + BinDict.PostOrder (TokenTree, PrintNode) + END +END AddNewEntry ; + + +(* + PrintNode - +*) + +PROCEDURE PrintNode (node: Node) ; +VAR + ptrToCard : PtrToCardinal ; + ptrToBool : PtrToBoolean ; +BEGIN + ptrToCard := BinDict.Key (node) ; + ptrToBool := BinDict.Value (node) ; + printf ("key = 0x%x, value = 0x%x (%d, %d)\n", + ptrToCard, ptrToBool, ptrToCard^, ptrToBool^) +END PrintNode ; + + +(* + IsSymError - return TRUE if the pair sym token have been + entered in the filter. +*) + +PROCEDURE IsSymError (filter: Filter; sym: CARDINAL; token: CARDINAL) : BOOLEAN ; +VAR + ptb : PtrToBoolean ; + TokenTree: BinDict.Dictionary ; +BEGIN + TokenTree := BinDict.Get (filter^.Sym2Dict, ADR (sym)) ; + (* RETURN (TokenTree # NIL) ; *) + IF TokenTree = NIL + THEN + (* No symbol registered, therefore FALSE. *) + RETURN FALSE + END ; + ptb := BinDict.Get (TokenTree, ADR (token)) ; + IF ptb = NIL + THEN + (* The symbol was registered, but no entry for token, therefore FALSE. *) + RETURN FALSE + END ; + (* Found symbol and token so we return the result. *) + RETURN ptb^ +END IsSymError ; + + +END FilterError. diff --git a/gcc/m2/gm2-compiler/M2Error.def b/gcc/m2/gm2-compiler/M2Error.def index 427bd08..7f945e4 100644 --- a/gcc/m2/gm2-compiler/M2Error.def +++ b/gcc/m2/gm2-compiler/M2Error.def @@ -130,6 +130,14 @@ PROCEDURE MoveError (e: Error; AtTokenNo: CARDINAL) : Error ; (* + KillError - remove error e from the error list and deallocate + memory associated with e. +*) + +PROCEDURE KillError (VAR e: Error) ; + + +(* SetColor - informs the error module that this error will have had colors assigned to it. If an error is issued without colors assigned then the default colors will be assigned to the legacy error diff --git a/gcc/m2/gm2-compiler/M2Error.mod b/gcc/m2/gm2-compiler/M2Error.mod index 561f42c..095e732 100644 --- a/gcc/m2/gm2-compiler/M2Error.mod +++ b/gcc/m2/gm2-compiler/M2Error.mod @@ -369,8 +369,8 @@ PROCEDURE WriteFormat3 (a: ARRAY OF CHAR; w1, w2, w3: ARRAY OF BYTE) ; VAR e: Error ; BEGIN - e := NewError(GetTokenNo()) ; - e^.s := DoFormat3(a, w1, w2, w3) + e := NewError (GetTokenNo ()) ; + e^.s := DoFormat3 (a, w1, w2, w3) END WriteFormat3 ; @@ -394,7 +394,7 @@ END MoveError ; PROCEDURE NewError (AtTokenNo: CARDINAL) : Error ; VAR - e, f: Error ; + e: Error ; BEGIN IF AtTokenNo = UnknownTokenNo THEN @@ -414,18 +414,7 @@ BEGIN END ; (* Assert (scopeKind # noscope) ; *) e^.scope := currentScope ; - IF (head=NIL) OR (head^.token>AtTokenNo) - THEN - e^.next := head ; - head := e - ELSE - f := head ; - WHILE (f^.next#NIL) AND (f^.next^.token<AtTokenNo) DO - f := f^.next - END ; - e^.next := f^.next ; - f^.next := e - END ; + AddToList (e) ; RETURN( e ) END NewError ; @@ -463,6 +452,95 @@ END NewNote ; (* + AddToList - adds error e to the list of errors in token order. +*) + +PROCEDURE AddToList (e: Error) ; +VAR + f: Error ; +BEGIN + IF (head=NIL) OR (head^.token > e^.token) + THEN + e^.next := head ; + head := e + ELSE + f := head ; + WHILE (f^.next # NIL) AND (f^.next^.token < e^.token) DO + f := f^.next + END ; + e^.next := f^.next ; + f^.next := e + END ; +END AddToList ; + + +(* + SubFromList - remove e from the global list. +*) + +PROCEDURE SubFromList (e: Error) ; +VAR + f: Error ; +BEGIN + IF head = e + THEN + head := head^.next + ELSE + f := head ; + WHILE (f # NIL) AND (f^.next # e) DO + f := f^.next + END ; + IF (f # NIL) AND (f^.next = e) + THEN + f^.next := e^.next + ELSE + InternalError ('expecting e to be on the global list') + END + END ; + DISPOSE (e) +END SubFromList ; + + +(* + WipeReferences - remove any reference to e from the global list. +*) + +PROCEDURE WipeReferences (e: Error) ; +VAR + f: Error ; +BEGIN + f := head ; + WHILE f # NIL DO + IF f^.parent = e + THEN + f^.parent := NIL + END ; + IF f^.child = e + THEN + f^.child := NIL + END ; + f := f^.next + END +END WipeReferences ; + + +(* + KillError - remove error e from the error list and deallocate + memory associated with e. +*) + +PROCEDURE KillError (VAR e: Error) ; +BEGIN + IF head # NIL + THEN + SubFromList (e) ; + WipeReferences (e) ; + e := NIL + END +END KillError ; + + +(* ChainError - creates and returns a new error handle, this new error is associated with, e, and is chained onto the end of, e. If, e, is NIL then the result to NewError is returned. diff --git a/gcc/m2/gm2-compiler/M2LexBuf.mod b/gcc/m2/gm2-compiler/M2LexBuf.mod index 143190e0..5198243 100644 --- a/gcc/m2/gm2-compiler/M2LexBuf.mod +++ b/gcc/m2/gm2-compiler/M2LexBuf.mod @@ -1078,6 +1078,10 @@ BEGIN THEN caret := right END ; + IF (caret = left) AND (left = right) + THEN + RETURN caret + END ; IF isSrcToken (caret) AND isSrcToken (left) AND isSrcToken (right) THEN lc := TokenToLocation (caret) ; diff --git a/gcc/m2/gm2-compiler/M2MetaError.mod b/gcc/m2/gm2-compiler/M2MetaError.mod index dc14e6b..aae0f02 100644 --- a/gcc/m2/gm2-compiler/M2MetaError.mod +++ b/gcc/m2/gm2-compiler/M2MetaError.mod @@ -26,7 +26,11 @@ FROM M2Base IMPORT ZType, RType, IsPseudoBaseFunction, IsPseudoBaseProcedure ; FROM NameKey IMPORT Name, KeyToCharStar, NulName ; FROM StrLib IMPORT StrLen ; FROM M2LexBuf IMPORT GetTokenNo, UnknownTokenNo ; -FROM M2Error IMPORT Error, NewError, NewWarning, NewNote, ErrorString, InternalError, ChainError, SetColor, FlushErrors, FlushWarnings ; + +FROM M2Error IMPORT Error, NewError, KillError, + NewWarning, NewNote, ErrorString, InternalError, + ChainError, SetColor, FlushErrors, FlushWarnings ; + FROM FIO IMPORT StdOut, WriteLine ; FROM SFIO IMPORT WriteS ; FROM StringConvert IMPORT ctos ; @@ -67,6 +71,9 @@ FROM SymbolTable IMPORT NulSym, IMPORT M2ColorString ; IMPORT M2Error ; +IMPORT FilterError ; + +FROM FilterError IMPORT Filter, AddSymError, IsSymError ; CONST @@ -85,6 +92,8 @@ TYPE errorBlock = RECORD useError : BOOLEAN ; e : Error ; + symcause : CARDINAL ; (* The symbol (or NulSym) associated with the token no. *) + token : CARDINAL ; type : errorType ; out, in : String ; highplus1 : CARDINAL ; @@ -115,12 +124,13 @@ TYPE VAR - lastRoot : Error ; - lastColor : colorType ; - seenAbort : BOOLEAN ; - dictionary : Index ; - outputStack: Index ; - freeEntry : dictionaryEntry ; + lastRoot : Error ; + lastColor : colorType ; + seenAbort : BOOLEAN ; + dictionary : Index ; + outputStack : Index ; + freeEntry : dictionaryEntry ; + FilterUnknown: Filter ; (* @@ -513,6 +523,8 @@ BEGIN WITH eb DO useError := TRUE ; e := NIL ; + symcause := NulSym ; + token := UnknownTokenNo ; type := error ; (* Default to the error color. *) out := InitString ('') ; in := input ; @@ -543,9 +555,9 @@ END initErrorBlock ; PROCEDURE push (VAR newblock: errorBlock; oldblock: errorBlock) ; BEGIN - pushColor (oldblock) ; (* save the current color. *) - newblock := oldblock ; (* copy all the fields. *) - newblock.out := NIL ; (* must do this before a clear as we have copied the address. *) + pushColor (oldblock) ; (* Save the current color. *) + newblock := oldblock ; (* Now copy all the fields. *) + newblock.out := NIL ; (* We must do this before a clear as we have copied the address. *) clear (newblock) ; newblock.quotes := TRUE END push ; @@ -604,6 +616,10 @@ BEGIN THEN toblock.e := fromblock.e END ; + IF toblock.symcause = NulSym + THEN + toblock.symcause := fromblock.symcause + END ; toblock.chain := fromblock.chain ; toblock.root := fromblock.root ; toblock.ini := fromblock.ini ; @@ -1173,35 +1189,54 @@ END doChain ; doError - creates and returns an error note. *) -PROCEDURE doError (VAR eb: errorBlock; tok: CARDINAL) ; +PROCEDURE doError (VAR eb: errorBlock; tok: CARDINAL; sym: CARDINAL) ; BEGIN IF eb.useError THEN - chooseError (eb, tok) + chooseError (eb, tok, sym) END END doError ; (* - defaultError - adds the default error location to, tok, if one has not already been - assigned. + defaultError - adds the default error location to, tok, + if one has not already been assigned. *) PROCEDURE defaultError (VAR eb: errorBlock; tok: CARDINAL) ; BEGIN IF eb.e = NIL THEN - doError (eb, tok) + doError (eb, tok, NulSym) + END ; + IF eb.token = UnknownTokenNo + THEN + eb.token := tok END END defaultError ; (* + updateTokSym - assign symcause to sym if not NulSym. + Update token. +*) + +PROCEDURE updateTokSym (VAR eb: errorBlock; tok: CARDINAL; sym: CARDINAL) ; +BEGIN + IF sym # NulSym + THEN + eb.symcause := sym + END ; + eb.token := tok +END updateTokSym ; + + +(* chooseError - choose the error kind dependant upon type. Either an error, warning or note will be generated. *) -PROCEDURE chooseError (VAR eb: errorBlock; tok: CARDINAL) ; +PROCEDURE chooseError (VAR eb: errorBlock; tok: CARDINAL; sym: CARDINAL) ; BEGIN IF eb.chain THEN @@ -1217,19 +1252,22 @@ BEGIN eb.e := NewError (tok) ELSE eb.e := MoveError (eb.e, tok) - END | + END ; + updateTokSym (eb, tok, sym) | warning: IF eb.e=NIL THEN eb.e := NewWarning (tok) ELSE eb.e := MoveError (eb.e, tok) - END | + END ; + updateTokSym (eb, tok, sym) | note : IF eb.e=NIL THEN eb.e := NewNote (tok) ELSE eb.e := MoveError (eb.e, tok) - END + END ; + updateTokSym (eb, tok, sym) ELSE InternalError ('unexpected enumeration value') @@ -1257,9 +1295,9 @@ BEGIN THEN IF IsInnerModule (scope) THEN - doError (eb, GetDeclaredMod (sym)) + doError (eb, GetDeclaredMod (sym), sym) ELSE - doError (eb, GetDeclaredMod (sym)) + doError (eb, GetDeclaredMod (sym), sym) END ELSE Assert (IsDefImp (scope)) ; @@ -1269,9 +1307,9 @@ BEGIN UNTIL GetScope(OuterModule)=NulSym. *) IF GetDeclaredModule (sym) = UnknownTokenNo THEN - doError (eb, GetDeclaredDef (sym)) + doError (eb, GetDeclaredDef (sym), sym) ELSE - doError (eb, GetDeclaredMod (sym)) + doError (eb, GetDeclaredMod (sym), sym) END END END doErrorScopeModule ; @@ -1290,9 +1328,9 @@ BEGIN THEN IF IsInnerModule (scope) THEN - doError (eb, GetDeclaredFor (sym)) + doError (eb, GetDeclaredFor (sym), sym) ELSE - doError (eb, GetDeclaredFor (sym)) + doError (eb, GetDeclaredFor (sym), sym) END ELSE Assert (IsDefImp (scope)) ; @@ -1302,9 +1340,9 @@ BEGIN UNTIL GetScope(OuterModule)=NulSym. *) IF GetDeclaredModule (sym) = UnknownTokenNo THEN - doError (eb, GetDeclaredDef (sym)) + doError (eb, GetDeclaredDef (sym), sym) ELSE - doError (eb, GetDeclaredFor (sym)) + doError (eb, GetDeclaredFor (sym), sym) END END END doErrorScopeForward ; @@ -1324,12 +1362,12 @@ BEGIN IF scope = NulSym THEN M2Error.EnterErrorScope (NIL) ; - doError (eb, GetDeclaredMod (sym)) + doError (eb, GetDeclaredMod (sym), sym) ELSE M2Error.EnterErrorScope (GetErrorScope (scope)) ; IF IsProcedure (scope) THEN - doError (eb, GetDeclaredMod (sym)) + doError (eb, GetDeclaredMod (sym), sym) ELSE doErrorScopeModule (eb, sym) END @@ -1353,12 +1391,12 @@ BEGIN IF scope = NulSym THEN M2Error.EnterErrorScope (NIL) ; - doError (eb, GetDeclaredFor (sym)) + doError (eb, GetDeclaredFor (sym), sym) ELSE M2Error.EnterErrorScope (GetErrorScope (scope)) ; IF IsProcedure (scope) THEN - doError (eb, GetDeclaredFor (sym)) + doError (eb, GetDeclaredFor (sym), sym) ELSE doErrorScopeForward (eb, sym) END @@ -1392,16 +1430,16 @@ BEGIN IF IsModule (scope) THEN (* No definition module for a program module. *) - doError (eb, GetDeclaredMod (sym)) + doError (eb, GetDeclaredMod (sym), sym) ELSE Assert (IsDefImp (scope)) ; IF GetDeclaredDefinition (sym) = UnknownTokenNo THEN (* Fall back to the implementation module if no declaration exists in the definition module. *) - doError (eb, GetDeclaredMod (sym)) + doError (eb, GetDeclaredMod (sym), sym) ELSE - doError (eb, GetDeclaredDef (sym)) + doError (eb, GetDeclaredDef (sym), sym) END END END doErrorScopeDefinition ; @@ -1421,12 +1459,12 @@ BEGIN IF scope = NulSym THEN M2Error.EnterErrorScope (NIL) ; - doError (eb, GetDeclaredFor (sym)) + doError (eb, GetDeclaredFor (sym), sym) ELSE M2Error.EnterErrorScope (GetErrorScope (scope)) ; IF IsProcedure (scope) THEN - doError (eb, GetDeclaredDef (sym)) + doError (eb, GetDeclaredDef (sym), sym) ELSE doErrorScopeDefinition (eb, sym) END @@ -1477,25 +1515,25 @@ BEGIN IF scope = NulSym THEN M2Error.EnterErrorScope (NIL) ; - doError (eb, GetDeclaredDef (sym)) + doError (eb, GetDeclaredDef (sym), sym) ELSE M2Error.EnterErrorScope (GetErrorScope (scope)) ; IF IsVar (sym) OR IsParameter (sym) THEN - doError (eb, GetVarParamTok (sym)) + doError (eb, GetVarParamTok (sym), sym) ELSIF IsProcedure (scope) THEN - doError (eb, GetDeclaredDef (sym)) + doError (eb, GetDeclaredDef (sym), sym) ELSIF IsModule (scope) THEN - doError (eb, GetDeclaredMod (sym)) + doError (eb, GetDeclaredMod (sym), sym) ELSE Assert (IsDefImp (scope)) ; IF GetDeclaredDefinition (sym) = UnknownTokenNo THEN - doError (eb, GetDeclaredMod (sym)) + doError (eb, GetDeclaredMod (sym), sym) ELSE - doError (eb, GetDeclaredDef (sym)) + doError (eb, GetDeclaredDef (sym), sym) END END END ; @@ -1550,7 +1588,7 @@ PROCEDURE used (VAR eb: errorBlock; sym: ARRAY OF CARDINAL; bol: CARDINAL) ; BEGIN IF bol <= HIGH (sym) THEN - doError (eb, GetFirstUsed (sym[bol])) + doError (eb, GetFirstUsed (sym[bol]), sym[bol]) END END used ; @@ -1755,7 +1793,8 @@ BEGIN 'B': declaredType (eb, sym, bol) | 'C': eb.chain := TRUE | 'D': declaredDef (eb, sym, bol) | - 'E': eb.type := error | + 'E': eb.type := error ; + eb.symcause := sym[bol] | 'F': filename (eb) ; DEC (eb.ini) | 'G': declaredFor (eb, sym, bol) | @@ -1764,7 +1803,8 @@ BEGIN DEC (eb.ini) | 'M': declaredMod (eb, sym, bol) | 'N': doCount (eb, sym, bol) | - 'O': eb.type := note | + 'O': eb.type := note ; + eb.symcause := sym[bol] | 'P': pushColor (eb) | 'Q': resetDictionary | 'R': eb.root := TRUE | @@ -1772,7 +1812,8 @@ BEGIN 'T': doGetType (eb, sym, bol) | 'U': used (eb, sym, bol) | 'V': declaredVar (eb, sym, bol) | - 'W': eb.type := warning | + 'W': eb.type := warning ; + eb.symcause := sym[bol] | 'X': pushOutput (eb) | 'Y': processDefine (eb) | 'Z': popOutput (eb) | @@ -2402,7 +2443,12 @@ BEGIN ebnf (eb, sym) ; flushColor (eb) ; defaultError (eb, tok) ; - ErrorString (eb.e, Dup (eb.out)) ; + IF isUniqueError (eb) + THEN + ErrorString (eb.e, Dup (eb.out)) ; + ELSE + KillError (eb.e) + END ; killErrorBlock (eb) ; checkAbort END MetaErrorStringT1 ; @@ -2425,7 +2471,12 @@ BEGIN ebnf (eb, sym) ; flushColor (eb) ; defaultError (eb, tok) ; - ErrorString (eb.e, Dup (eb.out)) ; + IF isUniqueError (eb) + THEN + ErrorString (eb.e, Dup (eb.out)) + ELSE + KillError (eb.e) + END ; killErrorBlock (eb) ; checkAbort END MetaErrorStringT2 ; @@ -2450,7 +2501,12 @@ BEGIN ebnf (eb, sym) ; flushColor (eb) ; defaultError (eb, tok) ; - ErrorString (eb.e, Dup (eb.out)) ; + IF isUniqueError (eb) + THEN + ErrorString (eb.e, Dup (eb.out)) + ELSE + KillError (eb.e) + END ; killErrorBlock (eb) ; checkAbort END MetaErrorStringT3 ; @@ -2475,7 +2531,12 @@ BEGIN ebnf (eb, sym) ; flushColor (eb) ; defaultError (eb, tok) ; - ErrorString (eb.e, Dup (eb.out)) ; + IF isUniqueError (eb) + THEN + ErrorString (eb.e, Dup (eb.out)) + ELSE + KillError (eb.e) + END ; killErrorBlock (eb) ; checkAbort END MetaErrorStringT4 ; @@ -2518,6 +2579,31 @@ END MetaError4 ; (* + isUniqueError - return TRUE if the symbol associated with the + error block is unknown and we have seen the same + token before. +*) + +PROCEDURE isUniqueError (VAR eb: errorBlock) : BOOLEAN ; +BEGIN + IF (eb.symcause # NulSym) AND IsUnknown (eb.symcause) + THEN + (* A candidate for filtering. *) + IF IsSymError (FilterUnknown, eb.symcause, eb.token) + THEN + (* Seen and reported about this unknown and token + location before. *) + RETURN FALSE + ELSE + (* Remember this combination. *) + AddSymError (FilterUnknown, eb.symcause, eb.token) + END + END ; + RETURN TRUE +END isUniqueError ; + + +(* wrapErrors - *) @@ -2531,15 +2617,20 @@ BEGIN ebnf (eb, sym) ; flushColor (eb) ; defaultError (eb, tok) ; - lastRoot := eb.e ; - ErrorString (eb.e, Dup (eb.out)) ; - killErrorBlock (eb) ; - initErrorBlock (eb, InitString (m2), sym) ; - eb.type := chained ; - ebnf (eb, sym) ; - flushColor (eb) ; - defaultError (eb, tok) ; - ErrorString (eb.e, Dup (eb.out)) ; + IF isUniqueError (eb) + THEN + lastRoot := eb.e ; + ErrorString (eb.e, Dup (eb.out)) ; + killErrorBlock (eb) ; + initErrorBlock (eb, InitString (m2), sym) ; + eb.type := chained ; + ebnf (eb, sym) ; + flushColor (eb) ; + defaultError (eb, tok) ; + ErrorString (eb.e, Dup (eb.out)) + ELSE + KillError (eb.e) + END ; killErrorBlock (eb) END wrapErrors ; @@ -2871,5 +2962,6 @@ BEGIN seenAbort := FALSE ; outputStack := InitIndex (1) ; dictionary := InitIndex (1) ; - freeEntry := NIL + freeEntry := NIL ; + FilterUnknown := FilterError.Init () END M2MetaError. diff --git a/gcc/m2/gm2-compiler/M2Quads.mod b/gcc/m2/gm2-compiler/M2Quads.mod index 3bdf8c5..bacd956 100644 --- a/gcc/m2/gm2-compiler/M2Quads.mod +++ b/gcc/m2/gm2-compiler/M2Quads.mod @@ -10776,8 +10776,9 @@ BEGIN PutVar (ReturnVar, Cardinal) ; GenQuadO (resulttok, SizeOp, ReturnVar, NulSym, GetSType (OperandT (1)), FALSE) ELSE + (* Spellcheck. *) MetaErrorT1 (resulttok, - '{%E}SYSTEM procedure function {%kTSIZE} expects a variable or type as its first parameter, seen {%1Ed}', + '{%E}SYSTEM procedure function {%kTSIZE} expects a variable or type as its first parameter, seen {%1Ed} {%1&s}', OperandT (1)) ; ReturnVar := MakeConstLit (resulttok, MakeKey ('0'), Cardinal) END diff --git a/gcc/m2/gm2-libs/BinDict.def b/gcc/m2/gm2-libs/BinDict.def new file mode 100644 index 0000000..16272fd --- /dev/null +++ b/gcc/m2/gm2-libs/BinDict.def @@ -0,0 +1,92 @@ +(* BinDict.def provides a generic binary dictionary. + +Copyright (C) 2025 Free Software Foundation, Inc. +Contributed by Gaius Mulley <gaiusmod2@gmail.com>. + +This file is part of GNU Modula-2. + +GNU Modula-2 is free software; you can redistribute it and/or modify +it under the terms of the GNU General Public License as published by +the Free Software Foundation; either version 3, or (at your option) +any later version. + +GNU Modula-2 is distributed in the hope that it will be useful, but +WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +<http://www.gnu.org/licenses/>. *) + +DEFINITION MODULE BinDict ; + +FROM SYSTEM IMPORT ADDRESS ; + +TYPE + Dictionary ; + Node ; + Compare = PROCEDURE (ADDRESS, ADDRESS) : INTEGER ; + Delete = PROCEDURE (ADDRESS) ; + VisitNode = PROCEDURE (Node) ; + + +(* + Init - create and return a new binary dictionary which will use + the compare procedure to order the contents as they are added. +*) + +PROCEDURE Init (KeyCompare: Compare; + KeyDelete, ValueDelete: Delete) : Dictionary ; + + +(* + Kill - delete the dictionary and its contents. + dict is assigned to NIL. +*) + +PROCEDURE Kill (VAR dict: Dictionary) ; + + +(* + PostOrder - visit each dictionary entry in post order. +*) + +PROCEDURE PostOrder (dict: Dictionary; visit: VisitNode) ; + + +(* + Insert - insert key value pair into the dictionary. +*) + +PROCEDURE Insert (dict: Dictionary; key, value: ADDRESS) ; + + +(* + Get - return the value associated with the key or NIL + if it does not exist. +*) + +PROCEDURE Get (dict: Dictionary; key: ADDRESS) : ADDRESS ; + + +(* + Value - return the value from node. +*) + +PROCEDURE Value (node: Node) : ADDRESS ; + + +(* + Key - return the key from node. +*) + +PROCEDURE Key (node: Node) : ADDRESS ; + + +END BinDict. diff --git a/gcc/m2/gm2-libs/BinDict.mod b/gcc/m2/gm2-libs/BinDict.mod new file mode 100644 index 0000000..f8bb873 --- /dev/null +++ b/gcc/m2/gm2-libs/BinDict.mod @@ -0,0 +1,272 @@ +(* BinDict.mod provides a generic binary dictionary. + +Copyright (C) 2025 Free Software Foundation, Inc. +Contributed by Gaius Mulley <gaiusmod2@gmail.com>. + +This file is part of GNU Modula-2. + +GNU Modula-2 is free software; you can redistribute it and/or modify +it under the terms of the GNU General Public License as published by +the Free Software Foundation; either version 3, or (at your option) +any later version. + +GNU Modula-2 is distributed in the hope that it will be useful, but +WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +<http://www.gnu.org/licenses/>. *) + +IMPLEMENTATION MODULE BinDict ; + +FROM Storage IMPORT ALLOCATE, DEALLOCATE ; + + +TYPE + Dictionary = POINTER TO RECORD + content : Node ; + compare : Compare ; + deleteKey, + deleteValue: Delete + END ; + + Node = POINTER TO RECORD + dict : Dictionary ; + left, + right: Node ; + key, + value: ADDRESS ; + END ; + + +(* + Init - create and return a new binary dictionary which will use + the compare procedure to order the contents as they are + added. +*) + +PROCEDURE Init (KeyCompare: Compare; KeyDelete, + ValueDelete: Delete) : Dictionary ; +VAR + dict: Dictionary ; +BEGIN + NEW (dict) ; + WITH dict^ DO + content := NIL ; + compare := KeyCompare ; + deleteKey := KeyDelete ; + deleteValue := ValueDelete + END ; + RETURN dict +END Init ; + + +(* + Kill - delete the dictionary and its contents. + dict is assigned to NIL. +*) + +PROCEDURE Kill (VAR dict: Dictionary) ; +BEGIN + PostOrder (dict, DeleteNode) ; + DISPOSE (dict) ; + dict := NIL +END Kill ; + + +(* + DeleteNode - deletes node dict, key and value. +*) + +PROCEDURE DeleteNode (node: Node) ; +BEGIN + IF node # NIL + THEN + WITH node^ DO + dict^.deleteKey (key) ; + dict^.deleteValue (value) + END ; + DISPOSE (node) + END +END DeleteNode ; + + +(* + Insert - insert key value pair into the dictionary. +*) + +PROCEDURE Insert (dict: Dictionary; key, value: ADDRESS) ; +BEGIN + dict^.content := InsertNode (dict, dict^.content, key, value) +END Insert ; + + +(* + InsertNode - insert the key value pair as a new node in the + binary tree within dict. +*) + +PROCEDURE InsertNode (dict: Dictionary; + node: Node; + key, value: ADDRESS) : Node ; +BEGIN + IF node = NIL + THEN + RETURN ConsNode (dict, key, value, NIL, NIL) + ELSE + CASE dict^.compare (key, node^.key) OF + + 0: HALT | (* Not expecting to replace a key value. *) + -1: RETURN ConsNode (dict, node^.key, node^.value, + InsertNode (dict, node^.left, + key, value), node^.right) | + +1: RETURN ConsNode (dict, node^.key, node^.value, + node^.left, + InsertNode (dict, node^.right, + key, value)) + END + END +END InsertNode ; + + +(* + ConsNode - return a new node containing the pairing key and value. + The new node fields are assigned left, right and dict. +*) + +PROCEDURE ConsNode (dict: Dictionary; + key, value: ADDRESS; + left, right: Node) : Node ; +VAR + node: Node ; +BEGIN + NEW (node) ; + node^.key := key ; + node^.value := value ; + node^.left := left ; + node^.right := right ; + node^.dict := dict ; + RETURN node +END ConsNode ; + + +(* + KeyExist - return TRUE if dictionary contains an entry key. + It compares the content and not the address pointer. +*) + +PROCEDURE KeyExist (dict: Dictionary; key: ADDRESS) : BOOLEAN ; +BEGIN + RETURN KeyExistNode (dict^.content, key) +END KeyExist ; + + +(* + KeyExistNode - return TRUE if the binary tree under node contains + key. +*) + +PROCEDURE KeyExistNode (node: Node; key: ADDRESS) : BOOLEAN ; +BEGIN + IF node # NIL + THEN + CASE node^.dict^.compare (key, node^.key) OF + + 0: RETURN TRUE | + -1: RETURN KeyExistNode (node^.left, key) | + +1: RETURN KeyExistNode (node^.right, key) + + END + END ; + RETURN FALSE +END KeyExistNode ; + + +(* + Value - return the value from node. +*) + +PROCEDURE Value (node: Node) : ADDRESS ; +BEGIN + RETURN node^.value +END Value ; + + +(* + Key - return the key from node. +*) + +PROCEDURE Key (node: Node) : ADDRESS ; +BEGIN + RETURN node^.value +END Key ; + + +(* + Get - return the value associated with the key or NIL + if it does not exist. +*) + +PROCEDURE Get (dict: Dictionary; key: ADDRESS) : ADDRESS ; +BEGIN + RETURN GetNode (dict^.content, key) +END Get ; + + +(* + GetNode - return the value in binary node tree which + is associated with key. +*) + +PROCEDURE GetNode (node: Node; key: ADDRESS) : ADDRESS ; +BEGIN + IF node # NIL + THEN + CASE node^.dict^.compare (key, node^.key) OF + + 0: RETURN node^.value | + +1: RETURN GetNode (node^.right, key) | + -1: RETURN GetNode (node^.left, key) + + END + END ; + RETURN NIL +END GetNode ; + + +(* + PostOrder - visit each dictionary entry in post order. +*) + +PROCEDURE PostOrder (dict: Dictionary; visit: VisitNode) ; +BEGIN + IF dict # NIL + THEN + PostOrderNode (dict^.content, visit) + END +END PostOrder ; + + +(* + PostOrderNode - visit the tree node in post order. +*) + +PROCEDURE PostOrderNode (node: Node; visit: VisitNode) ; +BEGIN + IF node # NIL + THEN + PostOrderNode (node^.left, visit) ; + PostOrderNode (node^.right, visit) ; + visit (node) + END +END PostOrderNode ; + + +END BinDict. diff --git a/gcc/match.pd b/gcc/match.pd index a4248a5..b37a437 100644 --- a/gcc/match.pd +++ b/gcc/match.pd @@ -794,6 +794,27 @@ DEFINE_INT_AND_FLOAT_ROUND_FN (RINT) (rdiv @0 (negate @1)) (rdiv (negate @0) @1)) +/* convert semantics of round(x) function to floor(x+0.5). */ +/* (x-floor(x)) < (ceil(x)-x) ? floor(x) : ceil(x) --> floor(x+0.5). */ +/* (x-floor(x)) >= (ceil(x)-x) ? ceil(x) : floor(x) --> floor(x+0.5). */ +/* (ceil(x)-x) > (x-floor(x)) ? floor(x) : ceil(x) --> floor(x+0.5). */ +/* (ceil(x)-x) <= (x-floor(x)) ? ceil(x) : floor(x) --> floor(x+0.5). */ +(for op (lt lt lt lt ge ge ge ge) + bt (BUILT_IN_FLOORF BUILT_IN_FLOOR BUILT_IN_FLOORL IFN_FLOOR + BUILT_IN_CEILF BUILT_IN_CEIL BUILT_IN_CEILL IFN_CEIL) + bf (BUILT_IN_CEILF BUILT_IN_CEIL BUILT_IN_CEILL IFN_CEIL + BUILT_IN_FLOORF BUILT_IN_FLOOR BUILT_IN_FLOORL IFN_FLOOR) + floor (BUILT_IN_FLOORF BUILT_IN_FLOOR BUILT_IN_FLOORL IFN_FLOOR + BUILT_IN_FLOORF BUILT_IN_FLOOR BUILT_IN_FLOORL IFN_FLOOR) + ceil (BUILT_IN_CEILF BUILT_IN_CEIL BUILT_IN_CEILL IFN_CEIL + BUILT_IN_CEILF BUILT_IN_CEIL BUILT_IN_CEILL IFN_CEIL) + (simplify + (cond (op:c (minus:s SSA_NAME@0 (floor SSA_NAME@0)) + (minus:s (ceil SSA_NAME@0) SSA_NAME@0)) + (bt SSA_NAME@0) (bf SSA_NAME@0)) + (if (!HONOR_SIGNED_ZEROS (type) && !HONOR_SIGN_DEPENDENT_ROUNDING (type)) + (floor (plus @0 { build_real (type, dconsthalf); }))))) + (if (flag_unsafe_math_optimizations) /* Simplify (C / x op 0.0) to x op 0.0 for C != 0, C != Inf/Nan. Since C / x may underflow to zero, do this only for unsafe math. */ @@ -6571,25 +6592,30 @@ DEFINE_INT_AND_FLOAT_ROUND_FN (RINT) tree from_type = TREE_TYPE (@1); tree c1_type = TREE_TYPE (@3), c2_type = TREE_TYPE (@2); enum tree_code code = ERROR_MARK; - enum tree_code ncmp = cmp; - tree c1 = @3; /* `((signed)a) < 0` should be converted back into `a >= (unsigned)SIGNED_TYPE_MIN`. `((signed)a) >= 0` should be converted back into `a < (unsigned)SIGNED_TYPE_MIN`. */ - if (integer_zerop (c1) + if (integer_zerop (@3) + && INTEGRAL_TYPE_P (from_type) && (cmp == GE_EXPR || cmp == LT_EXPR) && TYPE_UNSIGNED (from_type) && !TYPE_UNSIGNED (c1_type) - && TYPE_PRECISION (from_type) == TYPE_PRECISION (c1_type)) + && TYPE_PRECISION (from_type) == TYPE_PRECISION (c1_type) + && int_fits_type_p (@2, from_type) + && (types_match (c2_type, from_type) + || (TYPE_PRECISION (c2_type) > TYPE_PRECISION (from_type) + && (TYPE_UNSIGNED (from_type) + || TYPE_SIGN (c2_type) == TYPE_SIGN (from_type))))) { - ncmp = cmp == GE_EXPR ? LT_EXPR : GE_EXPR; - c1 = fold_convert (from_type, TYPE_MIN_VALUE (c1_type)); - c1_type = from_type; + tree_code ncmp = cmp == GE_EXPR ? LE_EXPR : GT_EXPR; + widest_int c1 = wi::mask<widest_int>(TYPE_PRECISION (type) - 1, 0); + code = minmax_from_comparison (ncmp, @1, c1, wi::to_widest (@2)); } - if (INTEGRAL_TYPE_P (from_type) + if (code == ERROR_MARK + && INTEGRAL_TYPE_P (from_type) && int_fits_type_p (@2, from_type) && (types_match (c1_type, from_type) || (TYPE_PRECISION (c1_type) > TYPE_PRECISION (from_type) @@ -6600,8 +6626,8 @@ DEFINE_INT_AND_FLOAT_ROUND_FN (RINT) && (TYPE_UNSIGNED (from_type) || TYPE_SIGN (c2_type) == TYPE_SIGN (from_type))))) { - if (ncmp != EQ_EXPR) - code = minmax_from_comparison (ncmp, @1, c1, @1, @2); + if (cmp != EQ_EXPR) + code = minmax_from_comparison (cmp, @1, @3, @1, @2); /* Can do A == C1 ? A : C2 -> A == C1 ? C1 : C2? */ else if (int_fits_type_p (@3, from_type)) code = EQ_EXPR; @@ -6911,6 +6937,35 @@ DEFINE_INT_AND_FLOAT_ROUND_FN (RINT) && integer_nonzerop (fold_build2 (GE_EXPR, boolean_type_node, @3, @4))) (max @2 @4)))))) +/* Optimize (((signed)a CMP 0) ? max<a,CST2> : CST3 */ +(for cmp (lt ge) + minmax (min max) + (simplify + (cond (cmp:c (nop_convert @0) integer_zerop@1) (minmax@2 @0 INTEGER_CST@3) INTEGER_CST@4) + (if (!TYPE_UNSIGNED (TREE_TYPE (@1)) + && TYPE_UNSIGNED (TREE_TYPE (@0))) + (with + { + tree_code code; + /* ((signed)a) < 0 -> a > SIGNED_MAX */ + /* ((signed)a) >= 0 -> a <= SIGNED_MAX */ + widest_int c1 = wi::mask<widest_int>(TYPE_PRECISION (type) - 1, 0); + tree_code ncmp = cmp == GE_EXPR ? LE_EXPR : GT_EXPR; + code = minmax_from_comparison (ncmp, @0, c1, wi::to_widest (@4)); + } + (if (ncmp == LE_EXPR + && code == MIN_EXPR + && wi::le_p (wi::to_wide (@3), + wi::to_wide (@4), + TYPE_SIGN (type))) + (min @2 @4) + (if (ncmp == GT_EXPR + && code == MAX_EXPR + && wi::ge_p (wi::to_wide (@3), + wi::to_wide (@4), + TYPE_SIGN (type))) + (max @2 @4))))))) + #if GIMPLE /* These patterns should be after min/max detection as simplifications of `(type)(zero_one ==/!= 0)` to `(type)(zero_one)` @@ -11872,6 +11927,59 @@ and, (if (full_perm_p) (vec_perm (op@3 @0 @1) @3 @2)))))) +/* Fold + x = VEC_PERM_EXPR <a, ANY, sel0>; + y = VEC_PERM_EXPR <ANY, b, sel0>; + c = VEC_PERM_EXPR <x, y, sel1>; + into + c = VEC_PERM_EXPR <a, b, sel0>; + if sel0 combined with sel1 denotes extracting a contiguous subvector from + the conceptual concatenated [ a | b ]. */ +(simplify + (vec_perm (view_convert? (vec_perm @0 @4 VECTOR_CST@2)) + (view_convert? (vec_perm @5 @1 VECTOR_CST@2)) + VECTOR_CST@3) + (with + { + bool can_fold = false; + unsigned HOST_WIDE_INT nelts; + vec_perm_builder builder; + if (TYPE_VECTOR_SUBPARTS (type).is_constant (&nelts) + && tree_to_vec_perm_builder (&builder, @2)) + { + /* Set can_fold to true when + - sel0 is a vector of consecutive indices. + - sel1 is composed of two parts of consecutive indices [ ia | ib ], + selecting the elements originally in 'a' and 'b', respectively. */ + vec_perm_indices sel0 (builder, 2, VECTOR_CST_NELTS (@2)); + unsigned int sel0_first_idx = sel0[0].to_constant (); + unsigned int elt_size = vector_element_bits (TREE_TYPE (@0)); + unsigned int ia_size = tree_to_uhwi (TYPE_SIZE (type)) + - elt_size * sel0_first_idx; + unsigned int ib_start; + if (sel0.series_p (0, 1, sel0_first_idx, 1) + && multiple_p (ia_size, vector_element_bits (type), &ib_start) + && tree_to_vec_perm_builder (&builder, @3)) + { + /* Check if the ib part contains consecutive indices starting from + 'nelts + ib_start'. */ + vec_perm_indices sel1 (builder, 2, VECTOR_CST_NELTS (@3)); + can_fold = sel1.series_p (ib_start, 1, nelts + ib_start, 1); + + /* Check if the ia part contains indices [0 ... ib_start - 1]. */ + if (can_fold) + for (unsigned int i = 0; i < ib_start; i++) + if (sel1[i].to_constant () != i) + { + can_fold = false; + break; + } + } + } + } + (if (can_fold) + (view_convert (vec_perm @0 @1 @2))))) + #if GIMPLE /* Simplify (a >> 1) + (b >> 1) + ((a | b) & 1) to .AVG_CEIL (a, b). Similar for (a | b) - ((a ^ b) >> 1). */ diff --git a/gcc/omp-low.cc b/gcc/omp-low.cc index 6b0135e..d36756e 100644 --- a/gcc/omp-low.cc +++ b/gcc/omp-low.cc @@ -3307,7 +3307,8 @@ check_omp_nesting_restrictions (gimple *stmt, omp_context *ctx) } else if (gimple_code (stmt) == GIMPLE_OMP_ATOMIC_LOAD || gimple_code (stmt) == GIMPLE_OMP_ATOMIC_STORE - || gimple_code (stmt) == GIMPLE_OMP_SCAN) + || gimple_code (stmt) == GIMPLE_OMP_SCAN + || gimple_code (stmt) == GIMPLE_OMP_STRUCTURED_BLOCK) return true; else if (gimple_code (stmt) == GIMPLE_OMP_FOR && gimple_omp_for_kind (ctx->stmt) == GF_OMP_FOR_KIND_SIMD) @@ -3337,7 +3338,8 @@ check_omp_nesting_restrictions (gimple *stmt, omp_context *ctx) && gimple_code (stmt) != GIMPLE_OMP_PARALLEL && (gimple_code (stmt) != GIMPLE_OMP_FOR || gimple_omp_for_kind (stmt) != GF_OMP_FOR_KIND_SIMD) - && gimple_code (stmt) != GIMPLE_OMP_SCAN) + && gimple_code (stmt) != GIMPLE_OMP_SCAN + && gimple_code (stmt) != GIMPLE_OMP_STRUCTURED_BLOCK) { if (ctx->loop_p) error_at (gimple_location (stmt), diff --git a/gcc/range-op.cc b/gcc/range-op.cc index 1f91066..6b6bf78 100644 --- a/gcc/range-op.cc +++ b/gcc/range-op.cc @@ -3103,8 +3103,9 @@ operator_cast::fold_range (irange &r, tree type ATTRIBUTE_UNUSED, int_range_max tmp; fold_pair (tmp, x, inner, outer); r.union_ (tmp); + // If we hit varying, go update the bitmask. if (r.varying_p ()) - return true; + break; } update_bitmask (r, inner, outer); @@ -3204,6 +3205,25 @@ operator_cast::op1_range (irange &r, tree type, } // And intersect with any known value passed in the extra operand. r.intersect (op2); + if (r.undefined_p ()) + return true; + + // Now create a bitmask indicating that the lower bit must match the + // bits in the LHS. Zero-extend LHS bitmask to precision of op1. + irange_bitmask bm = lhs.get_bitmask (); + wide_int mask = wide_int::from (bm.mask (), TYPE_PRECISION (type), + UNSIGNED); + wide_int value = wide_int::from (bm.value (), TYPE_PRECISION (type), + UNSIGNED); + + // Set then additonal unknown bits in mask. + wide_int lim = wi::mask (TYPE_PRECISION (lhs_type), true, + TYPE_PRECISION (type)); + mask = mask | lim; + + // Now set the new bitmask for the range. + irange_bitmask new_bm (value, mask); + r.update_bitmask (new_bm); return true; } @@ -3502,6 +3522,22 @@ operator_bitwise_and::wi_fold (irange &r, tree type, const wide_int &rh_lb, const wide_int &rh_ub) const { + // The AND algorithm does not handle complex signed operations well. + // If a signed range crosses the boundry between signed and unsigned + // proces sit as 2 ranges and union the results. + if (TYPE_SIGN (type) == SIGNED + && wi::neg_p (lh_lb, SIGNED) != wi::neg_p (lh_ub, SIGNED)) + { + int prec = TYPE_PRECISION (type); + int_range_max tmp; + // Process [lh_lb, -1] + wi_fold (tmp, type, lh_lb, wi::minus_one (prec), rh_lb, rh_ub); + // Now Process [0, rh_ub] + wi_fold (r, type, wi::zero (prec), lh_ub, rh_lb, rh_ub); + r.union_ (tmp); + return; + } + if (wi_optimize_and_or (r, BIT_AND_EXPR, type, lh_lb, lh_ub, rh_lb, rh_ub)) return; diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index eb21078..65fa7fa 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,79 @@ +2025-10-23 Robert Dubner <rdubner@symas.com> + + * cobol.dg/group2/Length_overflow__2_.out: Updated test result. + * cobol.dg/group2/Length_overflow_with_offset__1_.out: Likewise. + * cobol.dg/group2/Offset_overflow.out: Likewise. + * cobol.dg/group2/CALL_with_OCCURS_DEPENDING_ON.cob: New test. + * cobol.dg/group2/CALL_with_OCCURS_DEPENDING_ON.out: New test. + * cobol.dg/group2/CHAR_and_ORD_with_COLLATING_sequence_-_ASCII.cob: New test. + * cobol.dg/group2/CHAR_and_ORD_with_COLLATING_sequence_-_ASCII.out: New test. + * cobol.dg/group2/CHAR_and_ORD_with_COLLATING_sequence_-_EBCDIC.cob: New test. + * cobol.dg/group2/CHAR_and_ORD_with_COLLATING_sequence_-_EBCDIC.out: New test. + * cobol.dg/group2/EC-BOUND-REF-MOD_checking_process_termination.cob: New test. + * cobol.dg/group2/EC-BOUND-REF-MOD_checking_process_termination.out: New test. + * cobol.dg/group2/Intrinsics_without_FUNCTION_keyword__3_.cob: New test. + * cobol.dg/group2/Occurs_DEPENDING_ON__source_and_dest.cob: New test. + * cobol.dg/group2/Occurs_DEPENDING_ON__source_and_dest.out: New test. + * cobol.dg/group2/Recursive_subscripts.cob: New test. + * cobol.dg/group2/Recursive_subscripts.out: New test. + * cobol.dg/group2/SEARCH_ALL_with_OCCURS_DEPENDING_ON.cob: New test. + * cobol.dg/group2/SEARCH_ALL_with_OCCURS_DEPENDING_ON.out: New test. + * cobol.dg/group2/Subscript_by_arithmetic_expression.cob: New test. + * cobol.dg/group2/Subscript_out_of_bounds__1_.cob: New test. + * cobol.dg/group2/Subscript_out_of_bounds__1_.out: New test. + * cobol.dg/group2/Subscript_out_of_bounds__2_.cob: New test. + * cobol.dg/group2/Subscript_out_of_bounds__2_.out: New test. + * cobol.dg/group2/Subscripted_refmods.cob: New test. + * cobol.dg/group2/Subscripted_refmods.out: New test. + * cobol.dg/group2/length_of_ODO_Rules_7__8A__and_8B.cob: New test. + * cobol.dg/group2/length_of_ODO_Rules_7__8A__and_8B.out: New test. + * cobol.dg/group2/length_of_ODO_w_-_reference_modification.cob: New test. + +2025-10-23 Andrew Pinski <andrew.pinski@oss.qualcomm.com> + + * gcc.dg/tree-ssa/bool-12.c: Update based on when BIT_AND/BIT_IOR + is created and no longer MIN/MAX. + +2025-10-23 Robert Dubner <rdubner@symas.com> + James K. Lowden <jklowden@cobolworx.com> + + * cobol.dg/typo-1.cob: New test for squiggles and carets. + +2025-10-23 Alfie Richards <alfie.richards@arm.com> + + * gcc.target/aarch64/fmv_priority1.c: New test. + * gcc.target/aarch64/fmv_priority2.c: New test. + * gcc.target/aarch64/fmv_priority.in: Support file. + +2025-10-23 Alfie Richards <alfie.richards@arm.com> + + PR target/122190 + * gcc.target/aarch64/pr122190.c: New test + +2025-10-23 zhaozhou <zhaozhou@loongson.cn> + + * gcc.dg/fold-round-1.c: New test. + +2025-10-23 Christophe Lyon <christophe.lyon@linaro.org> + + PR target/122223 + * gcc.target/arm/mve/intrinsics/pr122223.c: Relax expected code. + +2025-10-23 liuhongt <hongtao.liu@intel.com> + + * gcc.target/i386/pr101639_reduc_mask_vdi.c: New test. + * gcc.target/i386/pr101639_reduc_mask_vqi.c: New test. + * gcc.target/i386/pr101639_reduc_mask_vsi.c: New test. + * gcc.target/i386/pr101639_reduc_mask_ior_vqi.c: New test. + * gcc.target/i386/pr101639_reduc_mask_and_vqi.c: New test. + +2025-10-23 liuhongt <hongtao.liu@intel.com> + + * gcc.target/i386/pr101639_reduc_mask_di.c: New test. + * gcc.target/i386/pr101639_reduc_mask_hi.c: New test. + * gcc.target/i386/pr101639_reduc_mask_qi.c: New test. + * gcc.target/i386/pr101639_reduc_mask_si.c: New test. + 2025-10-22 Paul-Antoine Arras <parras@baylibre.com> PR middle-end/122378 diff --git a/gcc/testsuite/c-c++-common/gomp/pr121452-1.c b/gcc/testsuite/c-c++-common/gomp/pr121452-1.c new file mode 100644 index 0000000..d605919 --- /dev/null +++ b/gcc/testsuite/c-c++-common/gomp/pr121452-1.c @@ -0,0 +1,17 @@ +/* { dg-do compile } */ +/* { dg-additional-options "-fdump-tree-original" } */ + +/* Check that the OMP_STRUCTURED_BLOCK that wraps intervening code is accepted. + */ + +void f(int *A, int *B, int *C) +{ + #pragma omp for simd collapse(2) + for (int i=0; i < 1; i++) { + for (int j=0; j < 1; j++) + A[i] += B[j]; + C[i] = 4; + } +} + +/* { dg-final { scan-tree-dump "#pragma omp __structured_block" "original" } } */ diff --git a/gcc/testsuite/c-c++-common/gomp/pr121452-2.c b/gcc/testsuite/c-c++-common/gomp/pr121452-2.c new file mode 100644 index 0000000..35fb1c1 --- /dev/null +++ b/gcc/testsuite/c-c++-common/gomp/pr121452-2.c @@ -0,0 +1,17 @@ +/* { dg-do compile } */ +/* { dg-additional-options "-fdump-tree-original" } */ + +/* Check that the OMP_STRUCTURED_BLOCK that wraps intervening code is accepted. + */ + +void f(int *A, int *B, int *C) +{ + #pragma omp loop bind(teams) order(concurrent) collapse(2) + for (int i=0; i < 1; i++) { + for (int j=0; j < 1; j++) + A[i] += B[j]; + C[i] = 4; + } +} + +/* { dg-final { scan-tree-dump "#pragma omp __structured_block" "original" } } */ diff --git a/gcc/testsuite/cobol.dg/group2/CALL_with_OCCURS_DEPENDING_ON.cob b/gcc/testsuite/cobol.dg/group2/CALL_with_OCCURS_DEPENDING_ON.cob new file mode 100644 index 0000000..c1b3b5f1b --- /dev/null +++ b/gcc/testsuite/cobol.dg/group2/CALL_with_OCCURS_DEPENDING_ON.cob @@ -0,0 +1,37 @@ + *> { dg-do run } + *> { dg-output-file "group2/CALL_with_OCCURS_DEPENDING_ON.out" } + + IDENTIFICATION DIVISION. + PROGRAM-ID. prog-main. + + DATA DIVISION. + WORKING-STORAGE SECTION. + 01 parm. + 03 parm-size PIC S999 COMP. + 03 parm-str. + 05 parm-char PIC X OCCURS 0 TO 100 TIMES + DEPENDING ON parm-size. + + PROCEDURE DIVISION. + MOVE 10 TO parm-size + MOVE "Hi, there!" TO parm-str + CALL "prog" USING parm + . + END PROGRAM prog-main. + + IDENTIFICATION DIVISION. + PROGRAM-ID. prog. + + DATA DIVISION. + LINKAGE SECTION. + 01 parm. + 03 parm-size PIC S999 COMP. + 03 parm-str. + 05 parm-char PIC X OCCURS 0 TO 100 TIMES + DEPENDING ON parm-size. + + PROCEDURE DIVISION USING parm. + DISPLAY FUNCTION TRIM(parm-str) WITH NO ADVANCING + . + END PROGRAM prog. + diff --git a/gcc/testsuite/cobol.dg/group2/CALL_with_OCCURS_DEPENDING_ON.out b/gcc/testsuite/cobol.dg/group2/CALL_with_OCCURS_DEPENDING_ON.out new file mode 100644 index 0000000..bd79118 --- /dev/null +++ b/gcc/testsuite/cobol.dg/group2/CALL_with_OCCURS_DEPENDING_ON.out @@ -0,0 +1 @@ +Hi, there! diff --git a/gcc/testsuite/cobol.dg/group2/CHAR_and_ORD_with_COLLATING_sequence_-_ASCII.cob b/gcc/testsuite/cobol.dg/group2/CHAR_and_ORD_with_COLLATING_sequence_-_ASCII.cob new file mode 100644 index 0000000..fddd1fb --- /dev/null +++ b/gcc/testsuite/cobol.dg/group2/CHAR_and_ORD_with_COLLATING_sequence_-_ASCII.cob @@ -0,0 +1,26 @@ + *> { dg-do run } + *> { dg-output-file "group2/CHAR_and_ORD_with_COLLATING_sequence_-_ASCII.out" } + IDENTIFICATION DIVISION. + PROGRAM-ID. prog. + ENVIRONMENT DIVISION. + CONFIGURATION SECTION. + OBJECT-COMPUTER. + GNU-Linux + PROGRAM COLLATING SEQUENCE IS THE-WILD-ONE. + SPECIAL-NAMES. + ALPHABET + THE-WILD-ONE IS "A" THRU "H" "I" ALSO "J", ALSO "K", ALSO + "L" ALSO "M" ALSO "N" "O" THROUGH "Z" "0" THRU "9". + PROCEDURE DIVISION. + DISPLAY LOW-VALUE + DISPLAY HIGH-VALUE + DISPLAY FUNCTION CHAR(1). + DISPLAY FUNCTION CHAR(9). + DISPLAY FUNCTION CHAR(10). + DISPLAY FUNCTION ORD("A") + DISPLAY FUNCTION ORD("I") + DISPLAY FUNCTION ORD("J") + DISPLAY FUNCTION ORD("K") + DISPLAY FUNCTION ORD("O") + GOBACK. + diff --git a/gcc/testsuite/cobol.dg/group2/CHAR_and_ORD_with_COLLATING_sequence_-_ASCII.out b/gcc/testsuite/cobol.dg/group2/CHAR_and_ORD_with_COLLATING_sequence_-_ASCII.out new file mode 100644 index 0000000..655f8ae --- /dev/null +++ b/gcc/testsuite/cobol.dg/group2/CHAR_and_ORD_with_COLLATING_sequence_-_ASCII.out @@ -0,0 +1,11 @@ +A +9 +A +I +O +1 +9 +9 +9 +10 + diff --git a/gcc/testsuite/cobol.dg/group2/CHAR_and_ORD_with_COLLATING_sequence_-_EBCDIC.cob b/gcc/testsuite/cobol.dg/group2/CHAR_and_ORD_with_COLLATING_sequence_-_EBCDIC.cob new file mode 100644 index 0000000..f6f6bbc --- /dev/null +++ b/gcc/testsuite/cobol.dg/group2/CHAR_and_ORD_with_COLLATING_sequence_-_EBCDIC.cob @@ -0,0 +1,27 @@ + *> { dg-do run } + *> { dg-options "-finternal-ebcdic" } + *> { dg-output-file "group2/CHAR_and_ORD_with_COLLATING_sequence_-_EBCDIC.out" } + IDENTIFICATION DIVISION. + PROGRAM-ID. prog. + ENVIRONMENT DIVISION. + CONFIGURATION SECTION. + OBJECT-COMPUTER. + GNU-Linux + PROGRAM COLLATING SEQUENCE IS THE-WILD-ONE. + SPECIAL-NAMES. + ALPHABET + THE-WILD-ONE IS "A" THRU "H" "I" ALSO "J", ALSO "K", ALSO + "L" ALSO "M" ALSO "N" "O" THROUGH "Z" "0" THRU "9". + PROCEDURE DIVISION. + DISPLAY LOW-VALUE + DISPLAY HIGH-VALUE + DISPLAY FUNCTION CHAR(1). + DISPLAY FUNCTION CHAR(9). + DISPLAY FUNCTION CHAR(10). + DISPLAY FUNCTION ORD("A") + DISPLAY FUNCTION ORD("I") + DISPLAY FUNCTION ORD("J") + DISPLAY FUNCTION ORD("K") + DISPLAY FUNCTION ORD("O") + GOBACK. + diff --git a/gcc/testsuite/cobol.dg/group2/CHAR_and_ORD_with_COLLATING_sequence_-_EBCDIC.out b/gcc/testsuite/cobol.dg/group2/CHAR_and_ORD_with_COLLATING_sequence_-_EBCDIC.out new file mode 100644 index 0000000..655f8ae --- /dev/null +++ b/gcc/testsuite/cobol.dg/group2/CHAR_and_ORD_with_COLLATING_sequence_-_EBCDIC.out @@ -0,0 +1,11 @@ +A +9 +A +I +O +1 +9 +9 +9 +10 + diff --git a/gcc/testsuite/cobol.dg/group2/EC-BOUND-REF-MOD_checking_process_termination.cob b/gcc/testsuite/cobol.dg/group2/EC-BOUND-REF-MOD_checking_process_termination.cob new file mode 100644 index 0000000..ecb38d2 --- /dev/null +++ b/gcc/testsuite/cobol.dg/group2/EC-BOUND-REF-MOD_checking_process_termination.cob @@ -0,0 +1,41 @@ + *> { dg-do run } + *> { dg-xfail-run-if "" { *-*-* } } + *> { dg-output-file "group2/EC-BOUND-REF-MOD_checking_process_termination.out" } + identification division. + program-id. caller. + data division. + working-storage section. + 77 str pic x(4) value "abcd". + procedure division. + display "sending str " str + call "prog1" using str. + display "returned str " str + call "prog2" using str. + display "returned str " str + goback. + + identification division. + program-id. prog1. + data division. + linkage section. + 01 str pic x any length. + procedure division using str. + move '4' to str(5:1) + display "We should get here, because there is no checking" + goback. + end program prog1. + + >>turn ec-all checking on + identification division. + program-id. prog2. + data division. + linkage section. + 01 str pic x any length. + procedure division using str. + move '4' to str(5:1) + display "I don't think we should get here?" + goback. + end program prog2. + + end program caller. + diff --git a/gcc/testsuite/cobol.dg/group2/EC-BOUND-REF-MOD_checking_process_termination.out b/gcc/testsuite/cobol.dg/group2/EC-BOUND-REF-MOD_checking_process_termination.out new file mode 100644 index 0000000..5e497b6 --- /dev/null +++ b/gcc/testsuite/cobol.dg/group2/EC-BOUND-REF-MOD_checking_process_termination.out @@ -0,0 +1,4 @@ +sending str abcd +We should get here, because there is no checking +returned str abcd + diff --git a/gcc/testsuite/cobol.dg/group2/Intrinsics_without_FUNCTION_keyword__3_.cob b/gcc/testsuite/cobol.dg/group2/Intrinsics_without_FUNCTION_keyword__3_.cob new file mode 100644 index 0000000..39a0c5b --- /dev/null +++ b/gcc/testsuite/cobol.dg/group2/Intrinsics_without_FUNCTION_keyword__3_.cob @@ -0,0 +1,17 @@ + *> { dg-do run } + + IDENTIFICATION DIVISION. + PROGRAM-ID. prog. + ENVIRONMENT DIVISION. + CONFIGURATION SECTION. + REPOSITORY. + FUNCTION PI INTRINSIC + FUNCTION E INTRINSIC. + DATA DIVISION. + WORKING-STORAGE SECTION. + 01 Z PIC 99V99. + PROCEDURE DIVISION. + MOVE PI TO Z. + MOVE E TO Z. + STOP RUN. + diff --git a/gcc/testsuite/cobol.dg/group2/Length_overflow__2_.out b/gcc/testsuite/cobol.dg/group2/Length_overflow__2_.out index f2ad6c7..78981922 100644 --- a/gcc/testsuite/cobol.dg/group2/Length_overflow__2_.out +++ b/gcc/testsuite/cobol.dg/group2/Length_overflow__2_.out @@ -1 +1 @@ -c +a diff --git a/gcc/testsuite/cobol.dg/group2/Length_overflow_with_offset__1_.out b/gcc/testsuite/cobol.dg/group2/Length_overflow_with_offset__1_.out index f2ad6c7..78981922 100644 --- a/gcc/testsuite/cobol.dg/group2/Length_overflow_with_offset__1_.out +++ b/gcc/testsuite/cobol.dg/group2/Length_overflow_with_offset__1_.out @@ -1 +1 @@ -c +a diff --git a/gcc/testsuite/cobol.dg/group2/Occurs_DEPENDING_ON__source_and_dest.cob b/gcc/testsuite/cobol.dg/group2/Occurs_DEPENDING_ON__source_and_dest.cob new file mode 100644 index 0000000..33d8c11 --- /dev/null +++ b/gcc/testsuite/cobol.dg/group2/Occurs_DEPENDING_ON__source_and_dest.cob @@ -0,0 +1,48 @@ + *> { dg-do run } + *> { dg-output-file "group2/Occurs_DEPENDING_ON__source_and_dest.out" } + identification division. + program-id. prog. + data division. + working-storage section. + 01 table1d value "1234567890". + 02 table1 pic x occurs 0 to 10 times depending on table1do. + + 01 table2d value "1234567890". + 02 table2 pic x occurs 0 to 10 times depending on table2do. + + 01 table3d. + 02 table3do pic 99. + 02 table3dd. + 03 table3 pic x occurs 0 to 10 times depending on table3do. + + 77 table1do pic 99. + 77 table2do pic 99. + 77 n pic 99. + procedure division. + display "Test1: Demonstrate ODO limits:" + perform varying n from 0 by 1 until n > 10 + move n to table1do + display n space """"table1d"""" + end-perform + + display "Test2: result should be ABC4567890" + move 3 to table2do + move "ABCDEFGHIJ" to table2d + move 10 to table2do + display " result is "table2d + + display "Test3A: result should be 05ABCDE" + move "05ABCDEFGHIJ" to table3d + display " result is "table3d + move 10 to table3do + display "Test3B: result should be 10ABCDEFGHIJ" + display " result is "table3d + + display "Test4: result should be 10lmnopqGHIJ" + move 6 to table3do + move "lmnopqrstu" to table3dd + move 10 to table3do + display " result is "table3d + + goback. + diff --git a/gcc/testsuite/cobol.dg/group2/Occurs_DEPENDING_ON__source_and_dest.out b/gcc/testsuite/cobol.dg/group2/Occurs_DEPENDING_ON__source_and_dest.out new file mode 100644 index 0000000..4c59c65 --- /dev/null +++ b/gcc/testsuite/cobol.dg/group2/Occurs_DEPENDING_ON__source_and_dest.out @@ -0,0 +1,21 @@ +Test1: Demonstrate ODO limits: +00 "" +01 "1" +02 "12" +03 "123" +04 "1234" +05 "12345" +06 "123456" +07 "1234567" +08 "12345678" +09 "123456789" +10 "1234567890" +Test2: result should be ABC4567890 + result is ABC4567890 +Test3A: result should be 05ABCDE + result is 05ABCDE +Test3B: result should be 10ABCDEFGHIJ + result is 10ABCDEFGHIJ +Test4: result should be 10lmnopqGHIJ + result is 10lmnopqGHIJ + diff --git a/gcc/testsuite/cobol.dg/group2/Offset_overflow.out b/gcc/testsuite/cobol.dg/group2/Offset_overflow.out index 7ed6ff8..78981922 100644 --- a/gcc/testsuite/cobol.dg/group2/Offset_overflow.out +++ b/gcc/testsuite/cobol.dg/group2/Offset_overflow.out @@ -1 +1 @@ -5 +a diff --git a/gcc/testsuite/cobol.dg/group2/Recursive_subscripts.cob b/gcc/testsuite/cobol.dg/group2/Recursive_subscripts.cob new file mode 100644 index 0000000..c2efd57 --- /dev/null +++ b/gcc/testsuite/cobol.dg/group2/Recursive_subscripts.cob @@ -0,0 +1,27 @@ + *> { dg-do run } + *> { dg-output-file "group2/Recursive_subscripts.out" } + + identification division. + program-id. pmain. + data division. + working-storage section. + 01 filler. + 02 tabl-values pic x(9) value "234567890". + 02 v redefines tabl-values occurs 9 pic 9. + procedure division. + display v(1) " should be 2" + display v(v(1)) " should be 3" + display v(v(v(1))) " should be 4" + display v(v(v(v(1)))) " should be 5" + display v(v(v(v(v(1))))) " should be 6" + display v(v(v(v(v(v(1)))))) " should be 7" + display v(v(v(v(v(v(v(1))))))) " should be 8" + display v(v(v(v(v(v(v(v(1)))))))) " should be 9" + + display v(v(v(v(v(v(v(v(v(1))))))))) " should be 0" + move 1 to v(v(v(v(v(v(v(v(v(1))))))))) + display v(v(v(v(v(v(v(v(v(1))))))))) " should be 1" + + goback. + end program pmain. + diff --git a/gcc/testsuite/cobol.dg/group2/Recursive_subscripts.out b/gcc/testsuite/cobol.dg/group2/Recursive_subscripts.out new file mode 100644 index 0000000..2fa81d4 --- /dev/null +++ b/gcc/testsuite/cobol.dg/group2/Recursive_subscripts.out @@ -0,0 +1,11 @@ +2 should be 2 +3 should be 3 +4 should be 4 +5 should be 5 +6 should be 6 +7 should be 7 +8 should be 8 +9 should be 9 +0 should be 0 +1 should be 1 + diff --git a/gcc/testsuite/cobol.dg/group2/SEARCH_ALL_with_OCCURS_DEPENDING_ON.cob b/gcc/testsuite/cobol.dg/group2/SEARCH_ALL_with_OCCURS_DEPENDING_ON.cob new file mode 100644 index 0000000..097fa77 --- /dev/null +++ b/gcc/testsuite/cobol.dg/group2/SEARCH_ALL_with_OCCURS_DEPENDING_ON.cob @@ -0,0 +1,42 @@ + *> { dg-do run } + *> { dg-output-file "group2/SEARCH_ALL_with_OCCURS_DEPENDING_ON.out" } + + IDENTIFICATION DIVISION. + PROGRAM-ID. prog. + DATA DIVISION. + WORKING-STORAGE SECTION. + * + 77 SCREEN-AKT PIC 9(02) VALUE 0. + 01 SCREEN-TAB. + 03 SCREEN-ENTRY OCCURS 0 TO 20 + DEPENDING ON SCREEN-AKT + ASCENDING KEY SCREEN-NAME + INDEXED BY SCREEN-IDX. + 05 SCREEN-NAME PIC X(02). + + PROCEDURE DIVISION. + + SEARCH ALL SCREEN-ENTRY + AT END + DISPLAY 'END' + WHEN SCREEN-NAME (SCREEN-IDX) = 'AB' + DISPLAY 'FOUND' + END-SEARCH + MOVE 1 TO SCREEN-AKT + MOVE 'AB' TO SCREEN-NAME (1) + SEARCH ALL SCREEN-ENTRY + AT END + DISPLAY 'END' + WHEN SCREEN-NAME (SCREEN-IDX) = 'AB' + DISPLAY 'FOUND' + END-SEARCH + MOVE 2 TO SCREEN-AKT + MOVE 'CD' TO SCREEN-NAME (2) + SEARCH ALL SCREEN-ENTRY + AT END + DISPLAY 'END' + WHEN SCREEN-NAME (SCREEN-IDX) = 'CD' + DISPLAY 'FOUND' + END-SEARCH + EXIT PROGRAM. + diff --git a/gcc/testsuite/cobol.dg/group2/SEARCH_ALL_with_OCCURS_DEPENDING_ON.out b/gcc/testsuite/cobol.dg/group2/SEARCH_ALL_with_OCCURS_DEPENDING_ON.out new file mode 100644 index 0000000..47a32dd --- /dev/null +++ b/gcc/testsuite/cobol.dg/group2/SEARCH_ALL_with_OCCURS_DEPENDING_ON.out @@ -0,0 +1,4 @@ +END +FOUND +FOUND + diff --git a/gcc/testsuite/cobol.dg/group2/Subscript_by_arithmetic_expression.cob b/gcc/testsuite/cobol.dg/group2/Subscript_by_arithmetic_expression.cob new file mode 100644 index 0000000..b9851d4 --- /dev/null +++ b/gcc/testsuite/cobol.dg/group2/Subscript_by_arithmetic_expression.cob @@ -0,0 +1,22 @@ + *> { dg-do run } + + IDENTIFICATION DIVISION. + PROGRAM-ID. prog. + DATA DIVISION. + WORKING-STORAGE SECTION. + 01 G VALUE "1234". + 02 X PIC X OCCURS 4. + 01 Z PIC X. + PROCEDURE DIVISION. + MOVE X((3 + 1) / 2) TO Z. + IF Z NOT = "2" + DISPLAY Z + END-DISPLAY + END-IF. + MOVE X(2 ** 2) TO Z. + IF Z NOT = "4" + DISPLAY Z + END-DISPLAY + END-IF. + STOP RUN. + diff --git a/gcc/testsuite/cobol.dg/group2/Subscript_out_of_bounds__1_.cob b/gcc/testsuite/cobol.dg/group2/Subscript_out_of_bounds__1_.cob new file mode 100644 index 0000000..828f81c --- /dev/null +++ b/gcc/testsuite/cobol.dg/group2/Subscript_out_of_bounds__1_.cob @@ -0,0 +1,17 @@ + *> { dg-do run } + *> { dg-xfail-run-if "" { *-*-* } } + *> { dg-output-file "group2/Subscript_out_of_bounds__1_.out" } + + IDENTIFICATION DIVISION. + PROGRAM-ID. prog. + DATA DIVISION. + WORKING-STORAGE SECTION. + 01 G. + 02 X PIC X OCCURS 10. + 01 I PIC 9 VALUE 0. + PROCEDURE DIVISION. + >>TURN EC-ALL CHECKING ON + DISPLAY """" X(I) """" + END-DISPLAY. + STOP RUN. + diff --git a/gcc/testsuite/cobol.dg/group2/Subscript_out_of_bounds__1_.out b/gcc/testsuite/cobol.dg/group2/Subscript_out_of_bounds__1_.out new file mode 100644 index 0000000..f66f772 --- /dev/null +++ b/gcc/testsuite/cobol.dg/group2/Subscript_out_of_bounds__1_.out @@ -0,0 +1,2 @@ +" " + diff --git a/gcc/testsuite/cobol.dg/group2/Subscript_out_of_bounds__2_.cob b/gcc/testsuite/cobol.dg/group2/Subscript_out_of_bounds__2_.cob new file mode 100644 index 0000000..d7ae196 --- /dev/null +++ b/gcc/testsuite/cobol.dg/group2/Subscript_out_of_bounds__2_.cob @@ -0,0 +1,17 @@ + *> { dg-do run } + *> { dg-xfail-run-if "" { *-*-* } } + *> { dg-output-file "group2/Subscript_out_of_bounds__2_.out" } + + IDENTIFICATION DIVISION. + PROGRAM-ID. prog. + DATA DIVISION. + WORKING-STORAGE SECTION. + 01 G. + 02 X PIC X OCCURS 10. + 01 I PIC 99 VALUE 11. + PROCEDURE DIVISION. + >>TURN EC-ALL CHECKING ON + DISPLAY """" X(I) """" + END-DISPLAY. + STOP RUN. + diff --git a/gcc/testsuite/cobol.dg/group2/Subscript_out_of_bounds__2_.out b/gcc/testsuite/cobol.dg/group2/Subscript_out_of_bounds__2_.out new file mode 100644 index 0000000..f66f772 --- /dev/null +++ b/gcc/testsuite/cobol.dg/group2/Subscript_out_of_bounds__2_.out @@ -0,0 +1,2 @@ +" " + diff --git a/gcc/testsuite/cobol.dg/group2/Subscripted_refmods.cob b/gcc/testsuite/cobol.dg/group2/Subscripted_refmods.cob new file mode 100644 index 0000000..c69a6e7 --- /dev/null +++ b/gcc/testsuite/cobol.dg/group2/Subscripted_refmods.cob @@ -0,0 +1,16 @@ + *> { dg-do run } + *> { dg-output-file "group2/Subscripted_refmods.out" } + + identification division. + program-id. pmain. + data division. + working-storage section. + 01 filler. + 02 tabl-values pic x(9) value "123456789". + 02 v redefines tabl-values occurs 9 pic 9. + procedure division. + display tabl-values( 3:4 ) " should be 3456" + display tabl-values( v(3):v(4) ) " should be 3456" + goback. + end program pmain. + diff --git a/gcc/testsuite/cobol.dg/group2/Subscripted_refmods.out b/gcc/testsuite/cobol.dg/group2/Subscripted_refmods.out new file mode 100644 index 0000000..4c69c3a --- /dev/null +++ b/gcc/testsuite/cobol.dg/group2/Subscripted_refmods.out @@ -0,0 +1,3 @@ +3456 should be 3456 +3456 should be 3456 + diff --git a/gcc/testsuite/cobol.dg/group2/length_of_ODO_Rules_7__8A__and_8B.cob b/gcc/testsuite/cobol.dg/group2/length_of_ODO_Rules_7__8A__and_8B.cob new file mode 100644 index 0000000..4b9e55d --- /dev/null +++ b/gcc/testsuite/cobol.dg/group2/length_of_ODO_Rules_7__8A__and_8B.cob @@ -0,0 +1,76 @@ + *> { dg-do run } + *> { dg-output-file "group2/length_of_ODO_Rules_7__8A__and_8B.out" } + + identification division. + program-id. prog. + procedure division. + call "prog1" + call "prog2" + call "prog3" + goback. + end program prog. + + identification division. + program-id. prog1. + data division. + working-storage section. + 01 depl pic 9. + 01 digtab. + 05 digitgrp. + 10 digits occurs 1 to 9 depending on depl pic x. + procedure division. + display "Demonstrates 13.18.38.4 OCCURS General rules 7)" + display "depl is completely separate" + display "output should be ""12345 """ + move 9 to depl + move space to digtab + move 5 to depl + move "123456789" to digtab + move 9 to depl + display """" digtab """" + goback. + end program prog1. + + identification division. + program-id. prog2. + data division. + working-storage section. + 01 digtab. + 05 depl pic 9. + 05 digitgrp. + 10 digits occurs 1 to 9 depending on depl pic x. + procedure division. + display "Demonstrates 13.18.38.4 OCCURS General rules 8a)" + display "depl is not subordinate to digitgrp" + display "output should be ""12345 """ + move 9 to depl + move space to digtab + move 5 to depl + move "123456789" to digitgrp + move 9 to depl + display """" digitgrp """" + goback. + end program prog2. + + identification division. + program-id. prog3. + data division. + working-storage section. + 01 digtab. + 05 depl pic 9. + 05 digitgrp. + 10 digits occurs 1 to 9 depending on depl pic x. + procedure division. + display "Demonstrates 13.18.38.4 OCCURS General rules 8b)" + display "depl is subordinate to digtab" + display "output should be ""123"" followed by ""123456789""" + move 9 to depl + move space to digtab + move 5 to depl + move "3123456789" to digtab + display """" digitgrp """" + move 9 to depl + display """" digitgrp """" + goback. + end program prog3. + diff --git a/gcc/testsuite/cobol.dg/group2/length_of_ODO_Rules_7__8A__and_8B.out b/gcc/testsuite/cobol.dg/group2/length_of_ODO_Rules_7__8A__and_8B.out new file mode 100644 index 0000000..6c6e906 --- /dev/null +++ b/gcc/testsuite/cobol.dg/group2/length_of_ODO_Rules_7__8A__and_8B.out @@ -0,0 +1,14 @@ +Demonstrates 13.18.38.4 OCCURS General rules 7) +depl is completely separate +output should be "12345 " +"12345 " +Demonstrates 13.18.38.4 OCCURS General rules 8a) +depl is not subordinate to digitgrp +output should be "12345 " +"12345 " +Demonstrates 13.18.38.4 OCCURS General rules 8b) +depl is subordinate to digtab +output should be "123" followed by "123456789" +"123" +"123456789" + diff --git a/gcc/testsuite/cobol.dg/group2/length_of_ODO_w_-_reference_modification.cob b/gcc/testsuite/cobol.dg/group2/length_of_ODO_w_-_reference_modification.cob new file mode 100644 index 0000000..37afe0b --- /dev/null +++ b/gcc/testsuite/cobol.dg/group2/length_of_ODO_w_-_reference_modification.cob @@ -0,0 +1,47 @@ + *> { dg-do run } + + IDENTIFICATION DIVISION. + PROGRAM-ID. prog. + DATA DIVISION. + WORKING-STORAGE SECTION. + 01 PLINE. + 03 PLINE-LEN PIC S9(4) COMP-5. + 03 PLINE-TEXT. + 04 FILLER PIC X(1) OCCURS 1 TO 80 + DEPENDING ON PLINE-LEN. + procedure division. + a-main section. + MOVE 5 TO PLINE-LEN + MOVE 'the first part in' TO PLINE-TEXT + MOVE 30 TO PLINE-LEN + IF PLINE-TEXT NOT = 'the f' + DISPLAY 'text1 wrong: ' PLINE-TEXT + END-DISPLAY + END-IF + MOVE 'the first part in' TO PLINE-TEXT + MOVE 4 TO PLINE-LEN + MOVE 'second' TO PLINE-TEXT + MOVE 14 TO PLINE-LEN + IF PLINE-TEXT NOT = 'secofirst part' + DISPLAY 'text2 wrong: ' PLINE-TEXT + END-DISPLAY + END-IF + MOVE 80 TO PLINE-LEN + MOVE SPACES TO PLINE-TEXT + MOVE 5 TO PLINE-LEN + MOVE 'the first part in' TO PLINE-TEXT (2:) + MOVE 30 TO PLINE-LEN + IF PLINE-TEXT NOT = ' the ' + DISPLAY 'text3 wrong: ' PLINE-TEXT + END-DISPLAY + END-IF + MOVE 'the first part in' TO PLINE-TEXT (2:) + MOVE 4 TO PLINE-LEN + MOVE 'second' TO PLINE-TEXT (2:) + MOVE 14 TO PLINE-LEN + IF PLINE-TEXT NOT = ' sec first par' + DISPLAY 'text4 wrong: ' PLINE-TEXT + END-DISPLAY + END-IF + STOP RUN. + diff --git a/gcc/testsuite/cobol.dg/typo-1.cob b/gcc/testsuite/cobol.dg/typo-1.cob new file mode 100644 index 0000000..a806863 --- /dev/null +++ b/gcc/testsuite/cobol.dg/typo-1.cob @@ -0,0 +1,15 @@ +*> { dg-options "-fdiagnostics-show-caret" } +*> { dg-do compile } + + identification division. + porgram-id. hello. *> { dg-error "8: syntax error, unexpected NAME, expecting FUNCTION or PROGRAM-ID" } + procedure division. + display "Hello World!". + stop run. + +*<< +{ dg-begin-multiline-output "" } + porgram-id. hello. + ^~~~~~~~~~~ +{ dg-end-multiline-output "" } +*>> diff --git a/gcc/testsuite/gcc.dg/c23-static-assert-5.c b/gcc/testsuite/gcc.dg/c23-static-assert-5.c new file mode 100644 index 0000000..2edc6b7 --- /dev/null +++ b/gcc/testsuite/gcc.dg/c23-static-assert-5.c @@ -0,0 +1,69 @@ +/* Test C2y static assertions in expressions: -pedantic warnings for C23. */ +/* { dg-do compile } */ +/* { dg-options "-std=c23 -pedantic" } */ + +/* Old forms of static assertion still valid. */ +static_assert (1); +static_assert (2, "message" ); +struct s { int a; static_assert (3); }; + +void +f () +{ + static_assert (4); + label: + static_assert (5); + for (static_assert (6);;) + ; +} + +/* Test new forms of static assertion. */ +void +g () +{ + (void) 0, static_assert (7), (void) 0; /* { dg-warning "ISO C does not support static assertions in expressions before C2Y" } */ + extern typeof (static_assert (8)) f (); /* { dg-warning "ISO C does not support static assertions in expressions before C2Y" } */ + 1 + ? static_assert (9) /* { dg-warning "ISO C does not support static assertions in expressions before C2Y" } */ + : static_assert (10); /* { dg-warning "ISO C does not support static assertions in expressions before C2Y" } */ + if (1) + static_assert (11); /* { dg-warning "ISO C does not support static assertions in expressions before C2Y" } */ + else + static_assert (12); /* { dg-warning "ISO C does not support static assertions in expressions before C2Y" } */ + for (;;) + static_assert (13); /* { dg-warning "ISO C does not support static assertions in expressions before C2Y" } */ + while (true) + static_assert (14); /* { dg-warning "ISO C does not support static assertions in expressions before C2Y" } */ + do + static_assert (15); /* { dg-warning "ISO C does not support static assertions in expressions before C2Y" } */ + while (false); + switch (16) + static_assert (17); /* { dg-warning "ISO C does not support static assertions in expressions before C2Y" } */ + (void) static_assert (18); /* { dg-warning "ISO C does not support static assertions in expressions before C2Y" } */ + (static_assert (19)); /* { dg-warning "ISO C does not support static assertions in expressions before C2Y" } */ +} + +void +g2 () +{ + (void) 0, static_assert (7, "message"), (void) 0; /* { dg-warning "ISO C does not support static assertions in expressions before C2Y" } */ + extern typeof (static_assert (8, "message")) f (); /* { dg-warning "ISO C does not support static assertions in expressions before C2Y" } */ + 1 + ? static_assert (9, "message") /* { dg-warning "ISO C does not support static assertions in expressions before C2Y" } */ + : static_assert (10, "message"); /* { dg-warning "ISO C does not support static assertions in expressions before C2Y" } */ + if (1) + static_assert (11, "message"); /* { dg-warning "ISO C does not support static assertions in expressions before C2Y" } */ + else + static_assert (12, "message"); /* { dg-warning "ISO C does not support static assertions in expressions before C2Y" } */ + for (;;) + static_assert (13, "message"); /* { dg-warning "ISO C does not support static assertions in expressions before C2Y" } */ + while (true) + static_assert (14, "message"); /* { dg-warning "ISO C does not support static assertions in expressions before C2Y" } */ + do + static_assert (15, "message"); /* { dg-warning "ISO C does not support static assertions in expressions before C2Y" } */ + while (false); + switch (16) + static_assert (17, "message"); /* { dg-warning "ISO C does not support static assertions in expressions before C2Y" } */ + (void) static_assert (18, "message"); /* { dg-warning "ISO C does not support static assertions in expressions before C2Y" } */ + (static_assert (19, "message")); /* { dg-warning "ISO C does not support static assertions in expressions before C2Y" } */ +} diff --git a/gcc/testsuite/gcc.dg/c23-static-assert-6.c b/gcc/testsuite/gcc.dg/c23-static-assert-6.c new file mode 100644 index 0000000..43e0b27 --- /dev/null +++ b/gcc/testsuite/gcc.dg/c23-static-assert-6.c @@ -0,0 +1,70 @@ +/* Test C2y static assertions in expressions: -pedantic-errors errors for + C23. */ +/* { dg-do compile } */ +/* { dg-options "-std=c23 -pedantic-errors" } */ + +/* Old forms of static assertion still valid. */ +static_assert (1); +static_assert (2, "message" ); +struct s { int a; static_assert (3); }; + +void +f () +{ + static_assert (4); + label: + static_assert (5); + for (static_assert (6);;) + ; +} + +/* Test new forms of static assertion. */ +void +g () +{ + (void) 0, static_assert (7), (void) 0; /* { dg-error "ISO C does not support static assertions in expressions before C2Y" } */ + extern typeof (static_assert (8)) f (); /* { dg-error "ISO C does not support static assertions in expressions before C2Y" } */ + 1 + ? static_assert (9) /* { dg-error "ISO C does not support static assertions in expressions before C2Y" } */ + : static_assert (10); /* { dg-error "ISO C does not support static assertions in expressions before C2Y" } */ + if (1) + static_assert (11); /* { dg-error "ISO C does not support static assertions in expressions before C2Y" } */ + else + static_assert (12); /* { dg-error "ISO C does not support static assertions in expressions before C2Y" } */ + for (;;) + static_assert (13); /* { dg-error "ISO C does not support static assertions in expressions before C2Y" } */ + while (true) + static_assert (14); /* { dg-error "ISO C does not support static assertions in expressions before C2Y" } */ + do + static_assert (15); /* { dg-error "ISO C does not support static assertions in expressions before C2Y" } */ + while (false); + switch (16) + static_assert (17); /* { dg-error "ISO C does not support static assertions in expressions before C2Y" } */ + (void) static_assert (18); /* { dg-error "ISO C does not support static assertions in expressions before C2Y" } */ + (static_assert (19)); /* { dg-error "ISO C does not support static assertions in expressions before C2Y" } */ +} + +void +g2 () +{ + (void) 0, static_assert (7, "message"), (void) 0; /* { dg-error "ISO C does not support static assertions in expressions before C2Y" } */ + extern typeof (static_assert (8, "message")) f (); /* { dg-error "ISO C does not support static assertions in expressions before C2Y" } */ + 1 + ? static_assert (9, "message") /* { dg-error "ISO C does not support static assertions in expressions before C2Y" } */ + : static_assert (10, "message"); /* { dg-error "ISO C does not support static assertions in expressions before C2Y" } */ + if (1) + static_assert (11, "message"); /* { dg-error "ISO C does not support static assertions in expressions before C2Y" } */ + else + static_assert (12, "message"); /* { dg-error "ISO C does not support static assertions in expressions before C2Y" } */ + for (;;) + static_assert (13, "message"); /* { dg-error "ISO C does not support static assertions in expressions before C2Y" } */ + while (true) + static_assert (14, "message"); /* { dg-error "ISO C does not support static assertions in expressions before C2Y" } */ + do + static_assert (15, "message"); /* { dg-error "ISO C does not support static assertions in expressions before C2Y" } */ + while (false); + switch (16) + static_assert (17, "message"); /* { dg-error "ISO C does not support static assertions in expressions before C2Y" } */ + (void) static_assert (18, "message"); /* { dg-error "ISO C does not support static assertions in expressions before C2Y" } */ + (static_assert (19, "message")); /* { dg-error "ISO C does not support static assertions in expressions before C2Y" } */ +} diff --git a/gcc/testsuite/gcc.dg/c23-static-assert-7.c b/gcc/testsuite/gcc.dg/c23-static-assert-7.c new file mode 100644 index 0000000..9c35353 --- /dev/null +++ b/gcc/testsuite/gcc.dg/c23-static-assert-7.c @@ -0,0 +1,70 @@ +/* Test C2y static assertions in expressions: -Wc23-c2y-compat warnings for + C23. */ +/* { dg-do compile } */ +/* { dg-options "-std=c23 -Wc23-c2y-compat" } */ + +/* Old forms of static assertion still valid. */ +static_assert (1); +static_assert (2, "message" ); +struct s { int a; static_assert (3); }; + +void +f () +{ + static_assert (4); + label: + static_assert (5); + for (static_assert (6);;) + ; +} + +/* Test new forms of static assertion. */ +void +g () +{ + (void) 0, static_assert (7), (void) 0; /* { dg-warning "ISO C does not support static assertions in expressions before C2Y" } */ + extern typeof (static_assert (8)) f (); /* { dg-warning "ISO C does not support static assertions in expressions before C2Y" } */ + 1 + ? static_assert (9) /* { dg-warning "ISO C does not support static assertions in expressions before C2Y" } */ + : static_assert (10); /* { dg-warning "ISO C does not support static assertions in expressions before C2Y" } */ + if (1) + static_assert (11); /* { dg-warning "ISO C does not support static assertions in expressions before C2Y" } */ + else + static_assert (12); /* { dg-warning "ISO C does not support static assertions in expressions before C2Y" } */ + for (;;) + static_assert (13); /* { dg-warning "ISO C does not support static assertions in expressions before C2Y" } */ + while (true) + static_assert (14); /* { dg-warning "ISO C does not support static assertions in expressions before C2Y" } */ + do + static_assert (15); /* { dg-warning "ISO C does not support static assertions in expressions before C2Y" } */ + while (false); + switch (16) + static_assert (17); /* { dg-warning "ISO C does not support static assertions in expressions before C2Y" } */ + (void) static_assert (18); /* { dg-warning "ISO C does not support static assertions in expressions before C2Y" } */ + (static_assert (19)); /* { dg-warning "ISO C does not support static assertions in expressions before C2Y" } */ +} + +void +g2 () +{ + (void) 0, static_assert (7, "message"), (void) 0; /* { dg-warning "ISO C does not support static assertions in expressions before C2Y" } */ + extern typeof (static_assert (8, "message")) f (); /* { dg-warning "ISO C does not support static assertions in expressions before C2Y" } */ + 1 + ? static_assert (9, "message") /* { dg-warning "ISO C does not support static assertions in expressions before C2Y" } */ + : static_assert (10, "message"); /* { dg-warning "ISO C does not support static assertions in expressions before C2Y" } */ + if (1) + static_assert (11, "message"); /* { dg-warning "ISO C does not support static assertions in expressions before C2Y" } */ + else + static_assert (12, "message"); /* { dg-warning "ISO C does not support static assertions in expressions before C2Y" } */ + for (;;) + static_assert (13, "message"); /* { dg-warning "ISO C does not support static assertions in expressions before C2Y" } */ + while (true) + static_assert (14, "message"); /* { dg-warning "ISO C does not support static assertions in expressions before C2Y" } */ + do + static_assert (15, "message"); /* { dg-warning "ISO C does not support static assertions in expressions before C2Y" } */ + while (false); + switch (16) + static_assert (17, "message"); /* { dg-warning "ISO C does not support static assertions in expressions before C2Y" } */ + (void) static_assert (18, "message"); /* { dg-warning "ISO C does not support static assertions in expressions before C2Y" } */ + (static_assert (19, "message")); /* { dg-warning "ISO C does not support static assertions in expressions before C2Y" } */ +} diff --git a/gcc/testsuite/gcc.dg/c23-static-assert-8.c b/gcc/testsuite/gcc.dg/c23-static-assert-8.c new file mode 100644 index 0000000..118e199 --- /dev/null +++ b/gcc/testsuite/gcc.dg/c23-static-assert-8.c @@ -0,0 +1,66 @@ +/* Test C2y static assertions in expressions: not diagnosed for C23 with + -pedantic-errors -Wno-c23-c2y-compat. */ +/* { dg-do compile } */ +/* { dg-options "-std=c23 -pedantic-errors -Wno-c23-c2y-compat" } */ + +/* Old forms of static assertion still valid. */ +static_assert (1); +static_assert (2, "message" ); +struct s { int a; static_assert (3); }; + +void +f () +{ + static_assert (4); + label: + static_assert (5); + for (static_assert (6);;) + ; +} + +/* Test new forms of static assertion. */ +void +g () +{ + (void) 0, static_assert (7), (void) 0; + extern typeof (static_assert (8)) f (); + 1 ? static_assert (9) : static_assert (10); + if (1) + static_assert (11); + else + static_assert (12); + for (;;) + static_assert (13); + while (true) + static_assert (14); + do + static_assert (15); + while (false); + switch (16) + static_assert (17); + (void) static_assert (18); + (static_assert (19)); +} + +void +g2 () +{ + (void) 0, static_assert (7, "message"), (void) 0; + extern typeof (static_assert (8, "message")) f (); + 1 ? static_assert (9, "message") : static_assert (10, "message"); + if (1) + static_assert (11, "message"); + else + static_assert (12, "message"); + for (;;) + static_assert (13, "message"); + while (true) + static_assert (14, "message"); + do + static_assert (15, "message"); + while (false); + switch (16) + static_assert (17, "message"); + (void) static_assert (18, "message"); + (static_assert (19, "message")); +} diff --git a/gcc/testsuite/gcc.dg/c2y-static-assert-2.c b/gcc/testsuite/gcc.dg/c2y-static-assert-2.c new file mode 100644 index 0000000..81cdd9d --- /dev/null +++ b/gcc/testsuite/gcc.dg/c2y-static-assert-2.c @@ -0,0 +1,65 @@ +/* Test C2y static assertions in expressions. */ +/* { dg-do compile } */ +/* { dg-options "-std=c2y -pedantic-errors" } */ + +/* Old forms of static assertion still valid. */ +static_assert (1); +static_assert (2, "message" ); +struct s { int a; static_assert (3); }; + +void +f () +{ + static_assert (4); + label: + static_assert (5); + for (static_assert (6);;) + ; +} + +/* Test new forms of static assertion. */ +void +g () +{ + (void) 0, static_assert (7), (void) 0; + extern typeof (static_assert (8)) f (); + 1 ? static_assert (9) : static_assert (10); + if (1) + static_assert (11); + else + static_assert (12); + for (;;) + static_assert (13); + while (true) + static_assert (14); + do + static_assert (15); + while (false); + switch (16) + static_assert (17); + (void) static_assert (18); + (static_assert (19)); +} + +void +g2 () +{ + (void) 0, static_assert (7, "message"), (void) 0; + extern typeof (static_assert (8, "message")) f (); + 1 ? static_assert (9, "message") : static_assert (10, "message"); + if (1) + static_assert (11, "message"); + else + static_assert (12, "message"); + for (;;) + static_assert (13, "message"); + while (true) + static_assert (14, "message"); + do + static_assert (15, "message"); + while (false); + switch (16) + static_assert (17, "message"); + (void) static_assert (18, "message"); + (static_assert (19, "message")); +} diff --git a/gcc/testsuite/gcc.dg/c2y-static-assert-3.c b/gcc/testsuite/gcc.dg/c2y-static-assert-3.c new file mode 100644 index 0000000..fcbf6af --- /dev/null +++ b/gcc/testsuite/gcc.dg/c2y-static-assert-3.c @@ -0,0 +1,69 @@ +/* Test C2y static assertions in expressions: -Wc23-c2y-compat warnings. */ +/* { dg-do compile } */ +/* { dg-options "-std=c2y -pedantic-errors -Wc23-c2y-compat" } */ + +/* Old forms of static assertion still valid. */ +static_assert (1); +static_assert (2, "message" ); +struct s { int a; static_assert (3); }; + +void +f () +{ + static_assert (4); + label: + static_assert (5); + for (static_assert (6);;) + ; +} + +/* Test new forms of static assertion. */ +void +g () +{ + (void) 0, static_assert (7), (void) 0; /* { dg-warning "ISO C does not support static assertions in expressions before C2Y" } */ + extern typeof (static_assert (8)) f (); /* { dg-warning "ISO C does not support static assertions in expressions before C2Y" } */ + 1 + ? static_assert (9) /* { dg-warning "ISO C does not support static assertions in expressions before C2Y" } */ + : static_assert (10); /* { dg-warning "ISO C does not support static assertions in expressions before C2Y" } */ + if (1) + static_assert (11); /* { dg-warning "ISO C does not support static assertions in expressions before C2Y" } */ + else + static_assert (12); /* { dg-warning "ISO C does not support static assertions in expressions before C2Y" } */ + for (;;) + static_assert (13); /* { dg-warning "ISO C does not support static assertions in expressions before C2Y" } */ + while (true) + static_assert (14); /* { dg-warning "ISO C does not support static assertions in expressions before C2Y" } */ + do + static_assert (15); /* { dg-warning "ISO C does not support static assertions in expressions before C2Y" } */ + while (false); + switch (16) + static_assert (17); /* { dg-warning "ISO C does not support static assertions in expressions before C2Y" } */ + (void) static_assert (18); /* { dg-warning "ISO C does not support static assertions in expressions before C2Y" } */ + (static_assert (19)); /* { dg-warning "ISO C does not support static assertions in expressions before C2Y" } */ +} + +void +g2 () +{ + (void) 0, static_assert (7, "message"), (void) 0; /* { dg-warning "ISO C does not support static assertions in expressions before C2Y" } */ + extern typeof (static_assert (8, "message")) f (); /* { dg-warning "ISO C does not support static assertions in expressions before C2Y" } */ + 1 + ? static_assert (9, "message") /* { dg-warning "ISO C does not support static assertions in expressions before C2Y" } */ + : static_assert (10, "message"); /* { dg-warning "ISO C does not support static assertions in expressions before C2Y" } */ + if (1) + static_assert (11, "message"); /* { dg-warning "ISO C does not support static assertions in expressions before C2Y" } */ + else + static_assert (12, "message"); /* { dg-warning "ISO C does not support static assertions in expressions before C2Y" } */ + for (;;) + static_assert (13, "message"); /* { dg-warning "ISO C does not support static assertions in expressions before C2Y" } */ + while (true) + static_assert (14, "message"); /* { dg-warning "ISO C does not support static assertions in expressions before C2Y" } */ + do + static_assert (15, "message"); /* { dg-warning "ISO C does not support static assertions in expressions before C2Y" } */ + while (false); + switch (16) + static_assert (17, "message"); /* { dg-warning "ISO C does not support static assertions in expressions before C2Y" } */ + (void) static_assert (18, "message"); /* { dg-warning "ISO C does not support static assertions in expressions before C2Y" } */ + (static_assert (19, "message")); /* { dg-warning "ISO C does not support static assertions in expressions before C2Y" } */ +} diff --git a/gcc/testsuite/gcc.dg/c2y-static-assert-4.c b/gcc/testsuite/gcc.dg/c2y-static-assert-4.c new file mode 100644 index 0000000..87eb7c8 --- /dev/null +++ b/gcc/testsuite/gcc.dg/c2y-static-assert-4.c @@ -0,0 +1,69 @@ +/* Test C2y static assertions in expressions: failed assertions. */ +/* { dg-do compile } */ +/* { dg-options "-std=c2y -pedantic-errors" } */ + +/* Old forms of static assertion still valid. */ +static_assert (0); /* { dg-error "static assertion failed" } */ +static_assert (0, "message" ); /* { dg-error "static assertion failed" } */ +struct s { int a; static_assert (0); }; /* { dg-error "static assertion failed" } */ + +void +f () +{ + static_assert (0); /* { dg-error "static assertion failed" } */ + label: + static_assert (0); /* { dg-error "static assertion failed" } */ + for (static_assert (0);;) /* { dg-error "static assertion failed" } */ + ; +} + +/* Test new forms of static assertion. */ +void +g () +{ + (void) 0, static_assert (0), (void) 0; /* { dg-error "static assertion failed" } */ + extern typeof (static_assert (0)) f (); /* { dg-error "static assertion failed" } */ + 1 + ? static_assert (0) /* { dg-error "static assertion failed" } */ + : static_assert (0); /* { dg-error "static assertion failed" } */ + if (1) + static_assert (0); /* { dg-error "static assertion failed" } */ + else + static_assert (0); /* { dg-error "static assertion failed" } */ + for (;;) + static_assert (0); /* { dg-error "static assertion failed" } */ + while (true) + static_assert (0); /* { dg-error "static assertion failed" } */ + do + static_assert (0); /* { dg-error "static assertion failed" } */ + while (false); + switch (16) + static_assert (0); /* { dg-error "static assertion failed" } */ + (void) static_assert (0); /* { dg-error "static assertion failed" } */ + (static_assert (0)); /* { dg-error "static assertion failed" } */ +} + +void +g2 () +{ + (void) 0, static_assert (0, "message"), (void) 0; /* { dg-error "static assertion failed" } */ + extern typeof (static_assert (0, "message")) f (); /* { dg-error "static assertion failed" } */ + 1 + ? static_assert (0, "message") /* { dg-error "static assertion failed" } */ + : static_assert (0, "message"); /* { dg-error "static assertion failed" } */ + if (1) + static_assert (0, "message"); /* { dg-error "static assertion failed" } */ + else + static_assert (0, "message"); /* { dg-error "static assertion failed" } */ + for (;;) + static_assert (0, "message"); /* { dg-error "static assertion failed" } */ + while (true) + static_assert (0, "message"); /* { dg-error "static assertion failed" } */ + do + static_assert (0, "message"); /* { dg-error "static assertion failed" } */ + while (false); + switch (16) + static_assert (0, "message"); /* { dg-error "static assertion failed" } */ + (void) static_assert (0, "message"); /* { dg-error "static assertion failed" } */ + (static_assert (0, "message")); /* { dg-error "static assertion failed" } */ +} diff --git a/gcc/testsuite/gcc.dg/fold-round-1.c b/gcc/testsuite/gcc.dg/fold-round-1.c new file mode 100644 index 0000000..0d7f954 --- /dev/null +++ b/gcc/testsuite/gcc.dg/fold-round-1.c @@ -0,0 +1,56 @@ +/* { dg-do compile } */ +/* { dg-options "-Ofast" } */ + +extern void link_error (void); + +#define TEST_ROUND(TYPE, FFLOOR, FCEIL) \ + void round_##FFLOOR##_1 (TYPE x) \ + { \ + TYPE t1 = 0; \ + TYPE t2 = __builtin_##FFLOOR (x + 0.5); \ + if ((x - __builtin_##FFLOOR (x)) < (__builtin_##FCEIL (x) - x)) \ + t1 = __builtin_##FFLOOR (x); \ + else \ + t1 = __builtin_##FCEIL (x); \ + if (t1 != t2) \ + link_error (); \ + } \ + void round_##FFLOOR##_2 (TYPE x) \ + { \ + TYPE t1 = 0; \ + TYPE t2 = __builtin_##FFLOOR (x + 0.5); \ + if ((__builtin_##FCEIL (x) - x) > (x - __builtin_##FFLOOR (x))) \ + t1 = __builtin_##FFLOOR (x); \ + else \ + t1 = __builtin_##FCEIL (x); \ + if (t1 != t2) \ + link_error (); \ + } \ + void round_##FFLOOR##_3 (TYPE x) \ + { \ + TYPE t1 = 0; \ + TYPE t2 = __builtin_##FFLOOR (x + 0.5); \ + if ((__builtin_##FCEIL (x) - x) <= (x - __builtin_##FFLOOR (x))) \ + t1 = __builtin_##FCEIL (x); \ + else \ + t1 = __builtin_##FFLOOR (x); \ + if (t1 != t2) \ + link_error (); \ + } \ + void round_##FFLOOR##_4 (TYPE x) \ + { \ + TYPE t1 = 0; \ + TYPE t2 = __builtin_##FFLOOR (x + 0.5); \ + if ((x - __builtin_##FFLOOR (x)) >= (__builtin_##FCEIL (x) - x)) \ + t1 = __builtin_##FCEIL (x); \ + else \ + t1 = __builtin_##FFLOOR (x); \ + if (t1 != t2) \ + link_error (); \ + } + +TEST_ROUND (float, floorf, ceilf) +TEST_ROUND (double, floor, ceil) +TEST_ROUND (long double, floorl, ceill) + +/* { dg-final { scan-assembler-not "link_error" } } */ diff --git a/gcc/testsuite/gcc.dg/fold-vecperm-1.c b/gcc/testsuite/gcc.dg/fold-vecperm-1.c new file mode 100644 index 0000000..5d4456b --- /dev/null +++ b/gcc/testsuite/gcc.dg/fold-vecperm-1.c @@ -0,0 +1,23 @@ +/* { dg-do compile } */ +/* { dg-options "-O2 -fdump-tree-optimized" } */ + +typedef int v4si __attribute__((vector_size(16))); +typedef short v8hi __attribute__((vector_size(16))); + +typedef union { + v4si s; + v8hi h; +} int128; + +int128 concat (int128 a, int128 b) { + int128 x, y, res; + v4si zero = { 0, 0, 0, 0 }; + v4si sel0 = { 3, 4, 5, 6 }; + v8hi sel1 = { 0, 1, 10, 11, 12, 13, 14, 15 }; + x.s = __builtin_shuffle (a.s, zero, sel0); + y.s = __builtin_shuffle (zero, b.s, sel0); + res.h = __builtin_shuffle (x.h, y.h, sel1); + return res; +} + +/* { dg-final { scan-tree-dump-times "VEC_PERM_EXPR" 1 "optimized" } } */ diff --git a/gcc/testsuite/gcc.dg/pr114331.c b/gcc/testsuite/gcc.dg/pr114331.c new file mode 100644 index 0000000..e93289e --- /dev/null +++ b/gcc/testsuite/gcc.dg/pr114331.c @@ -0,0 +1,20 @@ +/* { dg-do compile } */ +/* { dg-options "-O2 -fdump-tree-optimized" } */ + +int src(int num) { + switch((short)num){ + case 111: + /* Should fold to 110. */ + return num & 0xfffe; + case 267: + case 204: + case 263: + return 0; + default: + return 0; + } +} + + +/* { dg-final { scan-tree-dump "110" "optimized" } } */ + diff --git a/gcc/testsuite/gcc.dg/pr114725.c b/gcc/testsuite/gcc.dg/pr114725.c new file mode 100644 index 0000000..01c3139 --- /dev/null +++ b/gcc/testsuite/gcc.dg/pr114725.c @@ -0,0 +1,15 @@ +/* { dg-do compile } */ +/* { dg-options "-O2 -fdump-tree-optimized" } */ + +//* This should fold to return 0 +bool +src(int offset) +{ + if (offset > 128) + return 0; + else + return (offset & -9) == 258; +} + +/* { dg-final { scan-tree-dump "return 0" "optimized" } } */ +/* { dg-final { scan-tree-dump-not "PHI" "optimized" } } */ diff --git a/gcc/testsuite/gcc.dg/pr118254.c b/gcc/testsuite/gcc.dg/pr118254.c new file mode 100644 index 0000000..5a0553b --- /dev/null +++ b/gcc/testsuite/gcc.dg/pr118254.c @@ -0,0 +1,34 @@ +/* { dg-do compile } */ +/* { dg-options "-O2 -fdump-tree-evrp" } */ + +void foo(void); +int il=1000; + +int m1(void) +{ + short t = il; + unsigned t1 = t; + if (t1 == 0) { + char b = t1; + if (b != 1) + return 0; + foo(); + } + return 0; +} + +int m2(void) +{ + short t = il; + unsigned t1 = t; + if (t1 == 0) { + char b = il; + if (b != 1) + return 0; + foo(); + } + return 0; +} + +/* { dg-final { scan-tree-dump-not "foo" "evrp" } } */ + diff --git a/gcc/testsuite/gcc.dg/torture/vect-permute-ice.c b/gcc/testsuite/gcc.dg/torture/vect-permute-ice.c new file mode 100644 index 0000000..05a1da5 --- /dev/null +++ b/gcc/testsuite/gcc.dg/torture/vect-permute-ice.c @@ -0,0 +1,15 @@ +/* { dg-do compile } */ +/* This testcase triggered an ICE that was fixed by + g:1ceda79ca5fe1a1a296624a98de8fd04958fbe55. */ +char *a; +char c, e; +_Bool f() { + int g, d = 0; + for (int h = 0; h < 128; h += 8) { + char *b = &a[h]; + g = e * b[0] + c * b[1] + 2 * b[2] + 3 * b[3] + 4 * b[4] + 5 * b[5] + + 6 * b[6] + 7 * b[7]; + d += g; + } + return d; +} diff --git a/gcc/testsuite/gcc.dg/tree-ssa/bool-12.c b/gcc/testsuite/gcc.dg/tree-ssa/bool-12.c index e62594e..244e562 100644 --- a/gcc/testsuite/gcc.dg/tree-ssa/bool-12.c +++ b/gcc/testsuite/gcc.dg/tree-ssa/bool-12.c @@ -1,5 +1,5 @@ /* { dg-do compile } */ -/* { dg-options "-O1 -fdump-tree-optimized -fdump-tree-original -fdump-tree-phiopt1 -fdump-tree-forwprop2" } */ +/* { dg-options "-O1 -fdump-tree-optimized -fdump-tree-original -fdump-tree-phiopt2-raw" } */ #define bool _Bool int maxbool(bool ab, bool bb) { @@ -28,15 +28,12 @@ int minbool(bool ab, bool bb) /* { dg-final { scan-tree-dump-times "MIN_EXPR" 0 "original" } } */ /* { dg-final { scan-tree-dump-times "if " 2 "original" } } */ -/* PHI-OPT1 should have converted it into min/max */ -/* { dg-final { scan-tree-dump-times "MAX_EXPR" 1 "phiopt1" } } */ -/* { dg-final { scan-tree-dump-times "MIN_EXPR" 1 "phiopt1" } } */ -/* { dg-final { scan-tree-dump-times "if " 0 "phiopt1" } } */ - -/* Forwprop2 (after ccp) will convert it into &\| */ -/* { dg-final { scan-tree-dump-times "MAX_EXPR" 0 "forwprop2" } } */ -/* { dg-final { scan-tree-dump-times "MIN_EXPR" 0 "forwprop2" } } */ -/* { dg-final { scan-tree-dump-times "if " 0 "forwprop2" } } */ +/* PHI-OPT2 should have converted it into &\| */ +/* { dg-final { scan-tree-dump-not "min_expr, " "phiopt2" } } */ +/* { dg-final { scan-tree-dump-not "max_expr, " "phiopt2" } } */ +/* { dg-final { scan-tree-dump-times "bit_ior_expr, " 1 "phiopt2" } } */ +/* { dg-final { scan-tree-dump-times "bit_and_expr, " 1 "phiopt2" } } */ +/* { dg-final { scan-tree-dump-times "gimple_cond " 0 "phiopt2" } } */ /* By optimize there should be no min/max nor if */ /* { dg-final { scan-tree-dump-times "MAX_EXPR" 0 "optimized" } } */ diff --git a/gcc/testsuite/gcc.dg/vect/vect-pr122406-1.c b/gcc/testsuite/gcc.dg/vect/vect-pr122406-1.c new file mode 100644 index 0000000..c756ff3 --- /dev/null +++ b/gcc/testsuite/gcc.dg/vect/vect-pr122406-1.c @@ -0,0 +1,13 @@ +/* { dg-do compile } */ +/* { dg-additional-options "-fwrapv" } */ + +int f(long l, short *sp) { + unsigned short us; + for (; l; l -= 4, sp += 4) + us += sp[1] + sp[3]; + return us; +} + +/* ??? Both SVE and RVV refuse to do the { 1, 3 } permutation as two ld2 + or ld1 with odd extract plus lo/hi concat. Instead they prefer ld4. */ +/* { dg-final { scan-tree-dump "vectorizing a reduction chain" "vect" { target { { vect_extract_even_odd && vect_int } && { ! vect_variable_length } } } } } */ diff --git a/gcc/testsuite/gcc.dg/vect/vect-pr122406-2.c b/gcc/testsuite/gcc.dg/vect/vect-pr122406-2.c new file mode 100644 index 0000000..8b69625 --- /dev/null +++ b/gcc/testsuite/gcc.dg/vect/vect-pr122406-2.c @@ -0,0 +1,12 @@ +/* { dg-do compile } */ + +int f(long l, short *sp) { + unsigned short us; + for (; l; l -= 4, sp += 4) + us += sp[1] + sp[3]; + return us; +} + +/* ??? Both SVE and RVV refuse to do the { 1, 3 } permutation as two ld2 + or ld1 with odd extract plus lo/hi concat. Instead they prefer ld4. */ +/* { dg-final { scan-tree-dump "vectorizing a reduction chain" "vect" { target { { vect_extract_even_odd && vect_int } && { ! vect_variable_length } } } } } */ diff --git a/gcc/testsuite/gcc.target/aarch64/fmv_priority.in b/gcc/testsuite/gcc.target/aarch64/fmv_priority.in new file mode 100644 index 0000000..93209bc --- /dev/null +++ b/gcc/testsuite/gcc.target/aarch64/fmv_priority.in @@ -0,0 +1,92 @@ +int fn [[gnu::target_version("default")]] (int) { return 1; } +int fn_default (int) asm("fn.default"); +int fn [[gnu::target_version("rng")]] (int) { return 1; } +int fn_rng(int) asm("fn._Mrng"); +int fn [[gnu::target_version("flagm")]] (int) { return 1; } +int fn_flagm(int) asm("fn._Mflagm"); +int fn [[gnu::target_version("flagm2")]] (int) { return 1; } +int fn_flagm2(int) asm("fn._Mflagm2"); +int fn [[gnu::target_version("lse")]] (int) { return 1; } +int fn_lse(int) asm("fn._Mlse"); +int fn [[gnu::target_version("fp")]] (int) { return 1; } +int fn_fp(int) asm("fn._Mfp"); +int fn [[gnu::target_version("simd")]] (int) { return 1; } +int fn_simd(int) asm("fn._Msimd"); +int fn [[gnu::target_version("dotprod")]] (int) { return 1; } +int fn_dotprod(int) asm("fn._Mdotprod"); +int fn [[gnu::target_version("sm4")]] (int) { return 1; } +int fn_sm4(int) asm("fn._Msm4"); +int fn [[gnu::target_version("rdm")]] (int) { return 1; } +int fn_rdm(int) asm("fn._MrdmaMrdm"); +int fn [[gnu::target_version("crc")]] (int) { return 1; } +int fn_crc(int) asm("fn._Mcrc"); +int fn [[gnu::target_version("sha2")]] (int) { return 1; } +int fn_sha2(int) asm("fn._Msha2"); +int fn [[gnu::target_version("sha3")]] (int) { return 1; } +int fn_sha3(int) asm("fn._Msha3"); +int fn [[gnu::target_version("aes")]] (int) { return 1; } +int fn_aes(int) asm("fn._Maes"); +int fn [[gnu::target_version("fp16")]] (int) { return 1; } +int fn_fp16(int) asm("fn._Mfp16"); +int fn [[gnu::target_version("fp16fml")]] (int) { return 1; } +int fn_fp16fml(int) asm("fn._Mfp16fml"); +/* TODO: These FMV features are not yet supported in GCC. */ +// int fn [[gnu::target_version("dit")]] (int) { return 1; } +// int fn [[gnu::target_version("dpb")]] (int) { return 1; } +// int fn [[gnu::target_version("dpb2")]] (int) { return 1; } +int fn [[gnu::target_version("jscvt")]] (int) { return 1; } +int fn_jscvt(int) asm("fn._Mjscvt"); +int fn [[gnu::target_version("fcma")]] (int) { return 1; } +int fn_fcma(int) asm("fn._Mfcma"); +int fn [[gnu::target_version("rcpc")]] (int) { return 1; } +int fn_rcpc(int) asm("fn._Mrcpc"); +int fn [[gnu::target_version("rcpc2")]] (int) { return 1; } +int fn_rcpc2(int) asm("fn._Mrcpc2"); +int fn [[gnu::target_version("rcpc3")]] (int) { return 1; } +int fn_rcpc3(int) asm("fn._Mrcpc3"); +int fn [[gnu::target_version("frintts")]] (int) { return 1; } +int fn_frintts(int) asm("fn._Mfrintts"); +int fn [[gnu::target_version("i8mm")]] (int) { return 1; } +int fn_i8mm(int) asm("fn._Mi8mm"); +int fn [[gnu::target_version("bf16")]] (int) { return 1; } +int fn_bf16(int) asm("fn._Mbf16"); +int fn [[gnu::target_version("sve")]] (int) { return 1; } +int fn_sve(int) asm("fn._Msve"); +int fn [[gnu::target_version("f32mm")]] (int) { return 1; } +int fn_f32mm(int) asm("fn._Mf32mm"); +int fn [[gnu::target_version("f64mm")]] (int) { return 1; } +int fn_f64mm(int) asm("fn._Mf64mm"); +int fn [[gnu::target_version("sve2")]] (int) { return 1; } +int fn_sve2(int) asm("fn._Msve2"); +int fn [[gnu::target_version("sve2-aes")]] (int) { return 1; } +int fn_sve2_aes(int) asm("fn._Msve2_aes"); +int fn [[gnu::target_version("sve2-bitperm")]] (int) { return 1; } +int fn_sve2_bitperm(int) asm("fn._Msve2_bitperm"); +int fn [[gnu::target_version("sve2-sha3")]] (int) { return 1; } +int fn_sve2_sha3(int) asm("fn._Msve2_sha3"); +int fn [[gnu::target_version("sve2-sm4")]] (int) { return 1; } +int fn_sve2_sm4(int) asm("fn._Msve2_sm4"); +int fn [[gnu::target_version("sve2+sme")]] (int) { return 1; } +int fn_sve2_sme(int) asm("fn._Msve2Msme"); +/* TODO: This FMV features is not yet supported in GCC. */ +// int fn [[gnu::target_version("memtag")]] (int) { return 1; } +int fn [[gnu::target_version("sb")]] (int) { return 1; } +int fn_sb(int) asm("fn._Msb"); +/* TODO: This FMV feature is not yet supported in GCC. */ +// int fn [[gnu::target_version("ssbs")]] (int) { return 1; } +// int fn_ssbs(int) asm("fn._Mssbs"); +/* TODO: This FMV feature is not yet supported in GCC. */ +// int fn [[gnu::target_version("bti")]] (int) { return 1; } +int fn [[gnu::target_version("wfxt")]] (int) { return 1; } +int fn_wfxt(int) asm("fn._Mwfxt"); +int fn [[gnu::target_version("sve2+sme-f64f64")]] (int) { return 1; } +int fn_sve2_sme_f64f64(int) asm("fn._Msve2Msme_f64f64"); +int fn [[gnu::target_version("sve2+sme-i16i64")]] (int) { return 1; } +int fn_sve2_sme_i16i64(int) asm("fn._Msve2Msme_i16i64"); +int fn [[gnu::target_version("sve2+sme2")]] (int) { return 1; } +int fn_sve2_sme2(int) asm("fn._Msve2Msme2"); +int fn [[gnu::target_version("mops")]] (int) { return 1; } +int fn_mops(int) asm("fn._Mmops"); +int fn [[gnu::target_version("cssc")]] (int) { return 1; } +int fn_cssc(int) asm("fn._Mcssc"); + diff --git a/gcc/testsuite/gcc.target/aarch64/fmv_priority1.c b/gcc/testsuite/gcc.target/aarch64/fmv_priority1.c new file mode 100644 index 0000000..942b7a7 --- /dev/null +++ b/gcc/testsuite/gcc.target/aarch64/fmv_priority1.c @@ -0,0 +1,175 @@ +/* { dg-do run { target { aarch64_asm_sme2_ok } } } */ +/* { dg-require-ifunc "" } */ +/* { dg-options "-O0 -march=armv8-a" } */ + +#include <sys/auxv.h> +#include "../../../common/config/aarch64/cpuinfo.h" + +/* This test has a FMV function set with one version per feature we support. + Each version is turned on incrementally and the generated resolver is + checked to show the correct version is chosen. */ + +/* The resolver does actually take arguments, but ignores them and uses + __aarch64_cpu_features global instead to establish what features are + present. */ +int (*(resolver)(void)) (int) asm("fn.resolver"); + +extern struct { + unsigned long long features; +} aarch64_cpu_features asm("__aarch64_cpu_features"); + +#include "fmv_priority.in" + +#define setCPUFeature(F) aarch64_cpu_features.features |= 1UL << F + +int main () { + aarch64_cpu_features.features = 0; + + /* Initialize the CPU features, so the resolver doesn't try fetch it. */ + setCPUFeature(FEAT_INIT); + + /* Go through features in order and assure the priorities are correct. + By checking the correct versions are resolved. */ + + /* Some are missing as they are defined in the ACLE but are not yet + implemented. */ + if (resolver() != &fn_default) return 1; + + setCPUFeature(FEAT_RNG); + if (resolver() != &fn_rng) return 1; + + setCPUFeature(FEAT_FLAGM); + if (resolver() != &fn_flagm) return 1; + + setCPUFeature(FEAT_FLAGM2); + if (resolver() != &fn_flagm2) return 1; + + setCPUFeature (FEAT_LSE); + if (resolver () != &fn_lse) return 1; + + setCPUFeature (FEAT_FP); + if (resolver () != &fn_fp) return 1; + + setCPUFeature (FEAT_SIMD); + if (resolver () != &fn_simd) return 1; + + setCPUFeature (FEAT_DOTPROD); + if (resolver () != &fn_dotprod) return 1; + + setCPUFeature (FEAT_SM4); + if(resolver() != &fn_sm4) return 1; + + setCPUFeature (FEAT_RDM); + if(resolver() != &fn_rdm) return 1; + + setCPUFeature (FEAT_CRC); + if (resolver () != &fn_crc) return 1; + + setCPUFeature (FEAT_SHA2); + if (resolver () != &fn_sha2) return 1; + + setCPUFeature (FEAT_SHA3); + if (resolver () != &fn_sha3) return 1; + + setCPUFeature(FEAT_PMULL); + if(resolver() != &fn_aes) return 1; + + setCPUFeature (FEAT_FP16); + if (resolver () != &fn_fp16) return 1; + + setCPUFeature (FEAT_FP16FML); + if(resolver() != &fn_fp16fml) return 1; + + setCPUFeature (FEAT_DIT); + // if(resolver() != &fn_dit) return 1; + // + setCPUFeature (FEAT_DPB); + // if(resolver() != &fn_dpb) return 1; + // + setCPUFeature (FEAT_DPB2); + // if(resolver() != &fn_dpb2) return 1; + // + setCPUFeature (FEAT_JSCVT); + if (resolver () != &fn_jscvt) return 1; + + setCPUFeature (FEAT_FCMA); + if (resolver () != &fn_fcma) return 1; + + setCPUFeature (FEAT_RCPC); + if (resolver () != &fn_rcpc) return 1; + + setCPUFeature (FEAT_RCPC2); + if (resolver () != &fn_rcpc2) return 1; + + setCPUFeature (FEAT_RCPC3); + // if(resolver() != &fn_rcpc3) return 1; + // + setCPUFeature (FEAT_FRINTTS); + if (resolver () != &fn_frintts) return 1; + + setCPUFeature (FEAT_I8MM); + if (resolver () != &fn_i8mm) return 1; + + setCPUFeature (FEAT_BF16); + if (resolver () != &fn_bf16) return 1; + + setCPUFeature (FEAT_SVE); + if (resolver () != &fn_sve) return 1; + + setCPUFeature (FEAT_SVE_F32MM); + if(resolver() != &fn_f32mm) return 1; + + setCPUFeature (FEAT_SVE_F64MM); + if(resolver() != &fn_f64mm) return 1; + + setCPUFeature (FEAT_SVE2); + if (resolver () != &fn_sve2) return 1; + + setCPUFeature(FEAT_SVE_PMULL128); + if(resolver() != &fn_sve2_aes) return 1; + + setCPUFeature (FEAT_SVE_BITPERM); + if (resolver () != &fn_sve2_bitperm) return 1; + + setCPUFeature (FEAT_SVE_SHA3); + if (resolver () != &fn_sve2_sha3) return 1; + + setCPUFeature (FEAT_SVE_SM4); + if (resolver () != &fn_sve2_sm4) return 1; + + setCPUFeature (FEAT_SME); + if (resolver () != &fn_sve2_sme) return 1; + + setCPUFeature(FEAT_MEMTAG2); + // if(resolver() != &fn_memtag) return 1; + + setCPUFeature (FEAT_SB); + if (resolver () != &fn_sb) return 1; + + setCPUFeature(FEAT_SSBS2); + // if(resolver() != &fn_ssbs) return 1; + + setCPUFeature(FEAT_BTI); + // if(resolver() != &fn_bti) return 1; + + setCPUFeature (FEAT_WFXT); + if (resolver () != &fn_wfxt) return 1; + + setCPUFeature (FEAT_SME_F64); + if (resolver () != &fn_sve2_sme_f64f64) return 1; + + setCPUFeature (FEAT_SME_I64); + if (resolver () != &fn_sve2_sme_i16i64) return 1; + + setCPUFeature (FEAT_SME2); + if (resolver () != &fn_sve2_sme2) return 1; + + setCPUFeature (FEAT_MOPS); + if (resolver () != &fn_mops) return 1; + + setCPUFeature (FEAT_CSSC); + if (resolver () != &fn_cssc) return 1; + + return 0; +} + diff --git a/gcc/testsuite/gcc.target/aarch64/fmv_priority2.c b/gcc/testsuite/gcc.target/aarch64/fmv_priority2.c new file mode 100644 index 0000000..dbeb15e --- /dev/null +++ b/gcc/testsuite/gcc.target/aarch64/fmv_priority2.c @@ -0,0 +1,29 @@ +/* { dg-do compile } */ +/* { dg-require-ifunc "" } */ +/* { dg-options "-O0 -march=armv8-a -fdump-ipa-targetclone1-details" } */ + +#include "fmv_priority.in" + +// Checks that the versions are in the correct order +// Each of these lines checks 3 consecutive versions in the list with one overlap +/* { dg-final { scan-ipa-dump-times "Version order for fn/\[0-9\]+:\\nfn\.default/\[0-9\]+\\n" 1 "targetclone1" } } */ +/* { dg-final { scan-ipa-dump-times "fn\.default/\[0-9\]+\\nfn\._Mrng/\[0-9\]+\\nfn\._Mflagm/\[0-9\]+\\n" 1 "targetclone1" } } */ +/* { dg-final { scan-ipa-dump-times "fn\._Mflagm/\[0-9\]+\\nfn\._Mflagm2/\[0-9\]+\\nfn\._Mlse/\[0-9\]+\\n" 1 "targetclone1" } } */ +/* { dg-final { scan-ipa-dump-times "fn\._Mlse/\[0-9\]+\\nfn\._Mfp/\[0-9\]+\\nfn\._Msimd/\[0-9\]+\\n" 1 "targetclone1" } } */ +/* { dg-final { scan-ipa-dump-times "fn\._Msimd/\[0-9\]+\\nfn\._Mdotprod/\[0-9\]+\\nfn\._Msm4/\[0-9\]+\\n" 1 "targetclone1" } } */ +/* { dg-final { scan-ipa-dump-times "fn\._Msm4/\[0-9\]+\\nfn\._MrdmaMrdm/\[0-9\]+\\nfn\._Mcrc/\[0-9\]+\\n" 1 "targetclone1" } } */ +/* { dg-final { scan-ipa-dump-times "fn\._Mcrc/\[0-9\]+\\nfn\._Msha2/\[0-9\]+\\nfn\._Msha3/\[0-9\]+\\n" 1 "targetclone1" } } */ +/* { dg-final { scan-ipa-dump-times "fn\._Msha3/\[0-9\]+\\nfn\._Maes/\[0-9\]+\\nfn\._Mfp16/\[0-9\]+\\n" 1 "targetclone1" } } */ +/* { dg-final { scan-ipa-dump-times "fn\._Mfp16/\[0-9\]+\\nfn\._Mfp16fml/\[0-9\]+\\nfn\._Mjscvt/\[0-9\]+\\n" 1 "targetclone1" } } */ +/* { dg-final { scan-ipa-dump-times "fn\._Mjscvt/\[0-9\]+\\nfn\._Mfcma/\[0-9\]+\\nfn\._Mrcpc/\[0-9\]+\\n" 1 "targetclone1" } } */ +/* { dg-final { scan-ipa-dump-times "fn\._Mrcpc/\[0-9\]+\\nfn\._Mrcpc2/\[0-9\]+\\nfn\._Mrcpc3/\[0-9\]+\\n" 1 "targetclone1" } } */ +/* { dg-final { scan-ipa-dump-times "fn\._Mrcpc3/\[0-9\]+\\nfn\._Mfrintts/\[0-9\]+\\nfn\._Mi8mm/\[0-9\]+\\n" 1 "targetclone1" } } */ +/* { dg-final { scan-ipa-dump-times "fn\._Mi8mm/\[0-9\]+\\nfn\._Mbf16/\[0-9\]+\\nfn\._Msve/\[0-9\]+\\n" 1 "targetclone1" } } */ +/* { dg-final { scan-ipa-dump-times "fn\._Msve/\[0-9\]+\\nfn\._Mf32mm/\[0-9\]+\\nfn\._Mf64mm/\[0-9\]+\\n" 1 "targetclone1" } } */ +/* { dg-final { scan-ipa-dump-times "fn\._Mf64mm/\[0-9\]+\\nfn\._Msve2/\[0-9\]+\\nfn\._Msve2_aes/\[0-9\]+\\n" 1 "targetclone1" } } */ +/* { dg-final { scan-ipa-dump-times "fn\._Msve2_aes/\[0-9\]+\\nfn\._Msve2_bitperm/\[0-9\]+\\nfn\._Msve2_sha3/\[0-9\]+\\n" 1 "targetclone1" } } */ +/* { dg-final { scan-ipa-dump-times "fn\._Msve2_sha3/\[0-9\]+\\nfn\._Msve2_sm4/\[0-9\]+\\nfn\._Msve2Msme/\[0-9\]+\\n" 1 "targetclone1" } } */ +/* { dg-final { scan-ipa-dump-times "fn\._Msve2Msme/\[0-9\]+\\nfn\._Msb/\[0-9\]+\\nfn\._Mwfxt/\[0-9\]+\\n" 1 "targetclone1" } } */ +/* { dg-final { scan-ipa-dump-times "fn\._Mwfxt/\[0-9\]+\\nfn\._Msve2Msme_f64f64/\[0-9\]+\\nfn\._Msve2Msme_i16i64/\[0-9\]+\\n" 1 "targetclone1" } } */ +/* { dg-final { scan-ipa-dump-times "fn\._Msve2Msme_i16i64/\[0-9\]+\\nfn\._Msve2Msme2/\[0-9\]+\\nfn\._Mmops/\[0-9\]+\\n" 1 "targetclone1" } } */ +/* { dg-final { scan-ipa-dump-times "fn\._Mmops/\[0-9\]+\\nfn\._Mcssc/\[0-9\]+\\n" 1 "targetclone1" } } */ diff --git a/gcc/testsuite/gcc.target/aarch64/pr122190.c b/gcc/testsuite/gcc.target/aarch64/pr122190.c new file mode 100644 index 0000000..8546e12 --- /dev/null +++ b/gcc/testsuite/gcc.target/aarch64/pr122190.c @@ -0,0 +1,10 @@ +/* { dg-do compile } */ +/* { dg-require-ifunc "" } */ +/* { dg-options "-O0 -march=armv8-a -fdump-ipa-targetclone1-details" } */ + +int fn (int a) {return 1;} +int fn[[gnu::target_version("sve")]] (int a) {return 2;} +int fn[[gnu::target_version("simd+dotprod")]] (int a) {return 3;} +int fn[[gnu::target_version("sve+fp")]] (int a) {return 2;} + +/* { dg-final { scan-ipa-dump-times "Version order for fn/\[0-9\]+:\\nfn\.default/\[0-9\]+\\nfn\._MsimdMdotprod/\[0-9\]+\\nfn\._Msve/\[0-9\]+\\nfn\._MfpMsve/\[0-9\]+\\n" 1 "targetclone1" } } */ diff --git a/gcc/testsuite/gcc.target/arm/mve/intrinsics/pr122223.c b/gcc/testsuite/gcc.target/arm/mve/intrinsics/pr122223.c index 59e757a..045815c 100644 --- a/gcc/testsuite/gcc.target/arm/mve/intrinsics/pr122223.c +++ b/gcc/testsuite/gcc.target/arm/mve/intrinsics/pr122223.c @@ -21,5 +21,5 @@ float32x4_t foo() { } #endif -/* { dg-final { scan-assembler-not "vmov.f32\tq0, #0.0" } } */ -/* { dg-final { scan-assembler "vmov.f32\tq0, #1.0" } } */ +/* { dg-final { scan-assembler-not "vmov.f32\tq\[0-9\]+, #0.0" } } */ +/* { dg-final { scan-assembler "vmov.f32\tq\[0-9\]+, #1.0" } } */ diff --git a/gcc/testsuite/gcc.target/i386/builtin-fabs-2.c b/gcc/testsuite/gcc.target/i386/builtin-fabs-2.c index 093fd2e..dba3f8f 100644 --- a/gcc/testsuite/gcc.target/i386/builtin-fabs-2.c +++ b/gcc/testsuite/gcc.target/i386/builtin-fabs-2.c @@ -8,7 +8,7 @@ **foo: **... ** ja .L[0-9]+ -** movss 4\(%rdi\), %xmm1 +** movss 4\(%(e|r)di\), %xmm1 ** orps %xmm1, %xmm0 ** comiss %xmm0, %xmm2 ** seta %al diff --git a/gcc/testsuite/gcc.target/i386/pr101639_reduc_mask_and_vqi.c b/gcc/testsuite/gcc.target/i386/pr101639_reduc_mask_and_vqi.c new file mode 100644 index 0000000..23fc67e --- /dev/null +++ b/gcc/testsuite/gcc.target/i386/pr101639_reduc_mask_and_vqi.c @@ -0,0 +1,14 @@ +/* { dg-do compile } */ +/* { dg-options "-march=x86-64-v3 -O2" } */ +/* { dg-final { scan-assembler-times "vptest" 1 } } */ +/* { dg-final { scan-assembler-times "sete" 1 } } */ +/* { dg-final { scan-assembler-times "vpcmpeq" 1 } } */ + +bool f2(char * p, long n) +{ + bool r = true; + for(long i = 0; i < 32; ++i) + r &= (p[i] != 0); + return r; +} + diff --git a/gcc/testsuite/gcc.target/i386/pr101639_reduc_mask_ior_vqi.c b/gcc/testsuite/gcc.target/i386/pr101639_reduc_mask_ior_vqi.c new file mode 100644 index 0000000..e1deb2f --- /dev/null +++ b/gcc/testsuite/gcc.target/i386/pr101639_reduc_mask_ior_vqi.c @@ -0,0 +1,14 @@ +/* { dg-do compile } */ +/* { dg-options "-march=x86-64-v3 -O2" } */ +/* { dg-final { scan-assembler-times "vptest" 1 } } */ +/* { dg-final { scan-assembler-times "setne" 1 } } */ +/* { dg-final { scan-assembler-not "vpcmpeq" } } */ + +bool f2(char * p, long n) +{ + bool r = false; + for(long i = 0; i < 32; ++i) + r |= (p[i] != 0); + return r; +} + diff --git a/gcc/testsuite/gcc.target/i386/pr101639_reduc_mask_vdi.c b/gcc/testsuite/gcc.target/i386/pr101639_reduc_mask_vdi.c new file mode 100644 index 0000000..ee52697 --- /dev/null +++ b/gcc/testsuite/gcc.target/i386/pr101639_reduc_mask_vdi.c @@ -0,0 +1,31 @@ +/* { dg-do compile } */ +/* { dg-options "-march=x86-64-v3 -O2" } */ +/* { dg-final { scan-assembler-times "vptest" 2 } } */ +/* { dg-final { scan-assembler-times "sete" 1 } } */ +/* { dg-final { scan-assembler-times "setne" 1 } } */ +/* { dg-final { scan-assembler-times "popcnt" 1 } } */ +/* { dg-final { scan-assembler-times "vmovmskpd" 1 } } */ + +bool f(long long *p, long n) +{ + bool r = true; + for(long i = 0; i < 4; ++i) + r &= (p[i] != 0); + return r; +} + +bool f2(long long *p, long n) +{ + bool r = false; + for(long i = 0; i < 4; ++i) + r |= (p[i] != 0); + return r; +} + +bool f3(long long *p, long n) +{ + bool r = false; + for(long i = 0; i < 4; ++i) + r ^= (p[i] != 0); + return r; +} diff --git a/gcc/testsuite/gcc.target/i386/pr101639_reduc_mask_vqi.c b/gcc/testsuite/gcc.target/i386/pr101639_reduc_mask_vqi.c new file mode 100644 index 0000000..1707f15 --- /dev/null +++ b/gcc/testsuite/gcc.target/i386/pr101639_reduc_mask_vqi.c @@ -0,0 +1,31 @@ +/* { dg-do compile } */ +/* { dg-options "-march=x86-64-v3 -O2" } */ +/* { dg-final { scan-assembler-times "vptest" 2 } } */ +/* { dg-final { scan-assembler-times "sete" 1 } } */ +/* { dg-final { scan-assembler-times "setne" 1 } } */ +/* { dg-final { scan-assembler-times "popcnt" 1 } } */ +/* { dg-final { scan-assembler-times "vpmovmskb" 1 } } */ + +bool f(char * p, long n) +{ + bool r = true; + for(long i = 0; i < 32; ++i) + r &= (p[i] != 0); + return r; +} + +bool f2(char * p, long n) +{ + bool r = false; + for(long i = 0; i < 32; ++i) + r |= (p[i] != 0); + return r; +} + +bool f3(char * p, long n) +{ + bool r = false; + for(long i = 0; i < 32; ++i) + r ^= (p[i] != 0); + return r; +} diff --git a/gcc/testsuite/gcc.target/i386/pr101639_reduc_mask_vsi.c b/gcc/testsuite/gcc.target/i386/pr101639_reduc_mask_vsi.c new file mode 100644 index 0000000..2d4a39f --- /dev/null +++ b/gcc/testsuite/gcc.target/i386/pr101639_reduc_mask_vsi.c @@ -0,0 +1,31 @@ +/* { dg-do compile } */ +/* { dg-options "-march=x86-64-v3 -O2" } */ +/* { dg-final { scan-assembler-times "vptest" 2 } } */ +/* { dg-final { scan-assembler-times "sete" 1 } } */ +/* { dg-final { scan-assembler-times "setne" 1 } } */ +/* { dg-final { scan-assembler-times "popcnt" 1 } } */ +/* { dg-final { scan-assembler-times "vmovmskps" 1 } } */ + +bool f(int * p, long n) +{ + bool r = true; + for(long i = 0; i < 8; ++i) + r &= (p[i] != 0); + return r; +} + +bool f2(int * p, long n) +{ + bool r = false; + for(long i = 0; i < 8; ++i) + r |= (p[i] != 0); + return r; +} + +bool f3(int * p, long n) +{ + bool r = false; + for(long i = 0; i < 8; ++i) + r ^= (p[i] != 0); + return r; +} diff --git a/gcc/testsuite/gfortran.dg/gomp/pr121452-1.f90 b/gcc/testsuite/gfortran.dg/gomp/pr121452-1.f90 new file mode 100644 index 0000000..60697c9 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/gomp/pr121452-1.f90 @@ -0,0 +1,18 @@ +! { dg-do compile } + +! Check that the front end acccepts a CONTINUE statement +! inside an ordered loop. + +implicit none +integer :: i, j +integer :: A(5,5), B(5,5) = 1 + +!$omp do ordered(2) + do 10 i = 1, 5 + do 20 j = 1, 5 + A(i,j) = B(i,j) +20 continue +10 continue + +if (any(A /= 1)) stop 1 +end diff --git a/gcc/testsuite/gfortran.dg/gomp/pr121452-2.f90 b/gcc/testsuite/gfortran.dg/gomp/pr121452-2.f90 new file mode 100644 index 0000000..ab020d4 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/gomp/pr121452-2.f90 @@ -0,0 +1,22 @@ +! { dg-do compile } +! { dg-additional-options "-fdump-tree-original" } + +! Check that the OMP_STRUCTURED_BLOCK that wraps intervening code is accepted by +! the OMP lowering pass. + +implicit none +integer :: i, j, x +integer :: A(5,5), B(5,5) = 1 + +!$omp simd collapse(2) + do i = 1, 5 + do j = 1, 5 + A(i,j) = B(i,j) + end do + x = 1 ! intervening code + end do + +if (any(A /= 1)) stop 1 +end + +! { dg-final { scan-tree-dump "#pragma omp __structured_block" "original" } } diff --git a/gcc/testsuite/gfortran.dg/gomp/pr121452-3.f90 b/gcc/testsuite/gfortran.dg/gomp/pr121452-3.f90 new file mode 100644 index 0000000..605f92c --- /dev/null +++ b/gcc/testsuite/gfortran.dg/gomp/pr121452-3.f90 @@ -0,0 +1,22 @@ +! { dg-do compile } +! { dg-additional-options "-fdump-tree-original" } + +! Check that the OMP_STRUCTURED_BLOCK that wraps intervening code is accepted by +! the OMP lowering pass. + + +implicit none +integer :: i, j +integer :: A(5,5), B(5,5) = 1 + +!$omp simd collapse(2) + do 10 i = 1, 5 + do 20 j = 1, 5 + A(i,j) = B(i,j) +20 continue +10 continue + +if (any(A /= 1)) stop 1 +end + +! { dg-final { scan-tree-dump "#pragma omp __structured_block" "original" } } diff --git a/gcc/testsuite/gfortran.dg/transfer_array_subref_2.f90 b/gcc/testsuite/gfortran.dg/transfer_array_subref_2.f90 new file mode 100644 index 0000000..9ff5198 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/transfer_array_subref_2.f90 @@ -0,0 +1,52 @@ +! { dg-do run } +! { dg-additional-options "-O2 -fdump-tree-optimized" } +! +! PR fortran/122386 - passing of component ref of nested DT array to TRANSFER + +program main + implicit none + integer, parameter :: dp = 4 + + type cx + real(dp) :: re, im + end type cx + + type complex_wrap1 + type(cx) :: z(2) + end type complex_wrap1 + + type complex_wrap2 + type(cx), dimension(:), allocatable :: z + end type complex_wrap2 + + type(complex_wrap1) :: x = complex_wrap1([cx(1,2), cx(3,4)]) + type(complex_wrap2) :: w + + w%z = x%z + + ! The following statements should get optimized away... + if (size (transfer ( x%z%re ,[1.0_dp])) /= 2) error stop 1 + if (size (transfer ((x%z%re),[1.0_dp])) /= 2) error stop 2 + if (size (transfer ([x%z%re],[1.0_dp])) /= 2) error stop 3 + if (size (transfer ( x%z%im ,[1.0_dp])) /= 2) error stop 4 + if (size (transfer ((x%z%im),[1.0_dp])) /= 2) error stop 5 + if (size (transfer ([x%z%im],[1.0_dp])) /= 2) error stop 6 + + ! ... while the following may not: + if (any (transfer ( x%z%re ,[1.0_dp]) /= x%z%re)) stop 7 + if (any (transfer ( x%z%im ,[1.0_dp]) /= x%z%im)) stop 8 + + if (size (transfer ( w%z%re ,[1.0_dp])) /= 2) stop 11 + if (size (transfer ((w%z%re),[1.0_dp])) /= 2) stop 12 + if (size (transfer ([w%z%re],[1.0_dp])) /= 2) stop 13 + if (size (transfer ( w%z%im ,[1.0_dp])) /= 2) stop 14 + if (size (transfer ((w%z%im),[1.0_dp])) /= 2) stop 15 + if (size (transfer ([w%z%im],[1.0_dp])) /= 2) stop 16 + + if (any (transfer ( w%z%re ,[1.0_dp]) /= x%z%re)) stop 17 + if (any (transfer ( w%z%im ,[1.0_dp]) /= x%z%im)) stop 18 + + deallocate (w%z) +end program main + +! { dg-final { scan-tree-dump-not "_gfortran_error_stop_numeric" "optimized" } } diff --git a/gcc/testsuite/lib/target-supports.exp b/gcc/testsuite/lib/target-supports.exp index 2d45dda..f90cd26 100644 --- a/gcc/testsuite/lib/target-supports.exp +++ b/gcc/testsuite/lib/target-supports.exp @@ -336,10 +336,11 @@ proc check_weak_available { } { return 0 } - # VxWorks hardly supports it (vx7 RTPs only) - + # VxWorks supports it only since VxWorks 7 (assumed >= r2) for RTPs. + # Kernel mode works fine as well for our testsuite's purposes. + if { [istarget *-*-vxworks*] } { - return 0 + return [istarget *-*-vxworks7*] } # ELF and ECOFF support it. a.out does with gas/gld but may also with diff --git a/gcc/tree-ssa-phiopt.cc b/gcc/tree-ssa-phiopt.cc index 031184d..88153d3 100644 --- a/gcc/tree-ssa-phiopt.cc +++ b/gcc/tree-ssa-phiopt.cc @@ -1007,7 +1007,34 @@ match_simplify_replacement (basic_block cond_bb, basic_block middle_bb, } if (!result) - return false; + { + /* If we don't get back a MIN/MAX_EXPR still make sure the expression + stays in a form to be recognized by ISA that map to IEEE x > y ? x : y + semantics (that's not IEEE max semantics). */ + if (!HONOR_NANS (type) && !HONOR_SIGNED_ZEROS (type)) + return false; + if (stmt_to_move || stmt_to_move_alt) + return false; + tree_code cmp = gimple_cond_code (stmt); + if (cmp != LT_EXPR && cmp != LE_EXPR + && cmp != GT_EXPR && cmp != GE_EXPR) + return false; + tree lhs = gimple_cond_lhs (stmt); + tree rhs = gimple_cond_rhs (stmt); + /* `lhs CMP rhs ? lhs : rhs` or `lhs CMP rhs ? rhs : lhs` + are only acceptable case here. */ + if ((!operand_equal_for_phi_arg_p (lhs, arg_false) + || !operand_equal_for_phi_arg_p (rhs, arg_true)) + && (!operand_equal_for_phi_arg_p (rhs, arg_false) + || !operand_equal_for_phi_arg_p (lhs, arg_true))) + return false; + seq = nullptr; + result = gimple_build (&seq, cmp, boolean_type_node, lhs, rhs); + result = gimple_build (&seq, COND_EXPR, type, result, + arg_true, arg_false); + statistics_counter_event (cfun, "Non-IEEE FP MIN/MAX PHI replacement", + 1); + } if (dump_file && (dump_flags & TDF_FOLDING)) fprintf (dump_file, "accepted the phiopt match-simplify.\n"); @@ -1767,622 +1794,6 @@ value_replacement (basic_block cond_bb, basic_block middle_bb, return 0; } -/* If VAR is an SSA_NAME that points to a BIT_NOT_EXPR then return the TREE for - the value being inverted. */ - -static tree -strip_bit_not (tree var) -{ - if (TREE_CODE (var) != SSA_NAME) - return NULL_TREE; - - gimple *assign = SSA_NAME_DEF_STMT (var); - if (gimple_code (assign) != GIMPLE_ASSIGN) - return NULL_TREE; - - if (gimple_assign_rhs_code (assign) != BIT_NOT_EXPR) - return NULL_TREE; - - return gimple_assign_rhs1 (assign); -} - -/* Invert a MIN to a MAX or a MAX to a MIN expression CODE. */ - -enum tree_code -invert_minmax_code (enum tree_code code) -{ - switch (code) { - case MIN_EXPR: - return MAX_EXPR; - case MAX_EXPR: - return MIN_EXPR; - default: - gcc_unreachable (); - } -} - -/* The function minmax_replacement does the main work of doing the minmax - replacement. Return true if the replacement is done. Otherwise return - false. - BB is the basic block where the replacement is going to be done on. ARG0 - is argument 0 from the PHI. Likewise for ARG1. - - If THREEWAY_P then expect the BB to be laid out in diamond shape with each - BB containing only a MIN or MAX expression. */ - -static bool -minmax_replacement (basic_block cond_bb, basic_block middle_bb, basic_block alt_middle_bb, - edge e0, edge e1, gphi *phi, tree arg0, tree arg1, bool threeway_p) -{ - tree result; - edge true_edge, false_edge; - enum tree_code minmax, ass_code; - tree smaller, larger, arg_true, arg_false; - gimple_stmt_iterator gsi, gsi_from; - - tree type = TREE_TYPE (gimple_phi_result (phi)); - - gcond *cond = as_a <gcond *> (*gsi_last_bb (cond_bb)); - enum tree_code cmp = gimple_cond_code (cond); - tree rhs = gimple_cond_rhs (cond); - - /* Turn EQ/NE of extreme values to order comparisons. */ - if ((cmp == NE_EXPR || cmp == EQ_EXPR) - && TREE_CODE (rhs) == INTEGER_CST - && INTEGRAL_TYPE_P (TREE_TYPE (rhs))) - { - if (wi::eq_p (wi::to_wide (rhs), wi::min_value (TREE_TYPE (rhs)))) - { - cmp = (cmp == EQ_EXPR) ? LT_EXPR : GE_EXPR; - rhs = wide_int_to_tree (TREE_TYPE (rhs), - wi::min_value (TREE_TYPE (rhs)) + 1); - } - else if (wi::eq_p (wi::to_wide (rhs), wi::max_value (TREE_TYPE (rhs)))) - { - cmp = (cmp == EQ_EXPR) ? GT_EXPR : LE_EXPR; - rhs = wide_int_to_tree (TREE_TYPE (rhs), - wi::max_value (TREE_TYPE (rhs)) - 1); - } - } - - /* This transformation is only valid for order comparisons. Record which - operand is smaller/larger if the result of the comparison is true. */ - tree alt_smaller = NULL_TREE; - tree alt_larger = NULL_TREE; - if (cmp == LT_EXPR || cmp == LE_EXPR) - { - smaller = gimple_cond_lhs (cond); - larger = rhs; - /* If we have smaller < CST it is equivalent to smaller <= CST-1. - Likewise smaller <= CST is equivalent to smaller < CST+1. */ - if (TREE_CODE (larger) == INTEGER_CST - && INTEGRAL_TYPE_P (TREE_TYPE (larger))) - { - if (cmp == LT_EXPR) - { - wi::overflow_type overflow; - wide_int alt = wi::sub (wi::to_wide (larger), 1, - TYPE_SIGN (TREE_TYPE (larger)), - &overflow); - if (! overflow) - alt_larger = wide_int_to_tree (TREE_TYPE (larger), alt); - } - else - { - wi::overflow_type overflow; - wide_int alt = wi::add (wi::to_wide (larger), 1, - TYPE_SIGN (TREE_TYPE (larger)), - &overflow); - if (! overflow) - alt_larger = wide_int_to_tree (TREE_TYPE (larger), alt); - } - } - } - else if (cmp == GT_EXPR || cmp == GE_EXPR) - { - smaller = rhs; - larger = gimple_cond_lhs (cond); - /* If we have larger > CST it is equivalent to larger >= CST+1. - Likewise larger >= CST is equivalent to larger > CST-1. */ - if (TREE_CODE (smaller) == INTEGER_CST - && INTEGRAL_TYPE_P (TREE_TYPE (smaller))) - { - wi::overflow_type overflow; - if (cmp == GT_EXPR) - { - wide_int alt = wi::add (wi::to_wide (smaller), 1, - TYPE_SIGN (TREE_TYPE (smaller)), - &overflow); - if (! overflow) - alt_smaller = wide_int_to_tree (TREE_TYPE (smaller), alt); - } - else - { - wide_int alt = wi::sub (wi::to_wide (smaller), 1, - TYPE_SIGN (TREE_TYPE (smaller)), - &overflow); - if (! overflow) - alt_smaller = wide_int_to_tree (TREE_TYPE (smaller), alt); - } - } - } - else - return false; - - /* Handle the special case of (signed_type)x < 0 being equivalent - to x > MAX_VAL(signed_type) and (signed_type)x >= 0 equivalent - to x <= MAX_VAL(signed_type). */ - if ((cmp == GE_EXPR || cmp == LT_EXPR) - && INTEGRAL_TYPE_P (type) - && TYPE_UNSIGNED (type) - && integer_zerop (rhs)) - { - tree op = gimple_cond_lhs (cond); - if (TREE_CODE (op) == SSA_NAME - && INTEGRAL_TYPE_P (TREE_TYPE (op)) - && !TYPE_UNSIGNED (TREE_TYPE (op))) - { - gimple *def_stmt = SSA_NAME_DEF_STMT (op); - if (gimple_assign_cast_p (def_stmt)) - { - tree op1 = gimple_assign_rhs1 (def_stmt); - if (INTEGRAL_TYPE_P (TREE_TYPE (op1)) - && TYPE_UNSIGNED (TREE_TYPE (op1)) - && (TYPE_PRECISION (TREE_TYPE (op)) - == TYPE_PRECISION (TREE_TYPE (op1))) - && useless_type_conversion_p (type, TREE_TYPE (op1))) - { - wide_int w1 = wi::max_value (TREE_TYPE (op)); - wide_int w2 = wi::add (w1, 1); - if (cmp == LT_EXPR) - { - larger = op1; - smaller = wide_int_to_tree (TREE_TYPE (op1), w1); - alt_smaller = wide_int_to_tree (TREE_TYPE (op1), w2); - alt_larger = NULL_TREE; - } - else - { - smaller = op1; - larger = wide_int_to_tree (TREE_TYPE (op1), w1); - alt_larger = wide_int_to_tree (TREE_TYPE (op1), w2); - alt_smaller = NULL_TREE; - } - } - } - } - } - - /* We need to know which is the true edge and which is the false - edge so that we know if have abs or negative abs. */ - extract_true_false_edges_from_block (cond_bb, &true_edge, &false_edge); - - /* Forward the edges over the middle basic block. */ - if (true_edge->dest == middle_bb) - true_edge = EDGE_SUCC (true_edge->dest, 0); - if (false_edge->dest == middle_bb) - false_edge = EDGE_SUCC (false_edge->dest, 0); - - /* When THREEWAY_P then e1 will point to the edge of the final transition - from middle-bb to end. */ - if (true_edge == e0) - { - if (!threeway_p) - gcc_assert (false_edge == e1); - arg_true = arg0; - arg_false = arg1; - } - else - { - gcc_assert (false_edge == e0); - if (!threeway_p) - gcc_assert (true_edge == e1); - arg_true = arg1; - arg_false = arg0; - } - - if (empty_block_p (middle_bb) - && (!threeway_p - || empty_block_p (alt_middle_bb))) - { - if ((operand_equal_for_phi_arg_p (arg_true, smaller) - || (alt_smaller - && operand_equal_for_phi_arg_p (arg_true, alt_smaller))) - && (operand_equal_for_phi_arg_p (arg_false, larger) - || (alt_larger - && operand_equal_for_phi_arg_p (arg_true, alt_larger)))) - { - /* Case - - if (smaller < larger) - rslt = smaller; - else - rslt = larger; */ - minmax = MIN_EXPR; - } - else if ((operand_equal_for_phi_arg_p (arg_false, smaller) - || (alt_smaller - && operand_equal_for_phi_arg_p (arg_false, alt_smaller))) - && (operand_equal_for_phi_arg_p (arg_true, larger) - || (alt_larger - && operand_equal_for_phi_arg_p (arg_true, alt_larger)))) - minmax = MAX_EXPR; - else - return false; - } - else if (HONOR_NANS (type) || HONOR_SIGNED_ZEROS (type)) - /* The optimization may be unsafe due to NaNs. */ - return false; - else if (middle_bb != alt_middle_bb && threeway_p) - { - /* Recognize the following case: - - if (smaller < larger) - a = MIN (smaller, c); - else - b = MIN (larger, c); - x = PHI <a, b> - - This is equivalent to - - a = MIN (smaller, c); - x = MIN (larger, a); */ - - gimple *assign = last_and_only_stmt (middle_bb); - tree lhs, op0, op1, bound; - tree alt_lhs, alt_op0, alt_op1; - bool invert = false; - - /* When THREEWAY_P then e1 will point to the edge of the final transition - from middle-bb to end. */ - if (true_edge == e0) - gcc_assert (false_edge == EDGE_PRED (e1->src, 0)); - else - gcc_assert (true_edge == EDGE_PRED (e1->src, 0)); - - bool valid_minmax_p = false; - gimple_stmt_iterator it1 - = gsi_start_nondebug_after_labels_bb (middle_bb); - gimple_stmt_iterator it2 - = gsi_start_nondebug_after_labels_bb (alt_middle_bb); - if (gsi_one_nondebug_before_end_p (it1) - && gsi_one_nondebug_before_end_p (it2)) - { - gimple *stmt1 = gsi_stmt (it1); - gimple *stmt2 = gsi_stmt (it2); - if (is_gimple_assign (stmt1) && is_gimple_assign (stmt2)) - { - enum tree_code code1 = gimple_assign_rhs_code (stmt1); - enum tree_code code2 = gimple_assign_rhs_code (stmt2); - valid_minmax_p = (code1 == MIN_EXPR || code1 == MAX_EXPR) - && (code2 == MIN_EXPR || code2 == MAX_EXPR); - } - } - - if (!valid_minmax_p) - return false; - - if (!assign - || gimple_code (assign) != GIMPLE_ASSIGN) - return false; - - /* There cannot be any phi nodes in the middle bb. */ - if (!gimple_seq_empty_p (phi_nodes (middle_bb))) - return false; - - lhs = gimple_assign_lhs (assign); - ass_code = gimple_assign_rhs_code (assign); - if (ass_code != MAX_EXPR && ass_code != MIN_EXPR) - return false; - - op0 = gimple_assign_rhs1 (assign); - op1 = gimple_assign_rhs2 (assign); - - assign = last_and_only_stmt (alt_middle_bb); - if (!assign - || gimple_code (assign) != GIMPLE_ASSIGN) - return false; - - /* There cannot be any phi nodes in the alt middle bb. */ - if (!gimple_seq_empty_p (phi_nodes (alt_middle_bb))) - return false; - - alt_lhs = gimple_assign_lhs (assign); - if (ass_code != gimple_assign_rhs_code (assign)) - return false; - - if (!operand_equal_for_phi_arg_p (lhs, arg_true) - || !operand_equal_for_phi_arg_p (alt_lhs, arg_false)) - return false; - - alt_op0 = gimple_assign_rhs1 (assign); - alt_op1 = gimple_assign_rhs2 (assign); - - if ((operand_equal_for_phi_arg_p (op0, smaller) - || (alt_smaller - && operand_equal_for_phi_arg_p (op0, alt_smaller))) - && (operand_equal_for_phi_arg_p (alt_op0, larger) - || (alt_larger - && operand_equal_for_phi_arg_p (alt_op0, alt_larger)))) - { - /* We got here if the condition is true, i.e., SMALLER < LARGER. */ - if (!operand_equal_for_phi_arg_p (op1, alt_op1)) - return false; - - if ((arg0 = strip_bit_not (op0)) != NULL - && (arg1 = strip_bit_not (alt_op0)) != NULL - && (bound = strip_bit_not (op1)) != NULL) - { - minmax = MAX_EXPR; - ass_code = invert_minmax_code (ass_code); - invert = true; - } - else - { - bound = op1; - minmax = MIN_EXPR; - arg0 = op0; - arg1 = alt_op0; - } - } - else if ((operand_equal_for_phi_arg_p (op0, larger) - || (alt_larger - && operand_equal_for_phi_arg_p (op0, alt_larger))) - && (operand_equal_for_phi_arg_p (alt_op0, smaller) - || (alt_smaller - && operand_equal_for_phi_arg_p (alt_op0, alt_smaller)))) - { - /* We got here if the condition is true, i.e., SMALLER > LARGER. */ - if (!operand_equal_for_phi_arg_p (op1, alt_op1)) - return false; - - if ((arg0 = strip_bit_not (op0)) != NULL - && (arg1 = strip_bit_not (alt_op0)) != NULL - && (bound = strip_bit_not (op1)) != NULL) - { - minmax = MIN_EXPR; - ass_code = invert_minmax_code (ass_code); - invert = true; - } - else - { - bound = op1; - minmax = MAX_EXPR; - arg0 = op0; - arg1 = alt_op0; - } - } - else - return false; - - /* Emit the statement to compute min/max. */ - location_t locus = gimple_location (last_nondebug_stmt (cond_bb)); - gimple_seq stmts = NULL; - tree phi_result = gimple_phi_result (phi); - result = gimple_build (&stmts, locus, minmax, TREE_TYPE (phi_result), - arg0, arg1); - result = gimple_build (&stmts, locus, ass_code, TREE_TYPE (phi_result), - result, bound); - if (invert) - result = gimple_build (&stmts, locus, BIT_NOT_EXPR, TREE_TYPE (phi_result), - result); - - gsi = gsi_last_bb (cond_bb); - gsi_insert_seq_before (&gsi, stmts, GSI_NEW_STMT); - - replace_phi_edge_with_variable (cond_bb, e1, phi, result); - - return true; - } - else if (!threeway_p - || empty_block_p (alt_middle_bb)) - { - /* Recognize the following case, assuming d <= u: - - if (a <= u) - b = MAX (a, d); - x = PHI <b, u> - - This is equivalent to - - b = MAX (a, d); - x = MIN (b, u); */ - - gimple *assign = last_and_only_stmt (middle_bb); - tree lhs, op0, op1, bound; - - if (!single_pred_p (middle_bb)) - return false; - - if (!assign - || gimple_code (assign) != GIMPLE_ASSIGN) - return false; - - /* There cannot be any phi nodes in the middle bb. */ - if (!gimple_seq_empty_p (phi_nodes (middle_bb))) - return false; - - lhs = gimple_assign_lhs (assign); - ass_code = gimple_assign_rhs_code (assign); - if (ass_code != MAX_EXPR && ass_code != MIN_EXPR) - return false; - op0 = gimple_assign_rhs1 (assign); - op1 = gimple_assign_rhs2 (assign); - - if (true_edge->src == middle_bb) - { - /* We got here if the condition is true, i.e., SMALLER < LARGER. */ - if (!operand_equal_for_phi_arg_p (lhs, arg_true)) - return false; - - if (operand_equal_for_phi_arg_p (arg_false, larger) - || (alt_larger - && operand_equal_for_phi_arg_p (arg_false, alt_larger))) - { - /* Case - - if (smaller < larger) - { - r' = MAX_EXPR (smaller, bound) - } - r = PHI <r', larger> --> to be turned to MIN_EXPR. */ - if (ass_code != MAX_EXPR) - return false; - - minmax = MIN_EXPR; - if (operand_equal_for_phi_arg_p (op0, smaller) - || (alt_smaller - && operand_equal_for_phi_arg_p (op0, alt_smaller))) - bound = op1; - else if (operand_equal_for_phi_arg_p (op1, smaller) - || (alt_smaller - && operand_equal_for_phi_arg_p (op1, alt_smaller))) - bound = op0; - else - return false; - - /* We need BOUND <= LARGER. */ - if (!integer_nonzerop (fold_build2 (LE_EXPR, boolean_type_node, - bound, arg_false))) - return false; - } - else if (operand_equal_for_phi_arg_p (arg_false, smaller) - || (alt_smaller - && operand_equal_for_phi_arg_p (arg_false, alt_smaller))) - { - /* Case - - if (smaller < larger) - { - r' = MIN_EXPR (larger, bound) - } - r = PHI <r', smaller> --> to be turned to MAX_EXPR. */ - if (ass_code != MIN_EXPR) - return false; - - minmax = MAX_EXPR; - if (operand_equal_for_phi_arg_p (op0, larger) - || (alt_larger - && operand_equal_for_phi_arg_p (op0, alt_larger))) - bound = op1; - else if (operand_equal_for_phi_arg_p (op1, larger) - || (alt_larger - && operand_equal_for_phi_arg_p (op1, alt_larger))) - bound = op0; - else - return false; - - /* We need BOUND >= SMALLER. */ - if (!integer_nonzerop (fold_build2 (GE_EXPR, boolean_type_node, - bound, arg_false))) - return false; - } - else - return false; - } - else - { - /* We got here if the condition is false, i.e., SMALLER > LARGER. */ - if (!operand_equal_for_phi_arg_p (lhs, arg_false)) - return false; - - if (operand_equal_for_phi_arg_p (arg_true, larger) - || (alt_larger - && operand_equal_for_phi_arg_p (arg_true, alt_larger))) - { - /* Case - - if (smaller > larger) - { - r' = MIN_EXPR (smaller, bound) - } - r = PHI <r', larger> --> to be turned to MAX_EXPR. */ - if (ass_code != MIN_EXPR) - return false; - - minmax = MAX_EXPR; - if (operand_equal_for_phi_arg_p (op0, smaller) - || (alt_smaller - && operand_equal_for_phi_arg_p (op0, alt_smaller))) - bound = op1; - else if (operand_equal_for_phi_arg_p (op1, smaller) - || (alt_smaller - && operand_equal_for_phi_arg_p (op1, alt_smaller))) - bound = op0; - else - return false; - - /* We need BOUND >= LARGER. */ - if (!integer_nonzerop (fold_build2 (GE_EXPR, boolean_type_node, - bound, arg_true))) - return false; - } - else if (operand_equal_for_phi_arg_p (arg_true, smaller) - || (alt_smaller - && operand_equal_for_phi_arg_p (arg_true, alt_smaller))) - { - /* Case - - if (smaller > larger) - { - r' = MAX_EXPR (larger, bound) - } - r = PHI <r', smaller> --> to be turned to MIN_EXPR. */ - if (ass_code != MAX_EXPR) - return false; - - minmax = MIN_EXPR; - if (operand_equal_for_phi_arg_p (op0, larger)) - bound = op1; - else if (operand_equal_for_phi_arg_p (op1, larger)) - bound = op0; - else - return false; - - /* We need BOUND <= SMALLER. */ - if (!integer_nonzerop (fold_build2 (LE_EXPR, boolean_type_node, - bound, arg_true))) - return false; - } - else - return false; - } - - /* Move the statement from the middle block. */ - gsi = gsi_last_bb (cond_bb); - gsi_from = gsi_last_nondebug_bb (middle_bb); - reset_flow_sensitive_info (SINGLE_SSA_TREE_OPERAND (gsi_stmt (gsi_from), - SSA_OP_DEF)); - gsi_move_before (&gsi_from, &gsi); - } - else - return false; - - /* Emit the statement to compute min/max. */ - gimple_seq stmts = NULL; - tree phi_result = gimple_phi_result (phi); - - /* When we can't use a MIN/MAX_EXPR still make sure the expression - stays in a form to be recognized by ISA that map to IEEE x > y ? x : y - semantics (that's not IEEE max semantics). */ - if (HONOR_NANS (type) || HONOR_SIGNED_ZEROS (type)) - { - result = gimple_build (&stmts, cmp, boolean_type_node, - gimple_cond_lhs (cond), rhs); - result = gimple_build (&stmts, COND_EXPR, TREE_TYPE (phi_result), - result, arg_true, arg_false); - } - else - result = gimple_build (&stmts, minmax, TREE_TYPE (phi_result), arg0, arg1); - - gsi = gsi_last_bb (cond_bb); - gsi_insert_seq_before (&gsi, stmts, GSI_NEW_STMT); - - replace_phi_edge_with_variable (cond_bb, e1, phi, result); - - return true; -} - /* Attempt to optimize (x <=> y) cmp 0 and similar comparisons. For strong ordering <=> try to match something like: <bb 2> : // cond3_bb (== cond2_bb) @@ -4365,9 +3776,8 @@ execute_over_cond_phis (func_type func) But in this case bb1/bb2 can only be forwarding basic blocks. This fully replaces the old "Conditional Replacement", - "ABS Replacement" transformations as they are now + "ABS Replacement" and "MIN/MAX Replacement" transformations as they are now implmeneted in match.pd. - Some parts of the "MIN/MAX Replacement" are re-implemented in match.pd. Value Replacement ----------------- @@ -4409,26 +3819,6 @@ execute_over_cond_phis (func_type func) t3 = t1 & t2; x = a; - MIN/MAX Replacement - ------------------- - - This transformation, minmax_replacement replaces - - bb0: - if (a <= b) goto bb2; else goto bb1; - bb1: - bb2: - x = PHI <b (bb1), a (bb0), ...>; - - with - - bb0: - x' = MIN_EXPR (a, b) - bb2: - x = PHI <x' (bb0), ...>; - - A similar transformation is done for MAX_EXPR. - This pass also performs a fifth transformation of a slightly different flavor. @@ -4642,9 +4032,6 @@ pass_phiopt::execute (function *) && cond_removal_in_builtin_zero_pattern (bb, bb1, e1, e2, phi, arg0, arg1)) cfgchanged = true; - else if (minmax_replacement (bb, bb1, bb2, e1, e2, phi, arg0, arg1, - diamond_p)) - cfgchanged = true; else if (single_pred_p (bb1) && !diamond_p && spaceship_replacement (bb, bb1, e1, e2, phi, arg0, arg1)) diff --git a/gcc/tree-vect-loop.cc b/gcc/tree-vect-loop.cc index 9320bf8..50cdc2a 100644 --- a/gcc/tree-vect-loop.cc +++ b/gcc/tree-vect-loop.cc @@ -738,7 +738,6 @@ _loop_vec_info::_loop_vec_info (class loop *loop_in, vec_info_shared *shared) nonlinear_iv (false), ivexpr_map (NULL), scan_map (NULL), - slp_unrolling_factor (1), inner_loop_cost_factor (param_vect_inner_loop_cost_factor), vectorizable (false), can_use_partial_vectors_p (param_vect_partial_vector_usage != 0), @@ -2236,16 +2235,15 @@ start_over: if (!ok) return ok; - /* If there are any SLP instances mark them as pure_slp. */ + /* If there are any SLP instances mark them as pure_slp and compute + the overall vectorization factor. */ if (!vect_make_slp_decision (loop_vinfo)) return opt_result::failure_at (vect_location, "no stmts to vectorize.\n"); if (dump_enabled_p ()) dump_printf_loc (MSG_NOTE, vect_location, "Loop contains only SLP stmts\n"); - /* Determine the vectorization factor from the SLP decision. */ - LOOP_VINFO_VECT_FACTOR (loop_vinfo) - = LOOP_VINFO_SLP_UNROLLING_FACTOR (loop_vinfo); + /* Dump the vectorization factor from the SLP decision. */ if (dump_enabled_p ()) { dump_printf_loc (MSG_NOTE, vect_location, "vectorization factor = "); @@ -2253,12 +2251,6 @@ start_over: dump_printf (MSG_NOTE, "\n"); } - /* Optimize the SLP graph with the vectorization factor fixed. */ - vect_optimize_slp (loop_vinfo); - - /* Gather the loads reachable from the SLP graph entries. */ - vect_gather_slp_loads (loop_vinfo); - /* We don't expect to have to roll back to anything other than an empty set of rgroups. */ gcc_assert (LOOP_VINFO_MASKS (loop_vinfo).is_empty ()); @@ -2273,6 +2265,12 @@ start_over: poly_uint64 vectorization_factor = LOOP_VINFO_VECT_FACTOR (loop_vinfo); gcc_assert (known_ne (vectorization_factor, 0U)); + /* Optimize the SLP graph with the vectorization factor fixed. */ + vect_optimize_slp (loop_vinfo); + + /* Gather the loads reachable from the SLP graph entries. */ + vect_gather_slp_loads (loop_vinfo); + if (LOOP_VINFO_NITERS_KNOWN_P (loop_vinfo) && dump_enabled_p ()) { dump_printf_loc (MSG_NOTE, vect_location, @@ -2598,7 +2596,7 @@ again: stmt_vec_info vinfo; vinfo = SLP_TREE_SCALAR_STMTS (SLP_INSTANCE_TREE (instance))[0]; - if (! STMT_VINFO_GROUPED_ACCESS (vinfo)) + if (!vinfo || !STMT_VINFO_GROUPED_ACCESS (vinfo)) continue; vinfo = DR_GROUP_FIRST_ELEMENT (vinfo); unsigned int size = DR_GROUP_SIZE (vinfo); @@ -7149,11 +7147,7 @@ vectorizable_reduction (loop_vec_info loop_vinfo, reduction variable. */ slp_tree *slp_op = XALLOCAVEC (slp_tree, op.num_ops); tree *vectype_op = XALLOCAVEC (tree, op.num_ops); - /* We need to skip an extra operand for COND_EXPRs with embedded - comparison. */ - unsigned opno_adjust = 0; - if (op.code == COND_EXPR && COMPARISON_CLASS_P (op.ops[0])) - opno_adjust = 1; + gcc_assert (op.code != COND_EXPR || !COMPARISON_CLASS_P (op.ops[0])); for (i = 0; i < (int) op.num_ops; i++) { /* The condition of COND_EXPR is checked in vectorizable_condition(). */ @@ -7163,7 +7157,7 @@ vectorizable_reduction (loop_vec_info loop_vinfo, stmt_vec_info def_stmt_info; enum vect_def_type dt; if (!vect_is_simple_use (loop_vinfo, slp_for_stmt_info, - i + opno_adjust, &op.ops[i], &slp_op[i], &dt, + i, &op.ops[i], &slp_op[i], &dt, &vectype_op[i], &def_stmt_info)) { if (dump_enabled_p ()) @@ -7174,12 +7168,14 @@ vectorizable_reduction (loop_vec_info loop_vinfo, /* Skip reduction operands, and for an IFN_COND_OP we might hit the reduction operand twice (once as definition, once as else). */ - if (op.ops[i] == op.ops[STMT_VINFO_REDUC_IDX (stmt_info)]) + if (SLP_TREE_CHILDREN (slp_for_stmt_info)[i] + == SLP_TREE_CHILDREN + (slp_for_stmt_info)[SLP_TREE_REDUC_IDX (slp_for_stmt_info)]) continue; /* There should be only one cycle def in the stmt, the one leading to reduc_def. */ - if (VECTORIZABLE_CYCLE_DEF (dt)) + if (SLP_TREE_CHILDREN (slp_for_stmt_info)[i]->cycle_info.id != -1) return false; if (!vectype_op[i]) diff --git a/gcc/tree-vect-slp.cc b/gcc/tree-vect-slp.cc index 9698709..31d8485 100644 --- a/gcc/tree-vect-slp.cc +++ b/gcc/tree-vect-slp.cc @@ -4233,6 +4233,9 @@ vect_analyze_slp_reduc_chain (loop_vec_info vinfo, if (fail) return false; + /* Remember a stmt with the actual reduction operation. */ + stmt_vec_info reduc_scalar_stmt = scalar_stmts[0]; + /* When the SSA def chain through reduc-idx does not form a natural reduction chain try to linearize an associative operation manually. */ if (scalar_stmts.length () == 1 @@ -4240,7 +4243,7 @@ vect_analyze_slp_reduc_chain (loop_vec_info vinfo, && associative_tree_code ((tree_code)code) /* We may not associate if a fold-left reduction is required. */ && !needs_fold_left_reduction_p (TREE_TYPE (gimple_get_lhs - (scalar_stmt->stmt)), + (reduc_scalar_stmt->stmt)), code)) { auto_vec<chain_op_t> chain; @@ -4361,21 +4364,45 @@ vect_analyze_slp_reduc_chain (loop_vec_info vinfo, VECT_REDUC_INFO_FN (reduc_info) = IFN_LAST; reduc_info->is_reduc_chain = true; - /* Build the node for the PHI and possibly the conversion(s?). */ + /* Build the node for the PHI and possibly the conversions. */ slp_tree phis = vect_create_new_slp_node (2, ERROR_MARK); SLP_TREE_REPRESENTATIVE (phis) = next_stmt; phis->cycle_info.id = cycle_id; SLP_TREE_LANES (phis) = group_size; - SLP_TREE_VECTYPE (phis) = SLP_TREE_VECTYPE (node); + if (reduc_scalar_stmt == scalar_stmt) + SLP_TREE_VECTYPE (phis) = SLP_TREE_VECTYPE (node); + else + SLP_TREE_VECTYPE (phis) + = signed_or_unsigned_type_for (TYPE_UNSIGNED + (TREE_TYPE (gimple_get_lhs + (scalar_stmt->stmt))), + SLP_TREE_VECTYPE (node)); /* ??? vect_cse_slp_nodes cannot cope with cycles without any SLP_TREE_SCALAR_STMTS. */ SLP_TREE_SCALAR_STMTS (phis).create (group_size); for (unsigned i = 0; i < group_size; ++i) SLP_TREE_SCALAR_STMTS (phis).quick_push (next_stmt); + slp_tree op_input = phis; + if (reduc_scalar_stmt != scalar_stmt) + { + slp_tree conv = vect_create_new_slp_node (1, ERROR_MARK); + SLP_TREE_REPRESENTATIVE (conv) + = vinfo->lookup_def (gimple_arg (reduc_scalar_stmt->stmt, + STMT_VINFO_REDUC_IDX + (reduc_scalar_stmt))); + SLP_TREE_CHILDREN (conv).quick_push (phis); + conv->cycle_info.id = cycle_id; + SLP_TREE_REDUC_IDX (conv) = 0; + SLP_TREE_LANES (conv) = group_size; + SLP_TREE_VECTYPE (conv) = SLP_TREE_VECTYPE (node); + SLP_TREE_SCALAR_STMTS (conv) = vNULL; + op_input = conv; + } + slp_tree reduc = vect_create_new_slp_node (2, ERROR_MARK); - SLP_TREE_REPRESENTATIVE (reduc) = scalar_stmt; - SLP_TREE_CHILDREN (reduc).quick_push (phis); + SLP_TREE_REPRESENTATIVE (reduc) = reduc_scalar_stmt; + SLP_TREE_CHILDREN (reduc).quick_push (op_input); SLP_TREE_CHILDREN (reduc).quick_push (node); reduc->cycle_info.id = cycle_id; SLP_TREE_REDUC_IDX (reduc) = 0; @@ -4383,10 +4410,27 @@ vect_analyze_slp_reduc_chain (loop_vec_info vinfo, SLP_TREE_VECTYPE (reduc) = SLP_TREE_VECTYPE (node); /* ??? For the reduction epilogue we need a live lane. */ SLP_TREE_SCALAR_STMTS (reduc).create (group_size); - SLP_TREE_SCALAR_STMTS (reduc).quick_push (scalar_stmt); + SLP_TREE_SCALAR_STMTS (reduc).quick_push (reduc_scalar_stmt); for (unsigned i = 1; i < group_size; ++i) SLP_TREE_SCALAR_STMTS (reduc).quick_push (NULL); + if (reduc_scalar_stmt != scalar_stmt) + { + slp_tree conv = vect_create_new_slp_node (1, ERROR_MARK); + SLP_TREE_REPRESENTATIVE (conv) = scalar_stmt; + SLP_TREE_CHILDREN (conv).quick_push (reduc); + conv->cycle_info.id = cycle_id; + SLP_TREE_REDUC_IDX (conv) = 0; + SLP_TREE_LANES (conv) = group_size; + SLP_TREE_VECTYPE (conv) = SLP_TREE_VECTYPE (phis); + /* ??? For the reduction epilogue we need a live lane. */ + SLP_TREE_SCALAR_STMTS (conv).create (group_size); + SLP_TREE_SCALAR_STMTS (conv).quick_push (scalar_stmt); + for (unsigned i = 1; i < group_size; ++i) + SLP_TREE_SCALAR_STMTS (conv).quick_push (NULL); + reduc = conv; + } + edge le = loop_latch_edge (LOOP_VINFO_LOOP (vinfo)); SLP_TREE_CHILDREN (phis).quick_push (NULL); SLP_TREE_CHILDREN (phis).quick_push (NULL); @@ -8171,7 +8215,7 @@ vect_make_slp_decision (loop_vec_info loop_vinfo) decided_to_slp++; } - LOOP_VINFO_SLP_UNROLLING_FACTOR (loop_vinfo) = unrolling_factor; + LOOP_VINFO_VECT_FACTOR (loop_vinfo) = unrolling_factor; if (decided_to_slp && dump_enabled_p ()) { diff --git a/gcc/tree-vectorizer.h b/gcc/tree-vectorizer.h index 905a291..56b3a5a 100644 --- a/gcc/tree-vectorizer.h +++ b/gcc/tree-vectorizer.h @@ -945,7 +945,8 @@ public: used. */ poly_uint64 versioning_threshold; - /* Unrolling factor */ + /* Unrolling factor. In case of suitable super-word parallelism + it can be that no unrolling is needed, and thus this is 1. */ poly_uint64 vectorization_factor; /* If this loop is an epilogue loop whose main loop can be skipped, @@ -1090,10 +1091,6 @@ public: rhs of the store of the initializer. */ hash_map<tree, tree> *scan_map; - /* The unrolling factor needed to SLP the loop. In case of that pure SLP is - applied to the loop, i.e., no unrolling is needed, this is 1. */ - poly_uint64 slp_unrolling_factor; - /* The factor used to over weight those statements in an inner loop relative to the loop being vectorized. */ unsigned int inner_loop_cost_factor; @@ -1294,7 +1291,6 @@ public: #define LOOP_VINFO_USER_UNROLL(L) (L)->user_unroll #define LOOP_VINFO_GROUPED_STORES(L) (L)->grouped_stores #define LOOP_VINFO_SLP_INSTANCES(L) (L)->slp_instances -#define LOOP_VINFO_SLP_UNROLLING_FACTOR(L) (L)->slp_unrolling_factor #define LOOP_VINFO_REDUCTIONS(L) (L)->reductions #define LOOP_VINFO_PEELING_FOR_GAPS(L) (L)->peeling_for_gaps #define LOOP_VINFO_PEELING_FOR_NITER(L) (L)->peeling_for_niter |