diff options
Diffstat (limited to 'gcc')
94 files changed, 3109 insertions, 354 deletions
diff --git a/gcc/ChangeLog b/gcc/ChangeLog index dd930d6..8bdba01 100644 --- a/gcc/ChangeLog +++ b/gcc/ChangeLog @@ -1,3 +1,94 @@ +2025-10-25 Sam James <sam@gentoo.org> + + * doc/extend.texi (nocf_check): Fix syntax errors in example. + +2025-10-25 Jiahao Xu <xujiahao@loongson.cn> + + * config/loongarch/lasx.md (vec_extract<mode><lasxhalf>): New define_expand. + (vec_extract_lo_<mode>): New define_insn_and_split. + (vec_extract_hi_<mode>): New define_insn. + * config/loongarch/loongarch-protos.h (loongarch_check_vect_par_cnst_half) + New function prototype. + * config/loongarch/loongarch.cc (loongarch_split_reduction): + Implement TARGET_VECTORIZE_SPLIT_REDUCTION. + (loongarch_check_vect_par_cnst_half): New function. + * config/loongarch/predicates.md + (vect_par_cnst_low_half): New predicate. + (vect_par_cnst_high_half): New predicate. + +2025-10-24 Andrew MacLeod <amacleod@redhat.com> + + PR tree-optimization/114025 + * gimple-range-fold.cc (fold_using_range::condexpr_adjust): Handle + the same ssa_name in the condition and the COND_EXPR better. + +2025-10-24 Andrew MacLeod <amacleod@redhat.com> + + * range-op.cc (operator_bitwise_and::wi_fold): Split signed + operations crossing zero into 2 operations. + +2025-10-24 Andrew MacLeod <amacleod@redhat.com> + + PR tree-optimization/118254 + PR tree-optimization/114331 + * range-op.cc (operator_cast::fold_range): When VARYING is + reached, update the bitmask if we reach VARYING. + (operator_cast::op1_range): For truncating casts, create a + bitmask bit in LHS. + +2025-10-24 Takayuki 'January June' Suwa <jjsuwa_sys3175@yahoo.co.jp> + + * config/xtensa/xtensa.md (call_internal, call_value_internal, + sibcall_internal, sibcall_value_internal): Remove 'n'-constraint. + +2025-10-24 Takayuki 'January June' Suwa <jjsuwa_sys3175@yahoo.co.jp> + + * config/xtensa/xtensa.md (*addsubx, *subsi3_from_const, + *xtensa_clamps, *andsi3_const_pow2_minus_one, + *andsi3_const_negative_pow2, *andsi3_const_shifted_mask, + *splice_bits, extvsi_internal, extzvsi_internal, + *extzvsi-1bit_ashlsi3, *extzvsi-1bit_addsubx, insvsi, *lsiu, *ssiu, + *lsip, *ssip, *shift_per_byte_omit_AND_0, *shift_per_byte_omit_AND_1, + *shlrd_const, *shlrd_per_byte_omit_AND, *masktrue_const_bitcmpl, + *masktrue_const_pow2_minus_one, *masktrue_const_negative_pow2, + *masktrue_const_shifted_mask, call_internal, call_value_internal, + sibcall_internal, sibcall_value_internal, entry, + *eqne_zero_masked_bits, *eqne_in_range): Remove 'i'-constraint. + +2025-10-24 Josef Melcr <jmelcr02@gmail.com> + + PR middle-end/122392 + * attr-callback.cc (callback_build_attr): Remove erroneous + annotation. + +2025-10-24 Richard Biener <rguenther@suse.de> + + * tree-vect-loop.cc (vectorizable_reduction): SLP-ify reduction + operation processing a bit more. + +2025-10-24 Richard Biener <rguenther@suse.de> + + PR tree-optimization/122406 + * tree-vect-slp.cc (vect_analyze_slp_reduc_chain): Create + the SLP nodes for the conversions around the reduction + operation if required. + +2025-10-24 Paul-Antoine Arras <parras@baylibre.com> + + PR fortran/121452 + * omp-low.cc (check_omp_nesting_restrictions): Accept an + OMP_STRUCTURED_BLOCK in a collapsed simd region and in an ordered loop. + +2025-10-24 Pengfei Li <Pengfei.Li2@arm.com> + + * match.pd: Fold VEC_PERM_EXPR chains implementing vector + concat-and-extract. + +2025-10-24 Olivier Hainque <hainque@adacore.com> + + * config/rs6000/vxworks.h (SET_CMODEL): Undefine before + (re)defining. + 2025-10-23 Andrew Pinski <andrew.pinski@oss.qualcomm.com> * match.pd (`(type1)x CMP CST1 ? (type2)x : CST2`): Better handling diff --git a/gcc/DATESTAMP b/gcc/DATESTAMP index a234d9f..8a8350a 100644 --- a/gcc/DATESTAMP +++ b/gcc/DATESTAMP @@ -1 +1 @@ -20251024 +20251026 diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 806a2ca..a732e94 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,44 @@ +2025-10-24 Eric Botcazou <ebotcazou@adacore.com> + + PR ada/80033 + * gcc-interface/Makefile.in (force): Restore. + +2025-10-24 Nicolas Boulenguez <nicolas@debian.org> + + PR ada/80033 + * gcc-interface/Makefile.in (deftarg.o): Delete. + (init-vxsim.o): Likewise. + (force): Likewise. + +2025-10-24 Mivirl <octoberstargazer7405@mivirl.dev> + + PR ada/122367 + * rtinit.c (__gnat_runtime_initialize) [__MINGW32__]: Fix detection + of quoted arguments. + +2025-10-24 Eric Botcazou <ebotcazou@adacore.com> + + PR ada/118782 + * styleg.adb (Is_Box_Comment): Also stop the loop at EOF. + +2025-10-24 Eric Botcazou <ebotcazou@adacore.com> + + PR ada/113516 + * s-oscons-tmplt.c [_WIN32]: Undefine POLLPRI before redefining it. + +2025-10-24 Eric Botcazou <ebotcazou@adacore.com> + + PR ada/98879 + * terminals.c (__gnat_setup_child_communication) [_WIN32]: Add else + blocks in the processing of the data returned by ReadFile. + +2025-10-24 Nicolas Boulenguez <nicolas@debian.org> + + PR ada/81087 + * gnatlink.adb (Is_Prefix): Move around, streamline and return false + when the prefix is not strict. + (Gnatlink): Fix other instances of incorrect lower bound assumption. + 2025-10-20 Eric Botcazou <ebotcazou@adacore.com> PR ada/102078 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/sem_prag.adb b/gcc/ada/sem_prag.adb index 28c5f17..6b38de0 100644 --- a/gcc/ada/sem_prag.adb +++ b/gcc/ada/sem_prag.adb @@ -21867,8 +21867,17 @@ package body Sem_Prag is if Rep_Item_Too_Late (Def_Id, N) then return; - else - Set_Has_Gigi_Rep_Item (Def_Id); + end if; + + Set_Has_Gigi_Rep_Item (Def_Id); + + -- The pragma is processed directly by the back end when Def_Id is + -- translated. If the argument is not a string literal, it may be + -- declared after Def_Id and before the pragma, which requires the + -- processing of Def_Id to be delayed for the back end. + + if Nkind (Get_Pragma_Arg (Arg2)) /= N_String_Literal then + Set_Has_Delayed_Freeze (Def_Id); end if; end Machine_Attribute; 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/ChangeLog b/gcc/c/ChangeLog index 6f51dd9..89a1bbe 100644 --- a/gcc/c/ChangeLog +++ b/gcc/c/ChangeLog @@ -1,3 +1,18 @@ +2025-10-24 Joseph Myers <josmyers@redhat.com> + + * c-parser.cc (c_parser_next_tokens_start_typename) + (c_parser_next_tokens_start_declaration): Add argument for token + to start from + (c_parser_next_tokens_start_declaration): Check for whether static + assertion followed by semicolon. + (c_parser_check_balanced_raw_token_sequence): Declare earlier. + (c_parser_compound_statement_nostart, c_parser_for_statement): Use + c_parser_next_tokens_start_declaration not + c_token_starts_declaration on second token. + (c_parser_unary_expression): Handle static assertions. + * c-parser.h (c_parser_next_tokens_start_declaration): Add + argument. + 2025-10-21 Martin Uecker <uecker@tugraz.at> * c-decl.cc (build_array_declarator): Remove error. 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/Make-lang.in b/gcc/cobol/Make-lang.in index 1f9995f..ed6b588 100644 --- a/gcc/cobol/Make-lang.in +++ b/gcc/cobol/Make-lang.in @@ -245,7 +245,7 @@ cobol/scan.o: cobol/scan.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 \ + @if [ -f $@.gen ]; then \ $@.gen $(subst .cc,.h,$^) \ | diff -u $@ - \ | patch -t --set-time $@ ; \ diff --git a/gcc/config/loongarch/lasx.md b/gcc/config/loongarch/lasx.md index 3d71f30..eed4d2b 100644 --- a/gcc/config/loongarch/lasx.md +++ b/gcc/config/loongarch/lasx.md @@ -633,6 +633,48 @@ [(set_attr "move_type" "fmove") (set_attr "mode" "<UNITMODE>")]) +(define_expand "vec_extract<mode><lasxhalf>" + [(match_operand:<VHMODE256_ALL> 0 "register_operand") + (match_operand:LASX 1 "register_operand") + (match_operand 2 "const_0_or_1_operand")] + "ISA_HAS_LASX" +{ + if (INTVAL (operands[2])) + { + operands[2] = loongarch_lsx_vec_parallel_const_half (<MODE>mode, true); + emit_insn (gen_vec_extract_hi_<mode> (operands[0], operands[1], + operands[2])); + } + else + { + operands[2] = loongarch_lsx_vec_parallel_const_half (<MODE>mode, false); + emit_insn (gen_vec_extract_lo_<mode> (operands[0], operands[1], + operands[2])); + } + DONE; +}) + +(define_insn_and_split "vec_extract_lo_<mode>" + [(set (match_operand:<VHMODE256_ALL> 0 "register_operand" "=f") + (vec_select:<VHMODE256_ALL> + (match_operand:LASX 1 "register_operand" "f") + (match_operand:LASX 2 "vect_par_cnst_low_half")))] + "ISA_HAS_LASX" + "#" + "&& reload_completed" + [(set (match_dup 0) (match_dup 1))] + "operands[1] = gen_lowpart (<VHMODE256_ALL>mode, operands[1]);") + +(define_insn "vec_extract_hi_<mode>" + [(set (match_operand:<VHMODE256_ALL> 0 "register_operand" "=f") + (vec_select:<VHMODE256_ALL> + (match_operand:LASX 1 "register_operand" "f") + (match_operand:LASX 2 "vect_par_cnst_high_half")))] + "ISA_HAS_LASX" + "xvpermi.d\t%u0,%u1,0xe" + [(set_attr "move_type" "fmove") + (set_attr "mode" "<MODE>")]) + (define_expand "vec_perm<mode>" [(match_operand:LASX 0 "register_operand") (match_operand:LASX 1 "register_operand") diff --git a/gcc/config/loongarch/loongarch-protos.h b/gcc/config/loongarch/loongarch-protos.h index 6139af4..6ecbe27 100644 --- a/gcc/config/loongarch/loongarch-protos.h +++ b/gcc/config/loongarch/loongarch-protos.h @@ -121,6 +121,7 @@ extern bool loongarch_const_vector_same_int_p (rtx, machine_mode, extern bool loongarch_const_vector_shuffle_set_p (rtx, machine_mode); extern bool loongarch_const_vector_bitimm_set_p (rtx, machine_mode); extern bool loongarch_const_vector_bitimm_clr_p (rtx, machine_mode); +extern bool loongarch_check_vect_par_cnst_half (rtx, machine_mode, bool); extern rtx loongarch_const_vector_vrepli (rtx, machine_mode); extern rtx loongarch_lsx_vec_parallel_const_half (machine_mode, bool); extern rtx loongarch_gen_const_int_vector (machine_mode, HOST_WIDE_INT); diff --git a/gcc/config/loongarch/loongarch.cc b/gcc/config/loongarch/loongarch.cc index 3fe8c76..c782cac 100644 --- a/gcc/config/loongarch/loongarch.cc +++ b/gcc/config/loongarch/loongarch.cc @@ -1846,6 +1846,37 @@ loongarch_const_vector_shuffle_set_p (rtx op, machine_mode mode) return true; } +/* Check if OP is a PARALLEL RTX with CONST_INT elements representing + the HIGH (high_p == TRUE) or LOW (high_p == FALSE) half of a vector + for mode MODE. Returns true if the pattern matches, false otherwise. */ + +bool +loongarch_check_vect_par_cnst_half (rtx op, machine_mode mode, bool high_p) +{ + int nunits = XVECLEN (op, 0); + int nelts = GET_MODE_NUNITS (mode); + + if (!known_eq (nelts, nunits * 2)) + return false; + + rtx first = XVECEXP (op, 0, 0); + if (!CONST_INT_P (first)) + return false; + + int base = high_p ? nelts / 2 : 0; + if (INTVAL (first) != base) + return false; + + for (int i = 1; i < nunits; i++) + { + rtx elem = XVECEXP (op, 0, i); + if (!CONST_INT_P (elem) || INTVAL (elem) != INTVAL (first) + i) + return false; + } + + return true; +} + rtx loongarch_const_vector_vrepli (rtx x, machine_mode mode) { @@ -4143,6 +4174,19 @@ loongarch_rtx_costs (rtx x, machine_mode mode, int outer_code, } } +/* All CPUs prefer to avoid cross-lane operations so perform reductions + upper against lower halves up to LSX reg size. */ + +machine_mode +loongarch_split_reduction (machine_mode mode) +{ + if (LSX_SUPPORTED_MODE_P (mode)) + return mode; + + return mode_for_vector (as_a <scalar_mode> (GET_MODE_INNER (mode)), + GET_MODE_NUNITS (mode) / 2).require (); +} + /* Implement targetm.vectorize.builtin_vectorization_cost. */ static int @@ -11397,6 +11441,10 @@ loongarch_can_inline_p (tree caller, tree callee) #define TARGET_VECTORIZE_AUTOVECTORIZE_VECTOR_MODES \ loongarch_autovectorize_vector_modes +#undef TARGET_VECTORIZE_SPLIT_REDUCTION +#define TARGET_VECTORIZE_SPLIT_REDUCTION \ + loongarch_split_reduction + #undef TARGET_OPTAB_SUPPORTED_P #define TARGET_OPTAB_SUPPORTED_P loongarch_optab_supported_p diff --git a/gcc/config/loongarch/predicates.md b/gcc/config/loongarch/predicates.md index fd2d7b9..34cf74d 100644 --- a/gcc/config/loongarch/predicates.md +++ b/gcc/config/loongarch/predicates.md @@ -699,3 +699,19 @@ return true; }) + +;; PARALLEL for a vec_select that selects the low half +;; elements of a vector of MODE. +(define_special_predicate "vect_par_cnst_low_half" + (match_code "parallel") +{ + return loongarch_check_vect_par_cnst_half (op, mode, false); +}) + +;; PARALLEL for a vec_select that selects the high half +;; elements of a vector of MODE. +(define_special_predicate "vect_par_cnst_high_half" + (match_code "parallel") +{ + return loongarch_check_vect_par_cnst_half (op, mode, true);; +}) 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/doc/extend.texi b/gcc/doc/extend.texi index fb117f5..882c082 100644 --- a/gcc/doc/extend.texi +++ b/gcc/doc/extend.texi @@ -6896,15 +6896,14 @@ compiler checks for @code{nocf_check} attribute mismatch and reports a warning in case of mismatch. @smallexample -@{ -int foo (void) __attribute__(nocf_check); -void (*foo1)(void) __attribute__(nocf_check); +int foo (void) __attribute__((nocf_check)); +void (*foo1)(void) __attribute__((nocf_check)); void (*foo2)(void); /* foo's address is assumed to be valid. */ int foo (void) - +@{ /* This call site is not checked for control-flow validity. */ (*foo1)(); diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 792f3c7..bf5bcd63 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,26 @@ +2025-10-25 Harald Anlauf <anlauf@gmx.de> + + PR fortran/114023 + * trans-expr.cc (gfc_trans_pointer_assignment): Always set dtype + when remapping a pointer. For unlimited polymorphic LHS use + elem_len from RHS. + * trans-intrinsic.cc (gfc_conv_is_contiguous_expr): Extend inline + generated code for IS_CONTIGUOUS for pointer arguments to detect + when span differs from the element size. + +2025-10-24 Harald Anlauf <anlauf@gmx.de> + + PR fortran/122386 + * dependency.cc (gfc_ref_needs_temporary_p): Revert r16-518. + * trans-intrinsic.cc (gfc_conv_intrinsic_transfer): Force temporary + for SOURCE not being a simply-contiguous array. + +2025-10-24 Paul-Antoine Arras <parras@baylibre.com> + + PR fortran/121452 + * openmp.cc (resolve_omp_do): Allow CONTINUE as end statement of a + perfectly nested loop. + 2025-10-21 Paul-Antoine Arras <parras@baylibre.com> PR c/120180 diff --git a/gcc/fortran/decl.cc b/gcc/fortran/decl.cc index 5da3c26..569786a 100644 --- a/gcc/fortran/decl.cc +++ b/gcc/fortran/decl.cc @@ -3101,7 +3101,16 @@ variable_decl (int elem) goto cleanup; } - m = gfc_match_init_expr (&initializer); + if (gfc_comp_struct (gfc_current_state ()) + && gfc_current_block ()->attr.pdt_template) + { + m = gfc_match_expr (&initializer); + if (initializer && initializer->ts.type == BT_UNKNOWN) + initializer->ts = current_ts; + } + else + m = gfc_match_init_expr (&initializer); + if (m == MATCH_NO) { gfc_error ("Expected an initialization expression at %C"); @@ -3179,7 +3188,7 @@ variable_decl (int elem) gfc_error ("BOZ literal constant at %L cannot appear as an " "initializer", &initializer->where); m = MATCH_ERROR; - goto cleanup; + goto cleanup; } param->value = gfc_copy_expr (initializer); } @@ -4035,8 +4044,8 @@ gfc_get_pdt_instance (gfc_actual_arglist *param_list, gfc_symbol **sym, gfc_insert_parameter_exprs (kind_expr, type_param_spec_list); ok = gfc_simplify_expr (kind_expr, 1); - /* Variable expressions seem to default to BT_PROCEDURE. - TODO find out why this is and fix it. */ + /* Variable expressions default to BT_PROCEDURE in the absence of an + initializer so allow for this. */ if (kind_expr->ts.type != BT_INTEGER && kind_expr->ts.type != BT_PROCEDURE) { @@ -4271,6 +4280,9 @@ gfc_get_pdt_instance (gfc_actual_arglist *param_list, gfc_symbol **sym, if (!c2->initializer && c1->initializer) c2->initializer = gfc_copy_expr (c1->initializer); + + if (c2->initializer) + gfc_insert_parameter_exprs (c2->initializer, type_param_spec_list); } /* Copy the array spec. */ @@ -4374,7 +4386,21 @@ gfc_get_pdt_instance (gfc_actual_arglist *param_list, gfc_symbol **sym, } else if (!(c2->attr.pdt_kind || c2->attr.pdt_len || c2->attr.pdt_string || c2->attr.pdt_array) && c1->initializer) - c2->initializer = gfc_copy_expr (c1->initializer); + { + c2->initializer = gfc_copy_expr (c1->initializer); + if (c2->initializer->ts.type == BT_UNKNOWN) + c2->initializer->ts = c2->ts; + gfc_insert_parameter_exprs (c2->initializer, type_param_spec_list); + /* The template initializers are parsed using gfc_match_expr rather + than gfc_match_init_expr. Apply the missing reduction to the + PDT instance initializers. */ + if (!gfc_reduce_init_expr (c2->initializer)) + { + gfc_free_expr (c2->initializer); + goto error_return; + } + gfc_simplify_expr (c2->initializer, 1); + } } if (alloc_seen) 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/primary.cc b/gcc/fortran/primary.cc index cba4208..2d2c664 100644 --- a/gcc/fortran/primary.cc +++ b/gcc/fortran/primary.cc @@ -2071,6 +2071,23 @@ gfc_match_actual_arglist (int sub_flag, gfc_actual_arglist **argp, bool pdt) } } + /* PDT kind expressions are acceptable as initialization expressions. + However, intrinsics with a KIND argument reject them. Convert the + expression now by use of the component initializer. */ + if (tail->expr + && tail->expr->expr_type == EXPR_VARIABLE + && gfc_expr_attr (tail->expr).pdt_kind) + { + gfc_ref *ref; + gfc_expr *tmp = NULL; + for (ref = tail->expr->ref; ref; ref = ref->next) + if (!ref->next && ref->type == REF_COMPONENT + && ref->u.c.component->attr.pdt_kind + && ref->u.c.component->initializer) + tmp = gfc_copy_expr (ref->u.c.component->initializer); + if (tmp) + gfc_replace_expr (tail->expr, tmp); + } next: if (gfc_match_char (')') == MATCH_YES) diff --git a/gcc/fortran/resolve.cc b/gcc/fortran/resolve.cc index 1c49ccf..0d54448 100644 --- a/gcc/fortran/resolve.cc +++ b/gcc/fortran/resolve.cc @@ -16077,10 +16077,13 @@ resolve_typebound_intrinsic_op (gfc_symbol* derived, gfc_intrinsic_op op, /* Preempt 'gfc_check_new_interface' for submodules, where the mechanism for handling module procedures winds up resolving - operator interfaces twice and would otherwise cause an error. */ + operator interfaces twice and would otherwise cause an error. + Likewise, new instances of PDTs can cause the operator inter- + faces to be resolved multiple times. */ for (intr = derived->ns->op[op]; intr; intr = intr->next) if (intr->sym == target_proc - && target_proc->attr.used_in_submodule) + && (target_proc->attr.used_in_submodule + || derived->attr.pdt_type)) return true; if (!gfc_check_new_interface (derived->ns->op[op], diff --git a/gcc/fortran/simplify.cc b/gcc/fortran/simplify.cc index 00b02f3..b25cd2c 100644 --- a/gcc/fortran/simplify.cc +++ b/gcc/fortran/simplify.cc @@ -120,26 +120,10 @@ static int get_kind (bt type, gfc_expr *k, const char *name, int default_kind) { int kind; - gfc_expr *tmp; if (k == NULL) return default_kind; - if (k->expr_type == EXPR_VARIABLE - && k->symtree->n.sym->ts.type == BT_DERIVED - && k->symtree->n.sym->ts.u.derived->attr.pdt_type) - { - gfc_ref *ref; - for (ref = k->ref; ref; ref = ref->next) - if (!ref->next && ref->type == REF_COMPONENT - && ref->u.c.component->attr.pdt_kind - && ref->u.c.component->initializer) - { - tmp = gfc_copy_expr (ref->u.c.component->initializer); - gfc_replace_expr (k, tmp); - } - } - if (k->expr_type != EXPR_CONSTANT) { gfc_error ("KIND parameter of %s at %L must be an initialization " diff --git a/gcc/fortran/trans-expr.cc b/gcc/fortran/trans-expr.cc index 21f256b..67b60c7 100644 --- a/gcc/fortran/trans-expr.cc +++ b/gcc/fortran/trans-expr.cc @@ -11344,21 +11344,33 @@ gfc_trans_pointer_assignment (gfc_expr * expr1, gfc_expr * expr2) int dim; gcc_assert (remap->u.ar.dimen == expr1->rank); + /* Always set dtype. */ + tree dtype = gfc_conv_descriptor_dtype (desc); + tmp = gfc_get_dtype (TREE_TYPE (desc)); + gfc_add_modify (&block, dtype, tmp); + + /* For unlimited polymorphic LHS use elem_len from RHS. */ + if (UNLIMITED_POLY (expr1) && expr2->ts.type != BT_CLASS) + { + tree elem_len; + tmp = TYPE_SIZE_UNIT (gfc_typenode_for_spec (&expr2->ts)); + elem_len = fold_convert (gfc_array_index_type, tmp); + elem_len = gfc_evaluate_now (elem_len, &block); + tmp = gfc_conv_descriptor_elem_len (desc); + gfc_add_modify (&block, tmp, + fold_convert (TREE_TYPE (tmp), elem_len)); + } + if (rank_remap) { /* Do rank remapping. We already have the RHS's descriptor converted in rse and now have to build the correct LHS descriptor for it. */ - tree dtype, data, span; + tree data, span; tree offs, stride; tree lbound, ubound; - /* Set dtype. */ - dtype = gfc_conv_descriptor_dtype (desc); - tmp = gfc_get_dtype (TREE_TYPE (desc)); - gfc_add_modify (&block, dtype, tmp); - /* Copy data pointer. */ data = gfc_conv_descriptor_data_get (rse.expr); gfc_conv_descriptor_data_set (&block, desc, data); diff --git a/gcc/fortran/trans-intrinsic.cc b/gcc/fortran/trans-intrinsic.cc index d1c2a80..89a03d8 100644 --- a/gcc/fortran/trans-intrinsic.cc +++ b/gcc/fortran/trans-intrinsic.cc @@ -2316,10 +2316,14 @@ gfc_conv_is_contiguous_expr (gfc_se *se, gfc_expr *arg) int i; tree fncall0; gfc_array_spec *as; + gfc_symbol *sym = NULL; if (arg->ts.type == BT_CLASS) gfc_add_class_array_ref (arg); + if (arg->expr_type == EXPR_VARIABLE) + sym = arg->symtree->n.sym; + ss = gfc_walk_expr (arg); gcc_assert (ss != gfc_ss_terminator); gfc_init_se (&argse, NULL); @@ -2342,7 +2346,7 @@ gfc_conv_is_contiguous_expr (gfc_se *se, gfc_expr *arg) fncall0 = build_call_expr_loc (input_location, gfor_fndecl_is_contiguous0, 1, desc); se->expr = fncall0; - se->expr = convert (logical_type_node, se->expr); + se->expr = convert (boolean_type_node, se->expr); } else { @@ -2374,6 +2378,22 @@ gfc_conv_is_contiguous_expr (gfc_se *se, gfc_expr *arg) } se->expr = cond; } + + /* A pointer that does not have the CONTIGUOUS attribute needs to be checked + if it points to an array whose span differs from the element size. */ + if (as && sym && IS_POINTER(sym) && !sym->attr.contiguous) + { + tree span = gfc_conv_descriptor_span_get (desc); + tmp = fold_convert (TREE_TYPE (span), + gfc_conv_descriptor_elem_len (desc)); + cond = fold_build2_loc (input_location, EQ_EXPR, boolean_type_node, + span, tmp); + se->expr = fold_build2_loc (input_location, TRUTH_ANDIF_EXPR, + boolean_type_node, cond, + convert (boolean_type_node, se->expr)); + } + + gfc_free_ss_chain (ss); } @@ -8728,13 +8748,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/gimple-range-fold.cc b/gcc/gimple-range-fold.cc index d18b37b..06c645f 100644 --- a/gcc/gimple-range-fold.cc +++ b/gcc/gimple-range-fold.cc @@ -1187,6 +1187,17 @@ fold_using_range::condexpr_adjust (vrange &r1, vrange &r2, gimple *, tree cond, ssa2, src)) r2.intersect (tmp2); } + // If the same name is specified in the condition and COND_EXPR, + // combine the calculated condition range and the other one provided. ie: + // c_1 = b_2 < 10 + // f_3 = c_1 ? 0 : b_2 + // With b_2 providing the false value, the value of f_3 will be + // either 0 UNION (0 = b_2 < 10), which is [-INF, 9]. + // COND_EXPR is + if (ssa1 && cond_name == ssa1) + r1 = cond_true; + else if (ssa2 && cond_name == ssa2) + r2 = cond_false; return true; } diff --git a/gcc/jit/jit-recording.cc b/gcc/jit/jit-recording.cc index 6816a71..5c641f6 100644 --- a/gcc/jit/jit-recording.cc +++ b/gcc/jit/jit-recording.cc @@ -3430,7 +3430,7 @@ recording::string * recording::array_type::make_debug_string () { return string::from_printf (m_ctxt, - "%s[%ld]", + "%s[%" PRIu64 "]", m_element_type->get_debug_string (), m_num_elements); } @@ -3446,7 +3446,7 @@ recording::array_type::write_reproducer (reproducer &r) " gcc_jit_context_new_array_type_u64 (%s,\n" " %s, /* gcc_jit_location *loc */\n" " %s, /* gcc_jit_type *element_type */\n" - " %li); /* int num_elements */\n", + " %" PRIu64 "); /* int num_elements */\n", id, r.get_identifier (get_context ()), r.get_identifier (m_loc), diff --git a/gcc/m2/ChangeLog b/gcc/m2/ChangeLog index b605bf2..155c082 100644 --- a/gcc/m2/ChangeLog +++ b/gcc/m2/ChangeLog @@ -1,3 +1,79 @@ +2025-10-24 Gaius Mulley <gaiusmod2@gmail.com> + + PR modula2/122407 + * gm2-compiler/FilterError.def (Copyright): Use correct + licence. + * gm2-compiler/FilterError.mod (Copyright): Ditto. + * gm2-compiler/M2Quads.mod (BuildNewProcedure): Rewrite. + (BuildIncProcedure): Ditto. + (BuildDecProcedure): Ditto. + (BuildInclProcedure): Ditto. + (BuildExclProcedure): Ditto. + (BuildAbsFunction): Ditto. + (BuildCapFunction): Ditto. + (BuildChrFunction): Ditto. + (BuildOrdFunction): Ditto. + (BuildIntFunction): Ditto. + (BuildMinFunction): Ditto. + (BuildMaxFunction): Ditto. + (BuildTruncFunction): Ditto. + (BuildTBitSizeFunction): Ditto. + (BuildTSizeFunction): Ditto. + (BuildSizeFunction): Ditto. + +2025-10-24 Gaius Mulley <gaiusmod2@gmail.com> + + PR modula2/122407 + * Make-lang.in (GM2-LIBS-BOOT-DEFS): Add BinDict.def. + (GM2-LIBS-BOOT-MODS): Add BinDict.mod. + (GM2-COMP-BOOT-DEFS): Add FilterError.def. + (GM2-COMP-BOOT-MODS): Add FilterError.mod. + (GM2-LIBS-DEFS): Add BinDict.def. + (GM2-LIBS-MODS): Add BinDict.mod. + * gm2-compiler/M2Error.def (KillError): New procedure. + * gm2-compiler/M2Error.mod (WriteFormat3): Reformat. + (NewError): Rewrite and call AddToList. + (AddToList): New procedure. + (SubFromList): Ditto. + (WipeReferences): Ditto. + (KillError): Ditto. + * gm2-compiler/M2LexBuf.mod (MakeVirtualTok): Return + caret if all token positions are identical. + * gm2-compiler/M2MetaError.mod (KillError): Import. + (FilterError): Import. + (FilterUnknown): New global. + (initErrorBlock): Initialize symcause and token. + (push): Capitalize comments. + (pop): Copy symcause to toblock if discovered. + (doError): Add parameter sym. + (defaultError): Assign token if discovered. + Pass NulSym to doError. + (updateTokSym): New procedure. + (chooseError): Call updateTokSym. + (doErrorScopeModule): Pass sym to doError. + (doErrorScopeForward): Ditto. + (doErrorScopeMod): Ditto. + (doErrorScopeFor): Ditto. + (doErrorScopeDefinition): Ditto. + (doErrorScopeDef): Ditto. + (doErrorScopeProc): Ditto. + (used): Pass sym[bol] to doError. + (op): Assign symcause when encountering + an error, warning or note. + (MetaErrorStringT1): Rewrite. + (MetaErrorStringT2): Ditto. + (MetaErrorStringT3): Ditto. + (MetaErrorStringT4): Ditto. + (isUniqueError): New procedure function. + (wrapErrors): Rewrite. + (FilterUnknown): Initialize. + * gm2-compiler/M2Quads.mod (BuildTSizeFunction): Add spell check + hint specifier. + * gm2-compiler/FilterError.def: New file. + * gm2-compiler/FilterError.mod: New file. + * gm2-libs/BinDict.def: New file. + * gm2-libs/BinDict.mod: New file. + 2025-10-19 Gaius Mulley <gaiusmod2@gmail.com> PR modula2/122333 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..2a8e96c --- /dev/null +++ b/gcc/m2/gm2-compiler/FilterError.def @@ -0,0 +1,56 @@ +(* FilterError.def provides a filter for token and symbol. + +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. + +You should have received a copy of the GNU General Public License +along with GNU Modula-2; see the file COPYING3. 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..6f2b2f3 --- /dev/null +++ b/gcc/m2/gm2-compiler/FilterError.mod @@ -0,0 +1,224 @@ +(* FilterError.mod implements a filter for token and symbol. + +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. + +You should have received a copy of the GNU General Public License +along with GNU Modula-2; see the file COPYING3. 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..5ceeb4f 100644 --- a/gcc/m2/gm2-compiler/M2Quads.mod +++ b/gcc/m2/gm2-compiler/M2Quads.mod @@ -7244,7 +7244,8 @@ BEGIN PushT (2) ; (* Two parameters *) BuildProcedureCall (combinedtok) ELSE - MetaErrorT0 (paramtok, 'parameter to {%EkNEW} must be a pointer') + MetaErrorT1 (paramtok, 'parameter to {%EkNEW} must be a pointer,' + + ' seen {%1Ed} {%1&s}', PtrSym) END ELSE MetaErrorT0 (functok, '{%E}ALLOCATE procedure not found for NEW substitution') @@ -7333,7 +7334,8 @@ BEGIN PushT (2) ; (* Two parameters *) BuildProcedureCall (combinedtok) ELSE - MetaErrorT0 (paramtok, 'argument to {%EkDISPOSE} must be a pointer') + MetaErrorT1 (paramtok, 'argument to {%EkDISPOSE} must be a pointer,' + + ' seen {%1Ed} {%1&s}', PtrSym) END ELSE MetaErrorT0 (functok, '{%E}DEALLOCATE procedure not found for DISPOSE substitution') @@ -7442,6 +7444,7 @@ END CheckRangeIncDec ; PROCEDURE BuildIncProcedure (proctok: CARDINAL) ; VAR + vartok : CARDINAL ; NoOfParam, dtype, OperandSym, @@ -7452,6 +7455,7 @@ BEGIN IF (NoOfParam = 1) OR (NoOfParam = 2) THEN VarSym := OperandT (NoOfParam) ; (* Bottom/first parameter. *) + vartok := OperandTok (NoOfParam) ; IF IsVar (VarSym) THEN dtype := GetDType (VarSym) ; @@ -7464,13 +7468,13 @@ BEGIN PopT (OperandSym) END ; - PushTtok (VarSym, proctok) ; - TempSym := DereferenceLValue (proctok, VarSym) ; + PushTtok (VarSym, vartok) ; + TempSym := DereferenceLValue (vartok, VarSym) ; CheckRangeIncDec (proctok, TempSym, OperandSym, PlusTok) ; (* TempSym + OperandSym. *) BuildAssignmentWithoutBounds (proctok, FALSE, TRUE) (* VarSym := TempSym + OperandSym. *) ELSE - MetaErrorT1 (proctok, - 'base procedure {%EkINC} expects a variable as a parameter but was given {%1Ed}', + MetaErrorT1 (vartok, + 'base procedure {%EkINC} expects a variable as a parameter but was given {%1Ed} {%1&s}', VarSym) END ELSE @@ -7513,6 +7517,7 @@ END BuildIncProcedure ; PROCEDURE BuildDecProcedure (proctok: CARDINAL) ; VAR + vartok : CARDINAL ; NoOfParam, dtype, OperandSym, @@ -7523,6 +7528,7 @@ BEGIN IF (NoOfParam = 1) OR (NoOfParam = 2) THEN VarSym := OperandT (NoOfParam) ; (* Bottom/first parameter. *) + vartok := OperandTok (NoOfParam) ; IF IsVar (VarSym) THEN dtype := GetDType (VarSym) ; @@ -7535,13 +7541,13 @@ BEGIN PopT (OperandSym) END ; - PushTtok (VarSym, proctok) ; - TempSym := DereferenceLValue (OperandTok (NoOfParam), VarSym) ; + PushTtok (VarSym, vartok) ; + TempSym := DereferenceLValue (vartok, VarSym) ; CheckRangeIncDec (proctok, TempSym, OperandSym, MinusTok) ; (* TempSym - OperandSym. *) BuildAssignmentWithoutBounds (proctok, FALSE, TRUE) (* VarSym := TempSym - OperandSym. *) ELSE - MetaErrorT1 (proctok, - 'base procedure {%EkDEC} expects a variable as a parameter but was given {%1Ed}', + MetaErrorT1 (vartok, + 'base procedure {%EkDEC} expects a variable as a parameter but was given {%1Ed} {%1&s}', VarSym) END ELSE @@ -7604,6 +7610,7 @@ END DereferenceLValue ; PROCEDURE BuildInclProcedure (proctok: CARDINAL) ; VAR + vartok, optok : CARDINAL ; NoOfParam, DerefSym, @@ -7614,6 +7621,7 @@ BEGIN IF NoOfParam = 2 THEN VarSym := OperandT (2) ; + vartok := OperandTok (2) ; MarkArrayWritten (OperandA (2)) ; OperandSym := OperandT (1) ; optok := OperandTok (1) ; @@ -7625,14 +7633,14 @@ BEGIN BuildRange (InitInclCheck (VarSym, DerefSym)) ; GenQuadO (proctok, InclOp, VarSym, NulSym, DerefSym, FALSE) ELSE - MetaErrorT1 (proctok, - 'the first parameter to {%EkINCL} must be a set variable but is {%1Ed}', - VarSym) + MetaErrorT1 (vartok, + 'the first parameter to {%EkINCL} must be a set variable,' + + ' seen {%1Ed} {%1&s}', VarSym) END ELSE - MetaErrorT1 (proctok, - 'base procedure {%EkINCL} expects a variable as a parameter but is {%1Ed}', - VarSym) + MetaErrorT1 (vartok, + 'base procedure {%EkINCL} expects a variable as a parameter,' + + ' seen {%1Ed} {%1&s}', VarSym) END ELSE MetaErrorT0 (proctok, 'the base procedure {%EkINCL} expects 1 or 2 parameters') @@ -7668,6 +7676,7 @@ END BuildInclProcedure ; PROCEDURE BuildExclProcedure (proctok: CARDINAL) ; VAR + vartok, optok : CARDINAL ; NoOfParam, DerefSym, @@ -7678,6 +7687,7 @@ BEGIN IF NoOfParam=2 THEN VarSym := OperandT (2) ; + vartok := OperandTok (2) ; MarkArrayWritten (OperandA(2)) ; OperandSym := OperandT (1) ; optok := OperandTok (1) ; @@ -7689,14 +7699,14 @@ BEGIN BuildRange (InitExclCheck (VarSym, DerefSym)) ; GenQuadO (proctok, ExclOp, VarSym, NulSym, DerefSym, FALSE) ELSE - MetaErrorT1 (proctok, - 'the first parameter to {%EkEXCL} must be a set variable but is {%1Ed}', - VarSym) + MetaErrorT1 (vartok, + 'the first parameter to {%EkEXCL} must be a set variable,' + + ' seen {%1Ed} {%1&s}', VarSym) END ELSE - MetaErrorT1 (proctok, - 'base procedure {%EkEXCL} expects a variable as a parameter but is {%1Ed}', - VarSym) + MetaErrorT1 (vartok, + 'base procedure {%EkEXCL} expects a variable as a parameter,' + + ' seen {%1Ed} {%1&s}', VarSym) END ELSE MetaErrorT0 (proctok, @@ -7986,7 +7996,7 @@ BEGIN proctok := OperandTok (NoOfParam+1) ; IF NOT IsAModula2Type (ProcSym) THEN - MetaError1 ('coersion expecting a type, seen {%1Ea} which is {%1Ed}', ProcSym) + MetaError1 ('coersion expecting a type, seen {%1Ea} which is {%1Ed} {%1&s}', ProcSym) END ; IF NoOfParam = 1 THEN @@ -8674,7 +8684,7 @@ BEGIN IF ConstExpr AND IsVar (Var) THEN MetaErrorT2 (optok, - 'the procedure function {%1Ea} is being called from within a constant expression and therefore the parameter {%2a} must be a constant, seen a {%2dav}', + 'the procedure function {%1Ea} is being called from within a constant expression and therefore the parameter {%2a} must be a constant, seen a {%2dav} {%2&s}', Func, Var) ; RETURN TRUE ELSE @@ -8884,7 +8894,7 @@ BEGIN PushTtok (Res, combinedtok) ELSE MetaErrorT1 (optok, - 'the parameter to {%1EkODD} must be a variable or constant, seen {%1ad}', + 'the parameter to {%1EkODD} must be a variable or constant, seen {%1ad} {%1&s}', Var) ; PushTtok (False, combinedtok) END @@ -8963,13 +8973,13 @@ BEGIN PushTFtok (Res, GetSType (Var), combinedtok) ELSE MetaErrorT1 (vartok, - 'the parameter to {%AkABS} must be a variable or constant, seen {%1ad}', - Var) + 'the parameter to {%AkABS} must be a variable or constant,' + + ' seen {%1ad} {%1&s}', Var) END ELSE MetaErrorT1 (functok, - 'the pseudo procedure {%AkABS} only has one parameter, seen {%1n} parameters', - NoOfParam) + 'the pseudo procedure {%AkABS} only has one parameter,' + + ' seen {%1n} parameters', NoOfParam) END END BuildAbsFunction ; @@ -9027,13 +9037,13 @@ BEGIN PushTFtok (Res, Char, combinedtok) ELSE MetaErrorT1 (optok, - 'the parameter to {%AkCAP} must be a variable or constant, seen {%1ad}', - Var) + 'the parameter to {%AkCAP} must be a variable or constant,' + + ' seen {%1ad} {%1&s}', Var) END ELSE MetaErrorT1 (functok, - 'the pseudo procedure {%AkCAP} only has one parameter, seen {%1n} parameters', - NoOfParam) + 'the pseudo procedure {%AkCAP} only has one parameter,' + + ' seen {%1n} parameters', NoOfParam) END END BuildCapFunction ; @@ -9106,13 +9116,13 @@ BEGIN BuildConvertFunction (Convert, ConstExpr) ELSE MetaErrorT1 (optok, - 'the parameter to {%AkCHR} must be a variable or constant, seen {%1ad}', - Var) + 'the parameter to {%AkCHR} must be a variable or constant,' + + ' seen {%1ad} {%1&s}', Var) END ELSE MetaErrorT1 (functok, - 'the pseudo procedure {%AkCHR} only has one parameter, seen {%1n} parameters', - NoOfParam) + 'the pseudo procedure {%AkCHR} only has one parameter,' + + ' seen {%1n} parameters', NoOfParam) END END BuildChrFunction ; @@ -9186,13 +9196,14 @@ BEGIN BuildConvertFunction (Convert, ConstExpr) ELSE MetaErrorT2 (optok, - 'the parameter to {%1Aa} must be a variable or constant, seen {%2ad}', + 'the parameter to {%1Aa} must be a variable or constant,' + + ' seen {%2ad} {%2&s}', Sym, Var) END ELSE MetaErrorT2 (functok, - 'the pseudo procedure {%1Aa} only has one parameter, seen {%2n} parameters', - Sym, NoOfParam) + 'the pseudo procedure {%1Aa} only has one parameter,' + + ' seen {%2n} parameters', Sym, NoOfParam) END END BuildOrdFunction ; @@ -9265,14 +9276,14 @@ BEGIN ELSE combinedtok := MakeVirtualTok (functok, optok, optok) ; MetaErrorT2 (optok, - 'the parameter to {%1Ea} must be a variable or constant, seen {%2ad}', - Sym, Var) ; + 'the parameter to {%1Ea} must be a variable or constant,' + + ' seen {%2ad} {%2&s}', Sym, Var) ; PushTtok (combinedtok, MakeConstLit (combinedtok, MakeKey ('0'), ZType)) END ELSE MetaErrorT2 (functok, - 'the pseudo procedure {%1Ea} only has one parameter, seen {%2n} parameters', - Sym, NoOfParam) ; + 'the pseudo procedure {%1Ea} only has one parameter,' + + ' seen {%2n} parameters', Sym, NoOfParam) ; PushTtok (functok, MakeConstLit (functok, MakeKey ('0'), ZType)) END END BuildIntFunction ; @@ -9338,7 +9349,8 @@ BEGIN AreConst := FALSE ; ELSIF NOT IsConst (OperandT (i)) THEN - MetaError1 ('problem in the {%1EN} argument for {%kMAKEADR}, all arguments to {%kMAKEADR} must be either variables or constants', i) + MetaError1 ('problem in the {%1EN} argument for {%kMAKEADR},' + + ' all arguments to {%kMAKEADR} must be either variables or constants', i) END ; INC (i) END ; @@ -9350,7 +9362,8 @@ BEGIN PopN (NoOfParameters+1) ; PushTFtok (ReturnVar, GetSType (MakeAdr), resulttok) ELSE - MetaError1 ('the pseudo procedure {%EkMAKEADR} requires at least one parameter, seen {%1n}', NoOfParameters) ; + MetaError1 ('the pseudo procedure {%EkMAKEADR} requires at least one parameter,' + + ' seen {%1n}', NoOfParameters) ; PopN (1) ; PushTFtok (Nil, GetSType (MakeAdr), functok) END @@ -9422,15 +9435,16 @@ BEGIN PushTFtok (returnVar, GetSType (varSet), combinedtok) ELSE MetaErrorT1 (vartok, - 'SYSTEM procedure {%1EkSHIFT} expects a constant or variable which has a type of SET as its first parameter, seen {%1ad}', + 'SYSTEM procedure {%1EkSHIFT} expects a constant or variable which has a type of SET as its first parameter,' + + ' seen {%1ad} {%1&s}', varSet) ; PushTFtok (MakeConstLit (combinedtok, MakeKey ('0'), Cardinal), Cardinal, combinedtok) END ELSE combinedtok := MakeVirtualTok (functok, functok, paramtok) ; MetaErrorT1 (functok, - 'the pseudo procedure {%kSHIFT} requires at least two parameters, seen {%1En}', - NoOfParam) ; + 'the pseudo procedure {%kSHIFT} requires at least two parameters,' + + ' seen {%1En}', NoOfParam) ; PopN (NoOfParam + 1) ; PushTFtok (MakeConstLit (combinedtok, MakeKey ('0'), Cardinal), Cardinal, combinedtok) END @@ -9499,8 +9513,8 @@ BEGIN PushTFtok (returnVar, GetSType (varSet), combinedtok) ELSE MetaErrorT1 (vartok, - 'SYSTEM procedure {%EkROTATE} expects a constant or variable which has a type of SET as its first parameter, seen {%1ad}', - varSet) ; + 'SYSTEM procedure {%EkROTATE} expects a constant or variable which has a type of SET as its first parameter,' + + ' seen {%1ad} {%1&s}', varSet) ; PushTFtok (MakeConstLit (functok, MakeKey('0'), Cardinal), Cardinal, functok) END ELSE @@ -9570,8 +9584,8 @@ BEGIN (* Spellcheck. *) (* It is sensible not to try and recover when we dont know the return type. *) MetaErrorT1 (typetok, - 'undeclared type found in builtin procedure function {%AkVAL} {%1ad} {%1&s}', - Type) ; + 'undeclared type found in builtin procedure function' + + ' {%AkVAL} {%1ad} {%1&s}', Type) ; (* Non recoverable error. *) UnknownReported (Type) ELSIF ConstExprError (ProcSym, Exp, exptok, ConstExpr) @@ -10001,15 +10015,15 @@ BEGIN ELSE (* we dont know the type therefore cannot fake a return. *) MetaErrorT1 (vartok, - 'parameter to {%AkMIN} must be a type or a variable, seen {%1ad}', - Var) + 'parameter to {%AkMIN} must be a type or a variable,' + + ' seen {%1ad} {%1&s}', Var) (* non recoverable error. *) END ELSE (* we dont know the type therefore cannot fake a return. *) MetaErrorT1 (functok, - 'the pseudo builtin procedure function {%AkMIN} only has one parameter, seen {%1n}', - NoOfParam) + 'the pseudo builtin procedure function {%AkMIN} only has one parameter,' + + ' seen {%1n}', NoOfParam) (* non recoverable error. *) END END BuildMinFunction ; @@ -10062,15 +10076,15 @@ BEGIN ELSE (* we dont know the type therefore cannot fake a return. *) MetaErrorT1 (vartok, - 'parameter to {%AkMAX} must be a type or a variable, seen {%1ad}', - Var) + 'parameter to {%AkMAX} must be a type or a variable,' + + ' seen {%1ad} {%1&s}', Var) (* non recoverable error. *) ; END ELSE (* we dont know the type therefore cannot fake a return. *) MetaErrorT1 (functok, - 'the pseudo builtin procedure function {%AkMAX} only has one parameter, seen {%1n}', - NoOfParam) + 'the pseudo builtin procedure function {%AkMAX} only has one parameter,' + + ' seen {%1n}', NoOfParam) (* non recoverable error. *) END END BuildMaxFunction ; @@ -10156,8 +10170,8 @@ BEGIN END ELSE MetaErrorT2 (vartok, - 'argument to {%1Ead} must be a variable or constant, seen {%2ad}', - Sym, Var) ; + 'argument to {%1Ead} must be a variable or constant,' + + ' seen {%2ad} {%2&s}', Sym, Var) ; PushTFtok (MakeConstLit (functok, MakeKey('0'), Type), Type, functok) END ELSE @@ -10166,7 +10180,8 @@ BEGIN ELSE (* we dont know the type therefore cannot fake a return. *) MetaErrorT1 (functok, - 'the pseudo builtin procedure function {%AkTRUNC} only has one parameter, seen {%1n}', NoOfParam) + 'the pseudo builtin procedure function {%AkTRUNC} only has one parameter,' + + ' seen {%1n}', NoOfParam) (* non recoverable error. *) END END BuildTruncFunction ; @@ -10323,8 +10338,8 @@ BEGIN ELSE PushTFtok (MakeConstLit (combinedtok, MakeKey ('1.0'), RType), RType, combinedtok) ; MetaErrorT2 (vartok, - 'the parameter to the builtin procedure function {%1Ead} must be a constant or a variable, seen {%2ad}', - func, Var) + 'the parameter to the builtin procedure function {%1Ead} must be a constant or a variable,' + + ' seen {%2ad} {%2&s}', func, Var) END ELSE PopN (NoOfParam+1) ; (* destroy arguments to this function *) @@ -10399,8 +10414,8 @@ BEGIN ELSE PushTFtok (MakeConstLit (combinedtok, MakeKey ('1.0'), RType), RType, combinedtok) ; MetaErrorT2 (vartok, - 'the parameter to the builtin procedure function {%1Ead} must be a constant or a variable, seen {%2ad}', - func, Var) + 'the parameter to the builtin procedure function {%1Ead} must be a constant or a variable,' + + ' seen {%2ad} {%2&s}', func, Var) END ELSE PopN (NoOfParam+1) ; (* destroy arguments to this function *) @@ -10489,11 +10504,13 @@ BEGIN IF IsVar (l) OR IsConst (l) THEN MetaErrorT2 (functok, - 'the builtin procedure {%1Ead} requires two parameters, both must be variables or constants but the second parameter is {%2d}', + 'the builtin procedure {%1Ead} requires two parameters,' + + ' both must be variables or constants but the second parameter is {%2d}', func, r) ELSE MetaErrorT2 (functok, - 'the builtin procedure {%1Ead} requires two parameters, both must be variables or constants but the first parameter is {%2d}', + 'the builtin procedure {%1Ead} requires two parameters,' + + ' both must be variables or constants but the first parameter is {%2d}', func, l) END ; PushTFtok (MakeConstLit (combinedtok, MakeKey ('1.0'), CType), CType, combinedtok) @@ -10536,7 +10553,8 @@ END BuildCmplxFunction ; PROCEDURE BuildAdrFunction ; VAR - endtok, + param, + paramTok, combinedTok, procTok, t, @@ -10552,7 +10570,8 @@ BEGIN PopT (noOfParameters) ; procSym := OperandT (noOfParameters + 1) ; procTok := OperandTok (noOfParameters + 1) ; (* token of procedure ADR. *) - endtok := OperandTok (1) ; (* last parameter. *) + paramTok := OperandTok (1) ; (* last parameter. *) + param := OperandT (1) ; combinedTok := MakeVirtualTok (procTok, procTok, endtok) ; IF noOfParameters # 1 THEN @@ -10560,28 +10579,29 @@ BEGIN 'SYSTEM procedure ADR expects 1 parameter') ; PopN (noOfParameters + 1) ; (* destroy the arguments and function *) PushTF (Nil, Address) - ELSIF IsConstString (OperandT (1)) + ELSIF IsConstString (param) THEN - returnVar := MakeLeftValue (combinedTok, OperandT (1), RightValue, + returnVar := MakeLeftValue (combinedTok, param, RightValue, GetSType (procSym)) ; PopN (noOfParameters + 1) ; (* destroy the arguments and function *) PushTFtok (returnVar, GetSType (returnVar), combinedTok) - ELSIF (NOT IsVar(OperandT(1))) AND (NOT IsProcedure(OperandT(1))) + ELSIF (NOT IsVar (param)) AND (NOT IsProcedure (param)) THEN - MetaErrorNT0 (combinedTok, - 'SYSTEM procedure ADR expects a variable, procedure or a constant string as its parameter') ; + MetaErrorT1 (paramTok, + 'SYSTEM procedure ADR expects a variable, procedure or a constant string as its parameter,' + + ' seen {%1Ed} {%1&s}', param) ; PopN (noOfParameters + 1) ; (* destroy the arguments and function *) PushTFtok (Nil, Address, combinedTok) - ELSIF IsProcedure (OperandT (1)) + ELSIF IsProcedure (param) THEN - returnVar := MakeLeftValue (combinedTok, OperandT (1), RightValue, + returnVar := MakeLeftValue (combinedTok, param, RightValue, GetSType (procSym)) ; PopN (noOfParameters + 1) ; (* destroy the arguments and function *) PushTFtok (returnVar, GetSType (returnVar), combinedTok) ELSE - Type := GetSType (OperandT (1)) ; + Type := GetSType (param) ; Dim := OperandD (1) ; - MarkArrayWritten (OperandT (1)) ; + MarkArrayWritten (param) ; MarkArrayWritten (OperandA (1)) ; (* if the operand is an unbounded which has not been indexed then we will lookup its address from the unbounded record. @@ -10590,7 +10610,7 @@ BEGIN IF IsUnbounded (Type) AND (Dim = 0) THEN (* we will reference the address field of the unbounded structure *) - UnboundedSym := OperandT (1) ; + UnboundedSym := param ; rw := OperandRW (1) ; PushTFrw (UnboundedSym, GetSType (UnboundedSym), rw) ; Field := GetUnboundedAddressOffset (GetSType (UnboundedSym)) ; @@ -10614,14 +10634,14 @@ BEGIN ELSE returnVar := MakeTemporary (combinedTok, RightValue) ; PutVar (returnVar, GetSType (procSym)) ; - IF GetMode (OperandT (1)) = LeftValue + IF GetMode (param) = LeftValue THEN PutVar (returnVar, GetSType (procSym)) ; - GenQuadO (combinedTok, ConvertOp, returnVar, GetSType (procSym), OperandT (1), FALSE) + GenQuadO (combinedTok, ConvertOp, returnVar, GetSType (procSym), param, FALSE) ELSE - GenQuadO (combinedTok, AddrOp, returnVar, NulSym, OperandT (1), FALSE) + GenQuadO (combinedTok, AddrOp, returnVar, NulSym, param, FALSE) END ; - PutWriteQuad (OperandT (1), GetMode (OperandT (1)), NextQuad-1) ; + PutWriteQuad (param, GetMode (param), NextQuad-1) ; rw := OperandMergeRW (1) ; Assert (IsLegal (rw)) END ; @@ -10710,9 +10730,9 @@ BEGIN GenQuadO (resulttok, SizeOp, ReturnVar, NulSym, Type, TRUE) END ELSE - resulttok := functok ; - MetaErrorT1 (resulttok, - '{%E}SYSTEM procedure {%kSIZE} expects a variable or type as its parameter, seen {%1Ed}', + paramtok := OperandTok (1) ; + MetaErrorT1 (paramtok, + '{%E}SYSTEM procedure {%kSIZE} expects a variable or type as its parameter, seen {%1Ed} {%1&s}', OperandT (1)) ; ReturnVar := MakeConstLit (resulttok, MakeKey('0'), Cardinal) END ; @@ -10776,8 +10796,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 @@ -10801,7 +10822,7 @@ BEGIN ELSE resulttok := MakeVirtualTok (functok, functok, paramtok) ; MetaErrorT1 (resulttok, - '{%E}SYSTEM procedure function {%kTSIZE} expects the first parameter to be a record type, seen {%1d}', + '{%E}SYSTEM procedure function {%kTSIZE} expects the first parameter to be a record type, seen {%1d} {%1&s}', Record) ; ReturnVar := MakeConstLit (resulttok, MakeKey ('0'), Cardinal) END @@ -10865,7 +10886,7 @@ BEGIN GenQuadO (resulttok, StandardFunctionOp, ReturnVar, ProcSym, OperandT(1), FALSE) ELSE MetaErrorT1 (resulttok, - '{%E}SYSTEM procedure function {%kTBITSIZE} expects a variable as its first parameter, seen {%1d}', + '{%E}SYSTEM procedure function {%kTBITSIZE} expects a variable as its first parameter, seen {%1d} {%1&s}', OperandT (1)) ; ReturnVar := MakeConstLit (resulttok, MakeKey ('0'), Cardinal) END @@ -10888,7 +10909,7 @@ BEGIN ELSE resulttok := MakeVirtualTok (functok, functok, paramtok) ; MetaErrorT1 (resulttok, - '{%E}SYSTEM procedure function {%kTBITSIZE} expects the first parameter to be a record type, seen {%1d}', + '{%E}SYSTEM procedure function {%kTBITSIZE} expects the first parameter to be a record type, seen {%1d} {%1&s}', Record) ; 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 4c05fe2..b37a437 100644 --- a/gcc/match.pd +++ b/gcc/match.pd @@ -11927,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 65fa7fa..d6a2cf4 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,105 @@ +2025-10-25 Harald Anlauf <anlauf@gmx.de> + + PR fortran/114023 + * gfortran.dg/is_contiguous_5.f90: New test. + +2025-10-25 Jiahao Xu <xujiahao@loongson.cn> + + * gcc.target/loongarch/lasx-reduc-1.c: New test. + +2025-10-24 Andrew MacLeod <amacleod@redhat.com> + + * gcc.dg/pr110405.c: New. + +2025-10-24 Andrew MacLeod <amacleod@redhat.com> + + PR tree-optimization/114025 + * g++.dg/pr114025.C: New. + +2025-10-24 Gaius Mulley <gaiusmod2@gmail.com> + + PR modula2/122407 + * gm2.dg/spell/iso/fail/badspellabs.mod: New test. + * gm2.dg/spell/iso/fail/badspelladr.mod: New test. + * gm2.dg/spell/iso/fail/badspellcap.mod: New test. + * gm2.dg/spell/iso/fail/badspellchr.mod: New test. + * gm2.dg/spell/iso/fail/badspellchr2.mod: New test. + * gm2.dg/spell/iso/fail/badspelldec.mod: New test. + * gm2.dg/spell/iso/fail/badspellexcl.mod: New test. + * gm2.dg/spell/iso/fail/badspellinc.mod: New test. + * gm2.dg/spell/iso/fail/badspellincl.mod: New test. + * gm2.dg/spell/iso/fail/badspellnew.mod: New test. + * gm2.dg/spell/iso/fail/badspellsize.mod: New test. + * gm2.dg/spell/iso/fail/dg-spell-iso-fail.exp: New test. + +2025-10-24 Andrew Pinski <andrew.pinski@oss.qualcomm.com> + + PR target/122402 + * gcc.target/aarch64/auto-init-padding-2.c: Turn off SRA. + * gcc.target/aarch64/auto-init-padding-4.c: Likewise. + +2025-10-24 Harald Anlauf <anlauf@gmx.de> + + PR fortran/122386 + * gfortran.dg/transfer_array_subref_2.f90: New test. + +2025-10-24 Andrew MacLeod <amacleod@redhat.com> + + * gcc.dg/pr114725.c: New. + +2025-10-24 Andrew MacLeod <amacleod@redhat.com> + + PR tree-optimization/118254 + PR tree-optimization/114331 + * gcc.dg/pr114331.c: New. + * gcc.dg/pr118254.c: New. + +2025-10-24 Alex Coplan <alex.coplan@arm.com> + + * gcc.dg/torture/vect-permute-ice.c: New test. + +2025-10-24 Richard Biener <rguenther@suse.de> + + * gcc.dg/vect/vect-pr122406-1.c: Adjust to expect reduction + chain vectorization. + * gcc.dg/vect/vect-pr122406-2.c: Likewise. + +2025-10-24 Richard Biener <rguenther@suse.de> + + PR tree-optimization/122406 + * gcc.dg/vect/vect-pr122406-1.c: New testcase. + * gcc.dg/vect/vect-pr122406-2.c: Likewise. + +2025-10-24 Paul-Antoine Arras <parras@baylibre.com> + + PR fortran/121452 + * c-c++-common/gomp/pr121452-1.c: New test. + * c-c++-common/gomp/pr121452-2.c: New test. + * gfortran.dg/gomp/pr121452-1.f90: New test. + * gfortran.dg/gomp/pr121452-2.f90: New test. + * gfortran.dg/gomp/pr121452-3.f90: New test. + +2025-10-24 H.J. Lu <hjl.tools@gmail.com> + + PR target/122323 + * gcc.target/i386/builtin-fabs-2.c: Also scan (%edi)for x32. + +2025-10-24 Pengfei Li <Pengfei.Li2@arm.com> + + * gcc.dg/fold-vecperm-1.c: New test. + +2025-10-24 Olivier Hainque <hainque@adacore.com> + + * lib/target-supports.exp (check_weak_available): + Return 1 for VxWorks7. + +2025-10-24 Joseph Myers <josmyers@redhat.com> + + * gcc.dg/c23-static-assert-5.c, gcc.dg/c23-static-assert-6.c, + gcc.dg/c23-static-assert-7.c, gcc.dg/c23-static-assert-8.c, + gcc.dg/c2y-static-assert-2.c, gcc.dg/c2y-static-assert-3.c, + gcc.dg/c2y-static-assert-4.c: New tests. + 2025-10-23 Robert Dubner <rdubner@symas.com> * cobol.dg/group2/Length_overflow__2_.out: Updated test result. 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/g++.dg/pr114025.C b/gcc/testsuite/g++.dg/pr114025.C new file mode 100644 index 0000000..61bb8f1 --- /dev/null +++ b/gcc/testsuite/g++.dg/pr114025.C @@ -0,0 +1,39 @@ +/* { dg-do compile } */ +/* { dg-options " -O3 -std=gnu++17 -ffinite-math-only -fdump-tree-optimized" } */ + +#include <algorithm> +#include <stdexcept> + +#define AINLINE + +class TestClass +{ +public: + AINLINE void SetValue(float value); + +private: + float m_Value; +}; + +AINLINE +void TestClass::SetValue(float value) +{ + if (value >= 0.0f && value <= 100.0f) { + m_Value = value; + } + else { + throw std::out_of_range("Value must be [0, 100]."); + } +} + +void TestFunc(TestClass& t, float value) +{ + value = std::clamp(value, 30.0f, 50.0f); + // When TestClass::SetValue is inlined, the exception throwing code is not eliminated. + // Given that at this point we can prove that 'value' lies in the range [30.0f, 50.0f] well within the range required by the setter function, we can rid the not taken paths of code. + t.SetValue(value); +} + + +/* { dg-final { scan-tree-dump-times "std::out_of_range::out_of_range" 1 "optimized" } } */ + 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-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/pr110405.c b/gcc/testsuite/gcc.dg/pr110405.c new file mode 100644 index 0000000..549cc7b --- /dev/null +++ b/gcc/testsuite/gcc.dg/pr110405.c @@ -0,0 +1,14 @@ +/* { dg-do compile } */ +/* { dg-options "-O2 -fdump-tree-optimized" } */ + +void foo (unsigned long); +void +f (unsigned long i) +{ + if ((i & 7) == 6) + if(i & 1) + foo (0); +} + +/* { dg-final { scan-tree-dump-not "foo" "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/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/auto-init-padding-2.c b/gcc/testsuite/gcc.target/aarch64/auto-init-padding-2.c index d3b6591..25d06d7 100644 --- a/gcc/testsuite/gcc.target/aarch64/auto-init-padding-2.c +++ b/gcc/testsuite/gcc.target/aarch64/auto-init-padding-2.c @@ -1,7 +1,8 @@ /* Verify pattern initialization for structure type automatic variables with padding. */ /* { dg-do compile } */ -/* { dg-options "-O -ftrivial-auto-var-init=pattern" } */ +/* SRA should be turned off as it can fully scalarize var as the padding is not touched. */ +/* { dg-options "-O -ftrivial-auto-var-init=pattern -fno-tree-sra" } */ struct test_aligned { int internal1; diff --git a/gcc/testsuite/gcc.target/aarch64/auto-init-padding-4.c b/gcc/testsuite/gcc.target/aarch64/auto-init-padding-4.c index efd310f..fa9def7 100644 --- a/gcc/testsuite/gcc.target/aarch64/auto-init-padding-4.c +++ b/gcc/testsuite/gcc.target/aarch64/auto-init-padding-4.c @@ -1,7 +1,8 @@ /* Verify pattern initialization for nested structure type automatic variables with padding. */ /* { dg-do compile } */ -/* { dg-options "-O -ftrivial-auto-var-init=pattern" } */ +/* SRA should be turned off as it can fully scalarize var as the padding is not touched. */ +/* { dg-options "-O -ftrivial-auto-var-init=pattern -fno-tree-sra" } */ struct test_aligned { unsigned internal1; diff --git a/gcc/testsuite/gcc.target/aarch64/sve2/pr121599.c b/gcc/testsuite/gcc.target/aarch64/sve2/pr121599.c index 90c5ac9..da4b7aa 100644 --- a/gcc/testsuite/gcc.target/aarch64/sve2/pr121599.c +++ b/gcc/testsuite/gcc.target/aarch64/sve2/pr121599.c @@ -7,7 +7,7 @@ /* ** foo: -** movi d([0-9]+), #0 +** movi? [vdz]([0-9]+)\.?b?, #0 ** movprfx z0\.b, p0/z, z0\.b ** usqadd z0\.b, p0/m, z0\.b, z\1\.b ** ret @@ -19,7 +19,7 @@ svuint8_t foo (svbool_t pg, svuint8_t op1) /* ** bar: -** movi d([0-9]+), #0 +** movi? [vdz]([0-9]+)\.?b?, #0 ** movprfx z0\.b, p0/z, z0\.b ** suqadd z0\.b, p0/m, z0\.b, z\1\.b ** ret 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/loongarch/lasx-reduc-1.c b/gcc/testsuite/gcc.target/loongarch/lasx-reduc-1.c new file mode 100644 index 0000000..e449259 --- /dev/null +++ b/gcc/testsuite/gcc.target/loongarch/lasx-reduc-1.c @@ -0,0 +1,17 @@ +/* { dg-do compile } */ +/* { dg-options "-O3 -funsafe-math-optimizations -mlasx -fno-unroll-loops -fdump-tree-optimized" } */ +/* { dg-final { scan-tree-dump-times "\.REDUC_PLUS" 4 "optimized" } } */ + +#define DEFINE_SUM_FUNCTION(T, FUNC_NAME, SIZE) \ +T FUNC_NAME(const T arr[]) { \ + arr = __builtin_assume_aligned(arr, 64); \ + T sum = 0; \ + for (int i = 0; i < SIZE; i++) \ + sum += arr[i]; \ + return sum; \ +} + +DEFINE_SUM_FUNCTION (int, sum_int_1040, 1028) +DEFINE_SUM_FUNCTION (float, sum_float_1040, 1028) +DEFINE_SUM_FUNCTION (long, sum_long_1040, 1026) +DEFINE_SUM_FUNCTION (double, sum_double_1040, 1026) 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/is_contiguous_5.f90 b/gcc/testsuite/gfortran.dg/is_contiguous_5.f90 new file mode 100644 index 0000000..091e43b5 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/is_contiguous_5.f90 @@ -0,0 +1,126 @@ +! { dg-do run } +! PR fortran/114023 - IS_CONTIGUOUS and pointers to non-contiguous targets +! +! Based on testcase by Federico Perini + +program main + implicit none + complex, parameter :: cvals(*) = [(1,-1),(2,-2),(3,-3)] + complex , target :: cref(size(cvals)) = cvals ! Reference + complex, allocatable, target :: carr(:) ! Test + + type cx + real :: re, im + end type cx + type(cx), parameter :: tvals(*) = [cx(1,-1),cx(2,-2),cx(3,-3)] + real, parameter :: expect(*) = tvals% re + type(cx) , target :: tref(size(cvals)) = tvals ! Reference + type(cx), allocatable, target :: tarr(:) + + real, pointer :: rr1(:), rr2(:), rr3(:), rr4(:) + class(*), pointer :: cp1(:), cp2(:), cp3(:), cp4(:) + + carr = cvals + tarr = tvals + + if (any (expect /= [1,2,3])) error stop 90 + + ! REAL pointer to non-contiguous effective target + rr1(1:3) => cref%re + rr2 => cref%re + rr3(1:3) => carr%re + rr4 => carr%re + + if (is_contiguous (rr1)) stop 1 + if (my_contiguous_real (rr1)) stop 2 + if (is_contiguous (cref(1:3)%re)) stop 3 +! if (my_contiguous_real (cref(1:3)%re)) stop 4 ! pr122397 + + if (is_contiguous (rr3)) stop 6 + if (my_contiguous_real (rr3)) stop 7 + if (is_contiguous (carr(1:3)%re)) stop 8 +! if (my_contiguous_real (carr(1:3)%re)) stop 9 + + if (is_contiguous (rr2)) stop 11 + if (my_contiguous_real (rr2)) stop 12 + if (is_contiguous (cref%re)) stop 13 +! if (my_contiguous_real (cref%re)) stop 14 + + if (is_contiguous (rr4)) stop 16 + if (my_contiguous_real (rr4)) stop 17 + if (is_contiguous (carr%re)) stop 18 +! if (my_contiguous_real (carr%re)) stop 19 + + rr1(1:3) => tref%re + rr2 => tref%re + rr3(1:3) => tarr%re + rr4 => tarr%re + + if (is_contiguous (rr1)) stop 21 + if (my_contiguous_real (rr1)) stop 22 + if (is_contiguous (tref(1:3)%re)) stop 23 +! if (my_contiguous_real (tref(1:3)%re)) stop 24 + + if (is_contiguous (rr3)) stop 26 + if (my_contiguous_real (rr3)) stop 27 + if (is_contiguous (tarr(1:3)%re)) stop 28 +! if (my_contiguous_real (tarr(1:3)%re)) stop 29 + + if (is_contiguous (rr2)) stop 31 + if (my_contiguous_real (rr2)) stop 32 + if (is_contiguous (tref%re)) stop 33 +! if (my_contiguous_real (tref%re)) stop 34 + + if (is_contiguous (rr4)) stop 36 + if (my_contiguous_real (rr4)) stop 37 + if (is_contiguous (tarr%re)) stop 38 +! if (my_contiguous_real (tarr%re)) stop 39 + + ! Unlimited polymorphic pointer to non-contiguous effective target + cp1(1:3) => cref%re + cp2 => cref%re + cp3(1:3) => carr%re + cp4 => carr%re + + if (is_contiguous (cp1)) stop 41 + if (my_contiguous_poly (cp1)) stop 42 + if (is_contiguous (cp2)) stop 43 + if (my_contiguous_poly (cp2)) stop 44 + if (is_contiguous (cp3)) stop 45 + if (my_contiguous_poly (cp3)) stop 46 + if (is_contiguous (cp4)) stop 47 + if (my_contiguous_poly (cp4)) stop 48 + + cp1(1:3) => tref%re + cp2 => tref%re + cp3(1:3) => tarr%re + cp4 => tarr%re + + if (is_contiguous (cp1)) stop 51 + if (my_contiguous_poly (cp1)) stop 52 + if (is_contiguous (cp2)) stop 53 + if (my_contiguous_poly (cp2)) stop 54 + if (is_contiguous (cp3)) stop 55 + if (my_contiguous_poly (cp3)) stop 56 + if (is_contiguous (cp4)) stop 57 + if (my_contiguous_poly (cp4)) stop 58 + + deallocate (carr, tarr) +contains + pure logical function my_contiguous_real (x) result (res) + real, pointer, intent(in) :: x(:) + res = is_contiguous (x) + if (any (x /= expect)) error stop 97 + end function my_contiguous_real + + pure logical function my_contiguous_poly (x) result (res) + class(*), pointer, intent(in) :: x(:) + res = is_contiguous (x) + select type (x) + type is (real) + if (any (x /= expect)) error stop 98 + class default + error stop 99 + end select + end function my_contiguous_poly +end diff --git a/gcc/testsuite/gfortran.dg/pdt_60.f03 b/gcc/testsuite/gfortran.dg/pdt_60.f03 new file mode 100644 index 0000000..dc9f7f2 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/pdt_60.f03 @@ -0,0 +1,65 @@ +! { dg-do compile } +! { dg-options "-fdump-tree-original" } +! +! Test the fix for PR122290. +! +! Contributed by Damian Rouson <damian@archaeologic.codes> +! +module hyperparameters_m + implicit none + + type hyperparameters_t(k) + integer, kind :: k = kind(1.) + real(k) :: learning_rate_ = real(1.5,k) ! Gave "Invalid kind for REAL" + contains + generic :: operator(==) => default_real_equals, real8_equals ! Gave "Entity ‘default_real_equals’ at (1) + ! is already present in the interface" + generic :: g => default_real_equals, real8_equals ! Make sure that ordinary generic is OK + procedure default_real_equals + procedure real8_equals + end type + + interface + logical module function default_real_equals(lhs, rhs) + implicit none + class(hyperparameters_t), intent(in) :: lhs, rhs + end function + logical module function real8_equals(lhs, rhs) + implicit none + class(hyperparameters_t(kind(1d0))), intent(in) :: lhs, rhs + end function + end interface +end module + +! Added to test generic procedures are the correct ones. +submodule(hyperparameters_m) hyperparameters_s +contains + logical module function default_real_equals(lhs, rhs) + implicit none + class(hyperparameters_t), intent(in) :: lhs, rhs + default_real_equals = (lhs%learning_rate_ == rhs%learning_rate_) + end function + logical module function real8_equals(lhs, rhs) + implicit none + class(hyperparameters_t(kind(1d0))), intent(in) :: lhs, rhs + real8_equals = (lhs%learning_rate_ == rhs%learning_rate_) + end function +end submodule + + use hyperparameters_m + type (hyperparameters_t) :: a, b + type (hyperparameters_t(kind(1d0))) :: c, d + if (.not.(a == b)) stop 1 + if (.not.a%g(b)) stop 2 + a%learning_rate_ = real(2.5,a%k) + if (a == b) stop 3 + if (a%g(b)) stop 4 + + if (.not.(c == d)) stop 5 + if (.not.c%g(d)) stop 6 + c%learning_rate_ = real(2.5,c%k) + if (c == d) stop 7 + if (c%g(d)) stop 8 +end +! { dg-final { scan-tree-dump-times "default_real_equals" 8 "original" } } +! { dg-final { scan-tree-dump-times "real8_equals" 8 "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/gm2.dg/spell/iso/fail/badspellabs.mod b/gcc/testsuite/gm2.dg/spell/iso/fail/badspellabs.mod new file mode 100644 index 0000000..508d93a --- /dev/null +++ b/gcc/testsuite/gm2.dg/spell/iso/fail/badspellabs.mod @@ -0,0 +1,14 @@ + +(* { dg-do compile } *) +(* { dg-options "-g" } *) + +MODULE badspellabs ; + +VAR + foo: INTEGER ; +BEGIN + IF ABS (Foo) = 1 + (* { dg-error "the parameter to ABS must be a variable or constant, seen 'Foo', did you mean foo?" "Foo" { target *-*-* } 10 } *) + THEN + END +END badspellabs. diff --git a/gcc/testsuite/gm2.dg/spell/iso/fail/badspelladr.mod b/gcc/testsuite/gm2.dg/spell/iso/fail/badspelladr.mod new file mode 100644 index 0000000..7bad815 --- /dev/null +++ b/gcc/testsuite/gm2.dg/spell/iso/fail/badspelladr.mod @@ -0,0 +1,16 @@ + +(* { dg-do compile } *) +(* { dg-options "-g" } *) + +MODULE badspelladr ; + +FROM SYSTEM IMPORT ADR ; + +VAR + foo: INTEGER ; +BEGIN + IF ADR (Foo) = NIL + (* { dg-error "SYSTEM procedure ADR expects a variable, procedure or a constant string as its parameter, seen unknown, did you mean foo?" "Foo" { target *-*-* } 12 } *) + THEN + END +END badspelladr. diff --git a/gcc/testsuite/gm2.dg/spell/iso/fail/badspellcap.mod b/gcc/testsuite/gm2.dg/spell/iso/fail/badspellcap.mod new file mode 100644 index 0000000..8fc004c --- /dev/null +++ b/gcc/testsuite/gm2.dg/spell/iso/fail/badspellcap.mod @@ -0,0 +1,13 @@ +(* { dg-do compile } *) +(* { dg-options "-g" } *) + +MODULE badspellcap ; + +VAR + foo: CHAR ; +BEGIN + IF CAP (Foo) = 'A' + (* { dg-error "the parameter to CAP must be a variable or constant, seen 'Foo', did you mean foo?" "Foo" { target *-*-* } 9 } *) + THEN + END +END badspellcap. diff --git a/gcc/testsuite/gm2.dg/spell/iso/fail/badspellchr.mod b/gcc/testsuite/gm2.dg/spell/iso/fail/badspellchr.mod new file mode 100644 index 0000000..1f5beaa --- /dev/null +++ b/gcc/testsuite/gm2.dg/spell/iso/fail/badspellchr.mod @@ -0,0 +1,13 @@ +(* { dg-do compile } *) +(* { dg-options "-g" } *) + +MODULE badspellchr ; + +VAR + foo: CARDINAL ; +BEGIN + IF CHR (Foo) = 'A' + (* { dg-error "the parameter to CHR must be a variable or constant, seen 'Foo', did you mean foo?" "Foo" { target *-*-* } 9 } *) + THEN + END +END badspellchr. diff --git a/gcc/testsuite/gm2.dg/spell/iso/fail/badspellchr2.mod b/gcc/testsuite/gm2.dg/spell/iso/fail/badspellchr2.mod new file mode 100644 index 0000000..9808a4f --- /dev/null +++ b/gcc/testsuite/gm2.dg/spell/iso/fail/badspellchr2.mod @@ -0,0 +1,13 @@ +(* { dg-do compile } *) +(* { dg-options "-g" } *) + +MODULE badspellchr2 ; + +VAR + foo: CARDINAL ; +BEGIN + IF CHR (Foo+1) = 'A' + (* { dg-error "unknown symbol 'Foo', did you mean foo?" "Foo" { target *-*-* } 9 } *) + THEN + END +END badspellchr2. diff --git a/gcc/testsuite/gm2.dg/spell/iso/fail/badspelldec.mod b/gcc/testsuite/gm2.dg/spell/iso/fail/badspelldec.mod new file mode 100644 index 0000000..0c01fef --- /dev/null +++ b/gcc/testsuite/gm2.dg/spell/iso/fail/badspelldec.mod @@ -0,0 +1,11 @@ +(* { dg-do compile } *) +(* { dg-options "-g" } *) + +MODULE badspelldec ; + +VAR + foo: CARDINAL ; +BEGIN + DEC (Foo) + (* { dg-error "base procedure DEC expects a variable as a parameter but was given unknown, did you mean foo?" "Foo" { target *-*-* } 9 } *) +END badspelldec. diff --git a/gcc/testsuite/gm2.dg/spell/iso/fail/badspellexcl.mod b/gcc/testsuite/gm2.dg/spell/iso/fail/badspellexcl.mod new file mode 100644 index 0000000..92cb932 --- /dev/null +++ b/gcc/testsuite/gm2.dg/spell/iso/fail/badspellexcl.mod @@ -0,0 +1,11 @@ +(* { dg-do compile } *) +(* { dg-options "-g" } *) + +MODULE badspellexcl ; + +VAR + foo: BITSET ; +BEGIN + EXCL (Foo, 1) + (* { dg-error "base procedure EXCL expects a variable as a parameter, seen unknown, did you mean foo?" "Foo" { target *-*-* } 9 } *) +END badspellexcl. diff --git a/gcc/testsuite/gm2.dg/spell/iso/fail/badspellinc.mod b/gcc/testsuite/gm2.dg/spell/iso/fail/badspellinc.mod new file mode 100644 index 0000000..1d913ec --- /dev/null +++ b/gcc/testsuite/gm2.dg/spell/iso/fail/badspellinc.mod @@ -0,0 +1,12 @@ +(* { dg-do compile } *) +(* { dg-options "-g" } *) + +MODULE badspellinc ; + +VAR + foo: CARDINAL ; +BEGIN + INC (Foo) + (* { dg-error "base procedure INC expects a variable as a parameter but was given unknown, did you mean foo?" "Foo" { target *-*-* } 9 } *) + +END badspellinc. diff --git a/gcc/testsuite/gm2.dg/spell/iso/fail/badspellincl.mod b/gcc/testsuite/gm2.dg/spell/iso/fail/badspellincl.mod new file mode 100644 index 0000000..ddaa727 --- /dev/null +++ b/gcc/testsuite/gm2.dg/spell/iso/fail/badspellincl.mod @@ -0,0 +1,11 @@ +(* { dg-do compile } *) +(* { dg-options "-g" } *) + +MODULE badspellincl ; + +VAR + foo: BITSET ; +BEGIN + INCL (Foo, 1) + (* { dg-error "base procedure INCL expects a variable as a parameter, seen unknown, did you mean foo?" "Foo" { target *-*-* } 9 } *) +END badspellincl. diff --git a/gcc/testsuite/gm2.dg/spell/iso/fail/badspellnew.mod b/gcc/testsuite/gm2.dg/spell/iso/fail/badspellnew.mod new file mode 100644 index 0000000..4007867 --- /dev/null +++ b/gcc/testsuite/gm2.dg/spell/iso/fail/badspellnew.mod @@ -0,0 +1,13 @@ +(* { dg-do compile } *) +(* { dg-options "-g" } *) + +MODULE badspellnew ; + +FROM Storage IMPORT ALLOCATE ; + +VAR + foo: POINTER TO CARDINAL ; +BEGIN + NEW (Foo) + (* { dg-error "parameter to NEW must be a pointer, seen unknown, did you mean foo?" "Foo" { target *-*-* } 11 } *) +END badspellnew. diff --git a/gcc/testsuite/gm2.dg/spell/iso/fail/badspellsize.mod b/gcc/testsuite/gm2.dg/spell/iso/fail/badspellsize.mod new file mode 100644 index 0000000..6ae35a5 --- /dev/null +++ b/gcc/testsuite/gm2.dg/spell/iso/fail/badspellsize.mod @@ -0,0 +1,14 @@ + +(* { dg-do compile } *) +(* { dg-options "-g" } *) + +MODULE badspellsize ; + +VAR + foo: INTEGER ; +BEGIN + IF SIZE (Foo) = NIL + (* { dg-error "SYSTEM procedure SIZE expects a variable or type as its parameter, seen unknown, did you mean foo?" "Foo" { target *-*-* } 10 } *) + THEN + END +END badspellsize. diff --git a/gcc/testsuite/gm2.dg/spell/iso/fail/dg-spell-iso-fail.exp b/gcc/testsuite/gm2.dg/spell/iso/fail/dg-spell-iso-fail.exp new file mode 100644 index 0000000..145d7eb --- /dev/null +++ b/gcc/testsuite/gm2.dg/spell/iso/fail/dg-spell-iso-fail.exp @@ -0,0 +1,34 @@ +# Copyright (C) 2025 Free Software Foundation, Inc. + +# This program is free software; you can redistribute it and/or modify +# it under the terms of the GNU General Public License as published by +# the Free Software Foundation; either version 3 of the License, or +# (at your option) any later version. +# +# This program is distributed in the hope that it will be useful, +# but WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +# GNU General Public License for more details. +# +# You should have received a copy of the GNU General Public License +# along with GCC; see the file COPYING3. If not see +# <http://www.gnu.org/licenses/>. + +# Compile tests, no torture testing. +# +# These tests raise errors in the front end; torture testing doesn't apply. + +# Load support procs. +load_lib gm2-dg.exp + +gm2_init_iso $srcdir/$subdir + +# Initialize `dg'. +dg-init + +# Main loop. + +dg-runtest [lsort [glob -nocomplain $srcdir/$subdir/*.mod]] "" "" + +# All done. +dg-finish diff --git a/gcc/testsuite/gnat.dg/machine_attr3.adb b/gcc/testsuite/gnat.dg/machine_attr3.adb new file mode 100644 index 0000000..68a9c77 --- /dev/null +++ b/gcc/testsuite/gnat.dg/machine_attr3.adb @@ -0,0 +1,7 @@ +-- { dg-do compile } + +package body Machine_Attr3 is + + procedure Proc is null; + +end Machine_Attr3; diff --git a/gcc/testsuite/gnat.dg/machine_attr3.ads b/gcc/testsuite/gnat.dg/machine_attr3.ads new file mode 100644 index 0000000..edb7b7d --- /dev/null +++ b/gcc/testsuite/gnat.dg/machine_attr3.ads @@ -0,0 +1,10 @@ +package Machine_Attr3 is + + procedure Proc; + +private + + Attr : constant String := "nothrow"; + pragma Machine_Attribute (Proc, Attr); + +end Machine_Attr3; 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-vect-loop.cc b/gcc/tree-vect-loop.cc index a98c06d..50cdc2a 100644 --- a/gcc/tree-vect-loop.cc +++ b/gcc/tree-vect-loop.cc @@ -7147,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(). */ @@ -7161,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 ()) @@ -7172,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 3c760b4..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); |