diff options
Diffstat (limited to 'gcc')
61 files changed, 873 insertions, 121 deletions
diff --git a/gcc/ada/doc/gnat_rm/implementation_defined_pragmas.rst b/gcc/ada/doc/gnat_rm/implementation_defined_pragmas.rst index 02013f1..3986298 100644 --- a/gcc/ada/doc/gnat_rm/implementation_defined_pragmas.rst +++ b/gcc/ada/doc/gnat_rm/implementation_defined_pragmas.rst @@ -5914,13 +5914,33 @@ Syntax: pragma Short_Circuit_And_Or; -This configuration pragma causes any occurrence of the AND operator applied to -operands of type Standard.Boolean to be short-circuited (i.e. the AND operator -is treated as if it were AND THEN). Or is similarly treated as OR ELSE. This -may be useful in the context of certification protocols requiring the use of -short-circuited logical operators. If this configuration pragma occurs locally -within the file being compiled, it applies only to the file being compiled. +This configuration pragma causes the predefined AND and OR operators of +type Standard.Boolean to have short-circuit semantics. That is, they +behave like AND THEN and OR ELSE; the right-hand side is not evaluated +if the left-hand side determines the result. This may be useful in the +context of certification protocols requiring the use of short-circuited +logical operators. + There is no requirement that all units in a partition use this option. +However, mixing of short-circuit and non-short-circuit semantics can be +confusing. Therefore, the recommended use is to put the pragma in a +configuration file that applies to the whole program. Alternatively, if +you have a legacy library that should not use this pragma, you can put +it in a separate library project that does not use the pragma. +In any case, fine-grained mixing of the different semantics is not +recommended. If pragma ``Short_Circuit_And_Or`` is specified, then it +is illegal to rename the predefined Boolean AND and OR, or to pass +them to generic formal functions; this corresponds to the fact that +AND THEN and OR ELSE cannot be renamed nor passed as generic formal +functions. + +Note that this pragma has no effect on other logical operators -- +predefined operators of modular types, array-of-boolean types and types +derived from Standard.Boolean, nor user-defined operators. + +See also the pragma ``Unevaluated_Use_Of_Old`` and the restriction +``No_Direct_Boolean_Operators``, which may be useful in conjunction +with ``Short_Circuit_And_Or``. Pragma Short_Descriptors ======================== diff --git a/gcc/ada/exp_ch7.adb b/gcc/ada/exp_ch7.adb index e4daf4b..009bee4 100644 --- a/gcc/ada/exp_ch7.adb +++ b/gcc/ada/exp_ch7.adb @@ -7906,12 +7906,16 @@ package body Exp_Ch7 is if Is_Untagged_Derivation (Typ) then if Is_Protected_Type (Typ) then Utyp := Corresponding_Record_Type (Root_Type (Base_Type (Typ))); - else - Utyp := Underlying_Type (Root_Type (Base_Type (Typ))); - if Is_Protected_Type (Utyp) then - Utyp := Corresponding_Record_Type (Utyp); - end if; + else + declare + Root : constant Entity_Id := + Underlying_Type (Root_Type (Base_Type (Typ))); + begin + if Is_Protected_Type (Root) then + Utyp := Corresponding_Record_Type (Root); + end if; + end; end if; Ref := Unchecked_Convert_To (Utyp, Ref); diff --git a/gcc/ada/exp_util.adb b/gcc/ada/exp_util.adb index 4f98779..2172ce7 100644 --- a/gcc/ada/exp_util.adb +++ b/gcc/ada/exp_util.adb @@ -6190,11 +6190,17 @@ package body Exp_Util is Utyp := Corresponding_Record_Type (Root_Type (Btyp)); else - Utyp := Underlying_Type (Root_Type (Btyp)); - - if Is_Protected_Type (Utyp) then - Utyp := Corresponding_Record_Type (Utyp); - end if; + declare + Root : constant Entity_Id := Underlying_Type (Root_Type (Btyp)); + begin + if Is_Protected_Type (Root) then + Utyp := Corresponding_Record_Type (Root); + else + while No (TSS (Utyp, TSS_Finalize_Address)) loop + Utyp := Underlying_Type (Base_Type (Etype (Utyp))); + end loop; + end if; + end; end if; end if; diff --git a/gcc/ada/freeze.adb b/gcc/ada/freeze.adb index be2115a..3755d9e 100644 --- a/gcc/ada/freeze.adb +++ b/gcc/ada/freeze.adb @@ -765,6 +765,9 @@ package body Freeze is -- in fact constrained by non-static discriminant values. Could be made -- more precise ??? + function Value_Known (Exp : Node_Id) return Boolean; + -- Return True if the value of expression Exp is known at compile time + -------------------- -- Set_Small_Size -- -------------------- @@ -880,13 +883,13 @@ package body Freeze is High := Type_High_Bound (Etype (Index)); end if; - if not Compile_Time_Known_Value (Low) - or else not Compile_Time_Known_Value (High) - or else Etype (Index) = Any_Type - then + if Etype (Index) = Any_Type then return False; - else + elsif Compile_Time_Known_Value (Low) + and then Compile_Time_Known_Value (High) + then + Dim := Expr_Value (High) - Expr_Value (Low) + 1; if Dim > Uint_0 then @@ -894,6 +897,12 @@ package body Freeze is else Size := Uint_0; end if; + + elsif Value_Known (Low) and then Value_Known (High) then + Size := Uint_0; + + else + return False; end if; Next_Index (Index); @@ -1160,6 +1169,70 @@ package body Freeze is return True; end Static_Discriminated_Components; + ----------------- + -- Value_Known -- + ----------------- + + function Value_Known (Exp : Node_Id) return Boolean is + begin + -- This is the immediate case + + if Compile_Time_Known_Value (Exp) then + return True; + end if; + + -- The value may be known only to the back end, the typical example + -- being the alignment or the various sizes of composite types; in + -- the latter case, we may mutually recurse with Size_Known. + + case Nkind (Exp) is + when N_Attribute_Reference => + declare + P : constant Node_Id := Prefix (Exp); + + begin + if not Is_Entity_Name (P) + or else not Is_Type (Entity (P)) + then + return False; + end if; + + case Get_Attribute_Id (Attribute_Name (Exp)) is + when Attribute_Alignment => + return True; + + when Attribute_Component_Size => + return Size_Known (Component_Type (Entity (P))); + + when Attribute_Object_Size + | Attribute_Size + | Attribute_Value_Size + => + return Size_Known (Entity (P)); + + when others => + return False; + end case; + end; + + when N_Binary_Op => + return Value_Known (Left_Opnd (Exp)) + and then Value_Known (Right_Opnd (Exp)); + + when N_Qualified_Expression + | N_Type_Conversion + | N_Unchecked_Type_Conversion + => + return Value_Known (Expression (Exp)); + + when N_Unary_Op => + return Value_Known (Right_Opnd (Exp)); + + when others => + return False; + end case; + end Value_Known; + -- Start of processing for Check_Compile_Time_Size begin diff --git a/gcc/ada/gcc-interface/Make-lang.in b/gcc/ada/gcc-interface/Make-lang.in index 1c93816..bbbd697 100644 --- a/gcc/ada/gcc-interface/Make-lang.in +++ b/gcc/ada/gcc-interface/Make-lang.in @@ -1096,7 +1096,7 @@ check-ada-subtargets: check-acats-subtargets check-gnat-subtargets # No ada-specific selftests selftest-ada: -ACATSDIR = $(TESTSUITEDIR)/ada/acats-2 +ACATSDIR = $(TESTSUITEDIR)/ada/acats-4 ACATSCMD = run_acats.sh check_acats_numbers0:=1 2 3 4 5 6 7 8 9 diff --git a/gcc/ada/gcc-interface/decl.cc b/gcc/ada/gcc-interface/decl.cc index 903ec84..86cbf5b 100644 --- a/gcc/ada/gcc-interface/decl.cc +++ b/gcc/ada/gcc-interface/decl.cc @@ -6421,6 +6421,33 @@ gnat_to_gnu_subprog_type (Entity_Id gnat_subprog, bool definition, since structures are incomplete for the back-end. */ else if (Convention (gnat_subprog) != Convention_Stubbed) { + /* If we have two entries that may be returned in integer registers, + the larger has power-of-2 size and the smaller is integer, then + extend the smaller to this power-of-2 size to get a return type + with power-of-2 size and no holes, again to speed up accesses. */ + if (list_length (gnu_cico_field_list) == 2 + && gnu_cico_only_integral_type) + { + tree typ1 = TREE_TYPE (gnu_cico_field_list); + tree typ2 = TREE_TYPE (DECL_CHAIN (gnu_cico_field_list)); + if (TREE_CODE (typ1) == INTEGER_TYPE + && integer_pow2p (TYPE_SIZE (typ2)) + && compare_tree_int (TYPE_SIZE (typ2), + MAX_FIXED_MODE_SIZE) <= 0 + && tree_int_cst_lt (TYPE_SIZE (typ1), TYPE_SIZE (typ2))) + TREE_TYPE (gnu_cico_field_list) + = gnat_type_for_size (TREE_INT_CST_LOW (TYPE_SIZE (typ2)), + TYPE_UNSIGNED (typ1)); + else if (TREE_CODE (typ2) == INTEGER_TYPE + && integer_pow2p (TYPE_SIZE (typ1)) + && compare_tree_int (TYPE_SIZE (typ1), + MAX_FIXED_MODE_SIZE) <= 0 + && tree_int_cst_lt (TYPE_SIZE (typ2), TYPE_SIZE (typ1))) + TREE_TYPE (DECL_CHAIN (gnu_cico_field_list)) + = gnat_type_for_size (TREE_INT_CST_LOW (TYPE_SIZE (typ1)), + TYPE_UNSIGNED (typ2)); + } + finish_record_type (gnu_cico_return_type, nreverse (gnu_cico_field_list), 0, false); diff --git a/gcc/ada/gcc-interface/trans.cc b/gcc/ada/gcc-interface/trans.cc index e02804b..a7254fe 100644 --- a/gcc/ada/gcc-interface/trans.cc +++ b/gcc/ada/gcc-interface/trans.cc @@ -4049,7 +4049,7 @@ Subprogram_Body_to_gnu (Node_Id gnat_node) tree gnu_decl; /* Skip any entries that have been already filled in; they must - correspond to In Out parameters. */ + correspond to In Out parameters or previous Out parameters. */ while (gnu_cico_entry && TREE_VALUE (gnu_cico_entry)) gnu_cico_entry = TREE_CHAIN (gnu_cico_entry); @@ -4059,11 +4059,22 @@ Subprogram_Body_to_gnu (Node_Id gnat_node) if (DECL_BY_REF_P (gnu_decl)) gnu_decl = build_unary_op (INDIRECT_REF, NULL_TREE, gnu_decl); - /* Do any needed references for padded types. */ - TREE_VALUE (gnu_cico_entry) - = convert (TREE_TYPE (TREE_PURPOSE (gnu_cico_entry)), gnu_decl); + TREE_VALUE (gnu_cico_entry) = gnu_decl; } + + /* Finally, ensure type consistency between TREE_PURPOSE and TREE_VALUE + so that the assignment of the latter to the former can be done. */ + tree gnu_cico_entry = gnu_cico_list; + while (gnu_cico_entry) + { + if (!VOID_TYPE_P (TREE_VALUE (gnu_cico_entry))) + TREE_VALUE (gnu_cico_entry) + = convert (TREE_TYPE (TREE_PURPOSE (gnu_cico_entry)), + TREE_VALUE (gnu_cico_entry)); + gnu_cico_entry = TREE_CHAIN (gnu_cico_entry); + } } + else vec_safe_push (gnu_return_label_stack, NULL_TREE); @@ -4161,9 +4172,13 @@ Subprogram_Body_to_gnu (Node_Id gnat_node) } } - /* Otherwise, if this is a procedure or a function which does not return - by invisible reference, we can do a direct block-copy out. */ - else + /* Otherwise, if this is a procedure or a function that does not return + by invisible reference, we can do a direct block-copy out, but we do + not need to do it for a null initialization procedure when the _Init + parameter is not passed in since we would copy uninitialized bits. */ + else if (!(Is_Null_Init_Proc (gnat_subprog) + && list_length (gnu_cico_list) == 1 + && TREE_CODE (TREE_VALUE (gnu_cico_list)) == VAR_DECL)) { tree gnu_retval; diff --git a/gcc/ada/gcc-interface/utils.cc b/gcc/ada/gcc-interface/utils.cc index 23737c3..7324bee 100644 --- a/gcc/ada/gcc-interface/utils.cc +++ b/gcc/ada/gcc-interface/utils.cc @@ -1225,7 +1225,6 @@ make_packable_type (tree type, bool in_record, unsigned int max_align) Note that we rely on the pointer equality created here for TYPE_NAME to look through conversions in various places. */ TYPE_NAME (new_type) = TYPE_NAME (type); - TYPE_PACKED (new_type) = 1; TYPE_JUSTIFIED_MODULAR_P (new_type) = TYPE_JUSTIFIED_MODULAR_P (type); TYPE_CONTAINS_TEMPLATE_P (new_type) = TYPE_CONTAINS_TEMPLATE_P (type); TYPE_REVERSE_STORAGE_ORDER (new_type) = TYPE_REVERSE_STORAGE_ORDER (type); @@ -1240,6 +1239,8 @@ make_packable_type (tree type, bool in_record, unsigned int max_align) new_size = ceil_pow2 (size); new_align = MIN (new_size, BIGGEST_ALIGNMENT); SET_TYPE_ALIGN (new_type, new_align); + /* build_aligned_type needs to be able to adjust back the alignment. */ + TYPE_PACKED (new_type) = 0; } else { @@ -1261,6 +1262,7 @@ make_packable_type (tree type, bool in_record, unsigned int max_align) if (max_align > 0 && new_align > max_align) new_align = max_align; SET_TYPE_ALIGN (new_type, MIN (align, new_align)); + TYPE_PACKED (new_type) = 1; } TYPE_USER_ALIGN (new_type) = 1; diff --git a/gcc/ada/gnat_rm.texi b/gcc/ada/gnat_rm.texi index 79fb225..b0a14b0 100644 --- a/gcc/ada/gnat_rm.texi +++ b/gcc/ada/gnat_rm.texi @@ -19,7 +19,7 @@ @copying @quotation -GNAT Reference Manual , Jun 27, 2025 +GNAT Reference Manual , Jul 03, 2025 AdaCore @@ -7548,13 +7548,33 @@ Syntax: pragma Short_Circuit_And_Or; @end example -This configuration pragma causes any occurrence of the AND operator applied to -operands of type Standard.Boolean to be short-circuited (i.e. the AND operator -is treated as if it were AND THEN). Or is similarly treated as OR ELSE. This -may be useful in the context of certification protocols requiring the use of -short-circuited logical operators. If this configuration pragma occurs locally -within the file being compiled, it applies only to the file being compiled. +This configuration pragma causes the predefined AND and OR operators of +type Standard.Boolean to have short-circuit semantics. That is, they +behave like AND THEN and OR ELSE; the right-hand side is not evaluated +if the left-hand side determines the result. This may be useful in the +context of certification protocols requiring the use of short-circuited +logical operators. + There is no requirement that all units in a partition use this option. +However, mixing of short-circuit and non-short-circuit semantics can be +confusing. Therefore, the recommended use is to put the pragma in a +configuration file that applies to the whole program. Alternatively, if +you have a legacy library that should not use this pragma, you can put +it in a separate library project that does not use the pragma. +In any case, fine-grained mixing of the different semantics is not +recommended. If pragma @code{Short_Circuit_And_Or} is specified, then it +is illegal to rename the predefined Boolean AND and OR, or to pass +them to generic formal functions; this corresponds to the fact that +AND THEN and OR ELSE cannot be renamed nor passed as generic formal +functions. + +Note that this pragma has no effect on other logical operators – +predefined operators of modular types, array-of-boolean types and types +derived from Standard.Boolean, nor user-defined operators. + +See also the pragma @code{Unevaluated_Use_Of_Old} and the restriction +@code{No_Direct_Boolean_Operators}, which may be useful in conjunction +with @code{Short_Circuit_And_Or}. @node Pragma Short_Descriptors,Pragma Side_Effects,Pragma Short_Circuit_And_Or,Implementation Defined Pragmas @anchor{gnat_rm/implementation_defined_pragmas pragma-short-descriptors}@anchor{ed} diff --git a/gcc/ada/mutably_tagged.adb b/gcc/ada/mutably_tagged.adb index 153d168..b04ba92 100644 --- a/gcc/ada/mutably_tagged.adb +++ b/gcc/ada/mutably_tagged.adb @@ -40,6 +40,7 @@ with Sinfo.Nodes; use Sinfo.Nodes; with Sinfo.Utils; use Sinfo.Utils; with Stringt; use Stringt; with Tbuild; use Tbuild; +with Uintp; use Uintp; package body Mutably_Tagged is @@ -205,21 +206,41 @@ package body Mutably_Tagged is Mut_Tag_Typ : Entity_Id) return Node_Id is Loc : constant Source_Ptr := Sloc (New_Typ); + + CW_Size : constant Uint := RM_Size (Mut_Tag_Typ); + + function To_Mixed_Case (S : String) return String; + -- convert string to mixed case + + ------------------- + -- To_Mixed_Case -- + ------------------- + + function To_Mixed_Case (S : String) return String is + Buf : Bounded_String; + begin + Append (Buf, S); + Set_Casing (Buf, Mixed_Case); + return +Buf; + end To_Mixed_Case; + + -- Start of processing for Make_CW_Size_Compile_Check + begin - -- Generate a string literal for New_Typ's name which is needed for - -- printing within the Compile_Time_Error. + -- Build a Compile_Time_Error pragma in order to defer the + -- (compile-time) size check until after the back end has + -- determined sizes. + -- + -- It would be nice if we could somehow include the value of + -- New_Type'Size in the error message, but it is not clear how to + -- accomplish that with the current FE/BE interfaces. + + -- Get New_Typ's name (in mixed case) into the name buffer; + -- this is used immediately afterwards in the Make_Pragma call. Get_Decoded_Name_String (Chars (New_Typ)); Set_Casing (Mixed_Case); - -- Build a pragma Compile_Time_Error to force the backend to - -- preform appropriate sizing checks. - - -- Generate: - -- pragma Compile_Time_Error - -- (New_Typ'Size < Mut_Tag_Typ'Size, - -- "class size for by-reference type ""New_Typ"" too small") - return Make_Pragma (Loc, Chars => Name_Compile_Time_Error, @@ -233,19 +254,18 @@ package body Mutably_Tagged is Prefix => New_Occurrence_Of (New_Typ, Loc)), Right_Opnd => - Make_Integer_Literal (Loc, - RM_Size (Mut_Tag_Typ))))), + Make_Integer_Literal (Loc, CW_Size)))), Make_Pragma_Argument_Association (Loc, Expression => - - -- Is it possible to print the size of New_Typ via - -- Validate_Compile_Time_Warning_Or_Error after the back-end - -- has run to generate the error message manually ??? - Make_String_Literal (Loc, - "class size for by-reference type """ - & To_String (String_From_Name_Buffer) - & """ too small")))); + To_String (String_From_Name_Buffer) + & "'Size exceeds " + & To_Mixed_Case ( + To_String (Fully_Qualified_Name_String + (Find_Specific_Type (Mut_Tag_Typ), + Append_NUL => False))) + & "'Size'Class limit of " + & UI_Image (CW_Size))))); end Make_CW_Size_Compile_Check; ------------------------------------ diff --git a/gcc/ada/sem_aux.ads b/gcc/ada/sem_aux.ads index 5a63002..aad5d32 100644 --- a/gcc/ada/sem_aux.ads +++ b/gcc/ada/sem_aux.ads @@ -105,7 +105,7 @@ package Sem_Aux is -- this is equivalent to First_Entity. The exception arises for tagged -- types, where the tag itself is prepended to the front of the entity -- chain, so the First_Discriminant function steps past the tag if it is - -- present. When called on a private type with unknown discriminants, the + -- present. When called on a private type with unknown discriminants, the -- function always returns Empty. -- WARNING: There is a matching C declaration of this subprogram in fe.h diff --git a/gcc/ada/sem_ch13.adb b/gcc/ada/sem_ch13.adb index 1e88ef4..99acbf8 100644 --- a/gcc/ada/sem_ch13.adb +++ b/gcc/ada/sem_ch13.adb @@ -4634,6 +4634,7 @@ package body Sem_Ch13 is when Aspect_Designated_Storage_Model => if not All_Extensions_Allowed then + Error_Msg_Name_1 := Nam; Error_Msg_GNAT_Extension ("aspect %", Loc); goto Continue; @@ -8861,6 +8862,43 @@ package body Sem_Ch13 is Num_Repped_Components : Nat := 0; Num_Unrepped_Components : Nat := 0; + function Unchecked_Union_Pragma_Pending return Boolean; + -- Return True in the corner case of an Unchecked_Union pragma + -- occuring after the record representation clause (which + -- means that Is_Unchecked_Union will return False for Rectype, + -- even though it would return True if called later after the + -- pragma is analyzed). + + ------------------------------------ + -- Unchecked_Union_Pragma_Pending -- + ------------------------------------ + + function Unchecked_Union_Pragma_Pending return Boolean is + Decl_List_Element : Node_Id := N; + Pragma_Arg : Node_Id; + begin + while Present (Decl_List_Element) loop + if Nkind (Decl_List_Element) = N_Pragma + and then Get_Pragma_Id (Decl_List_Element) = + Pragma_Unchecked_Union + and then not Is_Empty_List (Pragma_Argument_Associations + (Decl_List_Element)) + then + Pragma_Arg := Get_Pragma_Arg + (First (Pragma_Argument_Associations + (Decl_List_Element))); + if Nkind (Pragma_Arg) = N_Identifier + and then Chars (Pragma_Arg) = Chars (Rectype) + then + return True; + end if; + end if; + + Next (Decl_List_Element); + end loop; + return False; + end Unchecked_Union_Pragma_Pending; + begin -- First count number of repped and unrepped components @@ -8899,8 +8937,10 @@ package body Sem_Ch13 is -- Ignore discriminant in unchecked union, since it is -- not there, and cannot have a component clause. - and then (not Is_Unchecked_Union (Rectype) - or else Ekind (Comp) /= E_Discriminant) + and then (Ekind (Comp) /= E_Discriminant + or else not (Is_Unchecked_Union (Rectype) + or else + Unchecked_Union_Pragma_Pending)) then Error_Msg_Sloc := Sloc (Comp); Error_Msg_NE @@ -11406,24 +11446,16 @@ package body Sem_Ch13 is ---------------------------------- procedure Check_Aspect_At_Freeze_Point (ASN : Node_Id) is - Ident : constant Node_Id := Identifier (ASN); - -- Identifier (use Entity field to save expression) - Expr : constant Node_Id := Expression (ASN); - -- For cases where using Entity (Identifier) doesn't work - A_Id : constant Aspect_Id := Get_Aspect_Id (Chars (Ident)); + A_Id : constant Aspect_Id := Get_Aspect_Id (Chars (Identifier (ASN))); T : Entity_Id := Empty; -- Type required for preanalyze call begin - -- On entry to this procedure, Entity (Ident) contains a copy of the - -- original expression from the aspect, saved for this purpose. - - -- On exit from this procedure Entity (Ident) is unchanged, still - -- containing that copy, but Expression (Ident) is a preanalyzed copy - -- of the expression, preanalyzed just after the freeze point. + -- On exit from this procedure, Expression (ASN) is a copy of the + -- original expression, preanalyzed just after the freeze point. -- Make a copy of the expression to be preanalyzed diff --git a/gcc/ada/sem_ch8.adb b/gcc/ada/sem_ch8.adb index db892d0..54066b4 100644 --- a/gcc/ada/sem_ch8.adb +++ b/gcc/ada/sem_ch8.adb @@ -4270,6 +4270,40 @@ package body Sem_Ch8 is Local_Restrict.Check_Actual_Subprogram_For_Instance (Actual_Subp_Name => Nam, Formal_Subp => Formal_Spec); end if; + + -- If pragma Short_Circuit_And_Or is specified, then we give an error + -- for renaming an operator that is made short circuit. + -- For example, this is illegal: + -- + -- function My_And (X, Y: Boolean) return Boolean renames "and"; + -- + -- if "and" denotes the usual predefined Boolean operator. Otherwise, + -- the semantics are confusing (sometimes short circuit, and sometimes + -- not, for calls to My_And). If we ever relax this rule, we will need + -- to clean up that run-time semantics. + + if Short_Circuit_And_Or + and then Chars (Old_S) in Name_Op_And | Name_Op_Or + and then In_Extended_Main_Source_Unit (N) + and then Etype (Old_S) = Standard_Boolean + and then Is_Intrinsic_Subprogram (Old_S) + then + if Comes_From_Source (N) then + Error_Msg_N + ("pragma Short_Circuit_And_Or disallows renaming of " & + "operator", N); + + -- Same error in case of an instantiation with My_And => "and" + + elsif Present (Corresponding_Formal_Spec (N)) then + Error_Msg_N + ("pragma Short_Circuit_And_Or disallows passing of " & + "operator as a generic actual", N); + + else + raise Program_Error; + end if; + end if; end Analyze_Subprogram_Renaming; ------------------------- diff --git a/gcc/ada/sem_res.adb b/gcc/ada/sem_res.adb index 96e8da6..e44994a 100644 --- a/gcc/ada/sem_res.adb +++ b/gcc/ada/sem_res.adb @@ -12463,16 +12463,6 @@ package body Sem_Res is Orig_N := Original_Node (Expression (Orig_N)); Orig_T := Target_Typ; - -- If the node is part of a larger expression, the Target_Type - -- may not be the original type of the node if the context is a - -- condition. Recover original type to see if conversion is needed. - - if Is_Boolean_Type (Orig_T) - and then Nkind (Parent (N)) in N_Op - then - Orig_T := Etype (Parent (N)); - end if; - -- If we have an entity name, then give the warning if the entity -- is the right type, or if it is a loop parameter covered by the -- original type (that's needed because loop parameters have an @@ -12548,6 +12538,16 @@ package body Sem_Res is then null; + -- Do not warn if original source-level conversion was + -- between two different types. + + elsif Nkind (Original_Node (N)) = N_Type_Conversion + and then + Base_Type (Etype (Subtype_Mark (Original_Node (N)))) + /= Base_Type (Etype (Expression (Original_Node (N)))) + then + null; + -- Here we give the redundant conversion warning. If it is an -- entity, give the name of the entity in the message. If not, -- just mention the expression. diff --git a/gcc/c-family/c-common.cc b/gcc/c-family/c-common.cc index 9d69298..362dc50 100644 --- a/gcc/c-family/c-common.cc +++ b/gcc/c-family/c-common.cc @@ -3438,20 +3438,41 @@ pointer_int_sum (location_t loc, enum tree_code resultcode, an overflow error if the constant is negative but INTOP is not. */ && (TYPE_OVERFLOW_UNDEFINED (TREE_TYPE (intop)) || (TYPE_PRECISION (TREE_TYPE (intop)) - == TYPE_PRECISION (TREE_TYPE (ptrop))))) - { - enum tree_code subcode = resultcode; - tree int_type = TREE_TYPE (intop); - if (TREE_CODE (intop) == MINUS_EXPR) - subcode = (subcode == PLUS_EXPR ? MINUS_EXPR : PLUS_EXPR); - /* Convert both subexpression types to the type of intop, - because weird cases involving pointer arithmetic - can result in a sum or difference with different type args. */ - ptrop = build_binary_op (EXPR_LOCATION (TREE_OPERAND (intop, 1)), - subcode, ptrop, - convert (int_type, TREE_OPERAND (intop, 1)), - true); - intop = convert (int_type, TREE_OPERAND (intop, 0)); + == TYPE_PRECISION (TREE_TYPE (ptrop)))) + && TYPE_PRECISION (TREE_TYPE (intop)) <= TYPE_PRECISION (sizetype)) + { + tree intop0 = TREE_OPERAND (intop, 0); + tree intop1 = TREE_OPERAND (intop, 1); + if (TYPE_PRECISION (TREE_TYPE (intop)) != TYPE_PRECISION (sizetype) + || TYPE_UNSIGNED (TREE_TYPE (intop)) != TYPE_UNSIGNED (sizetype)) + { + tree optype = c_common_type_for_size (TYPE_PRECISION (sizetype), + TYPE_UNSIGNED (sizetype)); + intop0 = convert (optype, intop0); + intop1 = convert (optype, intop1); + } + tree t = fold_build2_loc (loc, MULT_EXPR, TREE_TYPE (intop0), intop0, + convert (TREE_TYPE (intop0), size_exp)); + intop0 = convert (sizetype, t); + if (TREE_OVERFLOW_P (intop0) && !TREE_OVERFLOW (t)) + intop0 = wide_int_to_tree (TREE_TYPE (intop0), wi::to_wide (intop0)); + t = fold_build2_loc (loc, MULT_EXPR, TREE_TYPE (intop1), intop1, + convert (TREE_TYPE (intop1), size_exp)); + intop1 = convert (sizetype, t); + if (TREE_OVERFLOW_P (intop1) && !TREE_OVERFLOW (t)) + intop1 = wide_int_to_tree (TREE_TYPE (intop1), wi::to_wide (intop1)); + intop = build_binary_op (EXPR_LOCATION (intop), TREE_CODE (intop), + intop0, intop1, true); + + /* Create the sum or difference. */ + if (resultcode == MINUS_EXPR) + intop = fold_build1_loc (loc, NEGATE_EXPR, sizetype, intop); + + ret = fold_build_pointer_plus_loc (loc, ptrop, intop); + + fold_undefer_and_ignore_overflow_warnings (); + + return ret; } /* Convert the integer argument to a type the same size as sizetype diff --git a/gcc/common.opt b/gcc/common.opt index 8163e03..3d65656 100644 --- a/gcc/common.opt +++ b/gcc/common.opt @@ -547,7 +547,7 @@ Warn if an array is accessed out of bounds. Wauto-profile Common Var(warn_auto_profile) Warning -Warn about problems with auto-profile data +Warn about problems with auto-profile data. Wuse-after-free Common Var(warn_use_after_free) Warning diff --git a/gcc/common.opt.urls b/gcc/common.opt.urls index c705089..a507168 100644 --- a/gcc/common.opt.urls +++ b/gcc/common.opt.urls @@ -64,6 +64,9 @@ UrlSuffix(gcc/Warning-Options.html#index-Warray-bounds) Warray-bounds= UrlSuffix(gcc/Warning-Options.html#index-Warray-bounds) +Wauto-profile +UrlSuffix(gcc/Warning-Options.html#index-Wauto-profile) + Wuse-after-free UrlSuffix(gcc/Warning-Options.html#index-Wno-use-after-free) diff --git a/gcc/config/riscv/riscv-v.cc b/gcc/config/riscv/riscv-v.cc index ce1633c..a5ab8dd 100644 --- a/gcc/config/riscv/riscv-v.cc +++ b/gcc/config/riscv/riscv-v.cc @@ -5544,6 +5544,7 @@ expand_vx_binary_vec_dup_vec (rtx op_0, rtx op_1, rtx op_2, case SMIN: case UMIN: case US_PLUS: + case SS_PLUS: icode = code_for_pred_scalar (code, mode); break; case MINUS: @@ -5584,6 +5585,7 @@ expand_vx_binary_vec_vec_dup (rtx op_0, rtx op_1, rtx op_2, case UMIN: case US_PLUS: case US_MINUS: + case SS_PLUS: icode = code_for_pred_scalar (code, mode); break; default: diff --git a/gcc/config/riscv/riscv.cc b/gcc/config/riscv/riscv.cc index 167e78d..ecdb61e 100644 --- a/gcc/config/riscv/riscv.cc +++ b/gcc/config/riscv/riscv.cc @@ -3997,6 +3997,7 @@ riscv_rtx_costs (rtx x, machine_mode mode, int outer_code, int opno ATTRIBUTE_UN case UMOD: case US_PLUS: case US_MINUS: + case SS_PLUS: *total = get_vector_binary_rtx_cost (op, scalar2vr_cost); break; default: diff --git a/gcc/config/riscv/vector-iterators.md b/gcc/config/riscv/vector-iterators.md index 7825444..fd0959c 100644 --- a/gcc/config/riscv/vector-iterators.md +++ b/gcc/config/riscv/vector-iterators.md @@ -4042,11 +4042,11 @@ ]) (define_code_iterator any_int_binop_no_shift_v_vdup [ - plus minus and ior xor mult div udiv mod umod smax umax smin umin us_plus us_minus + plus minus and ior xor mult div udiv mod umod smax umax smin umin us_plus us_minus ss_plus ]) (define_code_iterator any_int_binop_no_shift_vdup_v [ - plus minus and ior xor mult smax umax smin umin us_plus + plus minus and ior xor mult smax umax smin umin us_plus ss_plus ]) (define_code_iterator any_int_unop [neg not]) diff --git a/gcc/cp/parser.cc b/gcc/cp/parser.cc index 617b7cd..cac74e3 100644 --- a/gcc/cp/parser.cc +++ b/gcc/cp/parser.cc @@ -36664,7 +36664,7 @@ static void cp_parser_abort_tentative_parse (cp_parser* parser) { gcc_assert (parser->context->status != CP_PARSER_STATUS_KIND_COMMITTED - || errorcount > 0); + || seen_error ()); cp_parser_simulate_error (parser); /* Now, pretend that we want to see if the construct was successfully parsed. */ diff --git a/gcc/fold-const.cc b/gcc/fold-const.cc index 4749257..8867540 100644 --- a/gcc/fold-const.cc +++ b/gcc/fold-const.cc @@ -15224,7 +15224,7 @@ bool tree_expr_nonnegative_warnv_p (tree t, bool *strict_overflow_p, int depth) { enum tree_code code; - if (t == error_mark_node) + if (error_operand_p (t)) return false; code = TREE_CODE (t); diff --git a/gcc/fortran/io.cc b/gcc/fortran/io.cc index 7466d8f..4d28c2c 100644 --- a/gcc/fortran/io.cc +++ b/gcc/fortran/io.cc @@ -29,7 +29,7 @@ along with GCC; see the file COPYING3. If not see gfc_st_label format_asterisk = {0, NULL, NULL, -1, ST_LABEL_FORMAT, ST_LABEL_FORMAT, NULL, - 0, {NULL, NULL}, NULL, 0}; + 0, {NULL, {NULL}}, NULL, 0}; typedef struct { diff --git a/gcc/testsuite/g++.dg/template/permissive-error3.C b/gcc/testsuite/g++.dg/template/permissive-error3.C new file mode 100644 index 0000000..988b7fa --- /dev/null +++ b/gcc/testsuite/g++.dg/template/permissive-error3.C @@ -0,0 +1,12 @@ +// PR c++/120575 +// { dg-additional-options -Wno-template-body } + +template< int > +struct T {}; + +template< int > +struct S { + + operator typename T< oops >::anything () {}; + +}; diff --git a/gcc/testsuite/gcc.dg/pr118948-1.c b/gcc/testsuite/gcc.dg/pr118948-1.c new file mode 100644 index 0000000..2a46cf1 --- /dev/null +++ b/gcc/testsuite/gcc.dg/pr118948-1.c @@ -0,0 +1,12 @@ +/* { dg-do compile } */ +/* { dg-options "" } */ + +/* PR c/118948 */ + +/* Used to ICE in tree_expr_nonnegative_p after an error. */ + +void f(void) { + int i; /* { dg-note "previous" } */ + for (i = 0; i < 2; i++) ; + float i; /* { dg-error "conflicting types for" } */ +} diff --git a/gcc/testsuite/gcc.dg/torture/pr120944.c b/gcc/testsuite/gcc.dg/torture/pr120944.c new file mode 100644 index 0000000..92f3c77 --- /dev/null +++ b/gcc/testsuite/gcc.dg/torture/pr120944.c @@ -0,0 +1,34 @@ +/* { dg-skip-if "" { *-*-* } { "-flto" } { "" } } */ +/* { dg-additional-options "-fdump-tree-optimized" } */ + +#include <stdlib.h> + +typedef union { + int u32; + struct + { + int A:1; + int B:2; + int C:3; + }; +} u_t; + +typedef union { + volatile int u[3]; + volatile struct { + u_t a; + int b; + int c; + }; +} DATA; + +void foo (volatile DATA *d) +{ + d->a.u32 = ~0; + u_t u = d->a; + int v = u.A; + if (v) + abort(); +} + +/* { dg-final { scan-tree-dump-times "if \\\(" 1 "optimized" } } */ diff --git a/gcc/testsuite/gcc.dg/ubsan/pr120837.c b/gcc/testsuite/gcc.dg/ubsan/pr120837.c new file mode 100644 index 0000000..97c85c7 --- /dev/null +++ b/gcc/testsuite/gcc.dg/ubsan/pr120837.c @@ -0,0 +1,32 @@ +/* PR c/120837 */ +/* { dg-do run } */ +/* { dg-options "-O1 -fsanitize=undefined -fno-sanitize-recover=undefined" } */ + +[[gnu::noipa]] void +bar (void **x, void **y) +{ + x[0] = 0; + x[1] = 0; + x[2] = 0; + y[0] = 0; + y[1] = 0; + y[2] = 0; + y[3] = 0; + y[4] = 0; +} + +[[gnu::noipa]] void * +foo (int x, int y) +{ + void *a[3]; + void *b[5]; + bar (a, b); + return (x > y ? b : a)[y - 1]; +} + +int +main () +{ + if (foo (2, 1) != 0) + __builtin_abort (); +} diff --git a/gcc/testsuite/gcc.dg/vect/vect-pr120927-2.c b/gcc/testsuite/gcc.dg/vect/vect-pr120927-2.c new file mode 100644 index 0000000..e38cebe --- /dev/null +++ b/gcc/testsuite/gcc.dg/vect/vect-pr120927-2.c @@ -0,0 +1,24 @@ +/* { dg-additional-options "--param vect-partial-vector-usage=1" } */ +/* { dg-additional-options "-mavx512bw -mavx512vl" { target avx512f_runtime } } */ + +#include "tree-vect.h" + +static const double __attribute__((aligned(__BIGGEST_ALIGNMENT__))) a[] = { 1., 2., 3., 4., 5. }; + +void __attribute__((noipa)) +foo (double *b, double *bp, double c, int n) +{ + for (int i = 0; i < n; ++i) + b[i] = bp[i] = a[i] * c; +} + +int main() +{ + double b[6], bp[6]; + b[5] = bp[5] = 13.; + check_vect (); + foo (b, bp, 3., 5); + if (b[5] != 13. || bp[5] != 13.) + abort (); + return 0; +} diff --git a/gcc/testsuite/gcc.dg/vect/vect-pr120927.c b/gcc/testsuite/gcc.dg/vect/vect-pr120927.c new file mode 100644 index 0000000..793593f --- /dev/null +++ b/gcc/testsuite/gcc.dg/vect/vect-pr120927.c @@ -0,0 +1,24 @@ +/* { dg-additional-options "--param vect-partial-vector-usage=1" } */ +/* { dg-additional-options "-mavx512bw -mavx512vl" { target avx512f_runtime } } */ + +#include "tree-vect.h" + +static const double a[] = { 1., 2., 3., 4., 5. }; + +void __attribute__((noipa)) +foo (double *b, double *bp, double c, int n) +{ + for (int i = 0; i < n; ++i) + b[i] = bp[i] = a[i] * c; +} + +int main() +{ + double b[6], bp[6]; + b[5] = bp[5] = 13.; + check_vect (); + foo (b, bp, 3., 5); + if (b[5] != 13. || bp[5] != 13.) + abort (); + return 0; +} diff --git a/gcc/testsuite/gcc.target/riscv/rvv/autovec/vx_vf/vx-1-i16.c b/gcc/testsuite/gcc.target/riscv/rvv/autovec/vx_vf/vx-1-i16.c index c86d77c..25652ec 100644 --- a/gcc/testsuite/gcc.target/riscv/rvv/autovec/vx_vf/vx-1-i16.c +++ b/gcc/testsuite/gcc.target/riscv/rvv/autovec/vx_vf/vx-1-i16.c @@ -18,3 +18,4 @@ TEST_BINARY_VX_SIGNED_0(T) /* { dg-final { scan-assembler-times {vrem.vx} 1 } } */ /* { dg-final { scan-assembler-times {vmax.vx} 2 } } */ /* { dg-final { scan-assembler-times {vmin.vx} 2 } } */ +/* { dg-final { scan-assembler-times {vsadd.vx} 1 } } */ diff --git a/gcc/testsuite/gcc.target/riscv/rvv/autovec/vx_vf/vx-1-i32.c b/gcc/testsuite/gcc.target/riscv/rvv/autovec/vx_vf/vx-1-i32.c index f6524cb..cbf4e28 100644 --- a/gcc/testsuite/gcc.target/riscv/rvv/autovec/vx_vf/vx-1-i32.c +++ b/gcc/testsuite/gcc.target/riscv/rvv/autovec/vx_vf/vx-1-i32.c @@ -18,3 +18,4 @@ TEST_BINARY_VX_SIGNED_0(T) /* { dg-final { scan-assembler-times {vrem.vx} 1 } } */ /* { dg-final { scan-assembler-times {vmax.vx} 2 } } */ /* { dg-final { scan-assembler-times {vmin.vx} 2 } } */ +/* { dg-final { scan-assembler-times {vsadd.vx} 1 } } */ diff --git a/gcc/testsuite/gcc.target/riscv/rvv/autovec/vx_vf/vx-1-i64.c b/gcc/testsuite/gcc.target/riscv/rvv/autovec/vx_vf/vx-1-i64.c index f1e8627..e5519e6 100644 --- a/gcc/testsuite/gcc.target/riscv/rvv/autovec/vx_vf/vx-1-i64.c +++ b/gcc/testsuite/gcc.target/riscv/rvv/autovec/vx_vf/vx-1-i64.c @@ -18,3 +18,4 @@ TEST_BINARY_VX_SIGNED_0(T) /* { dg-final { scan-assembler-times {vrem.vx} 1 } } */ /* { dg-final { scan-assembler-times {vmax.vx} 2 } } */ /* { dg-final { scan-assembler-times {vmin.vx} 2 } } */ +/* { dg-final { scan-assembler-times {vsadd.vx} 1 } } */ diff --git a/gcc/testsuite/gcc.target/riscv/rvv/autovec/vx_vf/vx-1-i8.c b/gcc/testsuite/gcc.target/riscv/rvv/autovec/vx_vf/vx-1-i8.c index 9b0cbd2..beaf174 100644 --- a/gcc/testsuite/gcc.target/riscv/rvv/autovec/vx_vf/vx-1-i8.c +++ b/gcc/testsuite/gcc.target/riscv/rvv/autovec/vx_vf/vx-1-i8.c @@ -18,3 +18,4 @@ TEST_BINARY_VX_SIGNED_0(T) /* { dg-final { scan-assembler-times {vrem.vx} 1 } } */ /* { dg-final { scan-assembler-times {vmax.vx} 2 } } */ /* { dg-final { scan-assembler-times {vmin.vx} 2 } } */ +/* { dg-final { scan-assembler-times {vsadd.vx} 1 } } */ diff --git a/gcc/testsuite/gcc.target/riscv/rvv/autovec/vx_vf/vx-2-i16.c b/gcc/testsuite/gcc.target/riscv/rvv/autovec/vx_vf/vx-2-i16.c index fb1154c..23c0ec9 100644 --- a/gcc/testsuite/gcc.target/riscv/rvv/autovec/vx_vf/vx-2-i16.c +++ b/gcc/testsuite/gcc.target/riscv/rvv/autovec/vx_vf/vx-2-i16.c @@ -18,3 +18,4 @@ TEST_BINARY_VX_SIGNED_0(T) /* { dg-final { scan-assembler-not {vrem.vx} } } */ /* { dg-final { scan-assembler-not {vmax.vx} } } */ /* { dg-final { scan-assembler-not {vmin.vx} } } */ +/* { dg-final { scan-assembler-not {vsadd.vx} } } */ diff --git a/gcc/testsuite/gcc.target/riscv/rvv/autovec/vx_vf/vx-2-i32.c b/gcc/testsuite/gcc.target/riscv/rvv/autovec/vx_vf/vx-2-i32.c index d4baa4b..e5fc38e 100644 --- a/gcc/testsuite/gcc.target/riscv/rvv/autovec/vx_vf/vx-2-i32.c +++ b/gcc/testsuite/gcc.target/riscv/rvv/autovec/vx_vf/vx-2-i32.c @@ -18,3 +18,4 @@ TEST_BINARY_VX_SIGNED_0(T) /* { dg-final { scan-assembler-not {vrem.vx} } } */ /* { dg-final { scan-assembler-not {vmax.vx} } } */ /* { dg-final { scan-assembler-not {vmin.vx} } } */ +/* { dg-final { scan-assembler-not {vsadd.vx} } } */ diff --git a/gcc/testsuite/gcc.target/riscv/rvv/autovec/vx_vf/vx-2-i64.c b/gcc/testsuite/gcc.target/riscv/rvv/autovec/vx_vf/vx-2-i64.c index 18c1a78..7701fc9 100644 --- a/gcc/testsuite/gcc.target/riscv/rvv/autovec/vx_vf/vx-2-i64.c +++ b/gcc/testsuite/gcc.target/riscv/rvv/autovec/vx_vf/vx-2-i64.c @@ -18,3 +18,4 @@ TEST_BINARY_VX_SIGNED_0(T) /* { dg-final { scan-assembler-not {vrem.vx} } } */ /* { dg-final { scan-assembler-not {vmax.vx} } } */ /* { dg-final { scan-assembler-not {vmin.vx} } } */ +/* { dg-final { scan-assembler-not {vsadd.vx} } } */ diff --git a/gcc/testsuite/gcc.target/riscv/rvv/autovec/vx_vf/vx-2-i8.c b/gcc/testsuite/gcc.target/riscv/rvv/autovec/vx_vf/vx-2-i8.c index 5ce3c88..4b84204 100644 --- a/gcc/testsuite/gcc.target/riscv/rvv/autovec/vx_vf/vx-2-i8.c +++ b/gcc/testsuite/gcc.target/riscv/rvv/autovec/vx_vf/vx-2-i8.c @@ -18,3 +18,4 @@ TEST_BINARY_VX_SIGNED_0(T) /* { dg-final { scan-assembler-not {vrem.vx} } } */ /* { dg-final { scan-assembler-not {vmax.vx} } } */ /* { dg-final { scan-assembler-not {vmin.vx} } } */ +/* { dg-final { scan-assembler-not {vsadd.vx} } } */ diff --git a/gcc/testsuite/gcc.target/riscv/rvv/autovec/vx_vf/vx-3-i16.c b/gcc/testsuite/gcc.target/riscv/rvv/autovec/vx_vf/vx-3-i16.c index 2965924..09058a8 100644 --- a/gcc/testsuite/gcc.target/riscv/rvv/autovec/vx_vf/vx-3-i16.c +++ b/gcc/testsuite/gcc.target/riscv/rvv/autovec/vx_vf/vx-3-i16.c @@ -18,3 +18,4 @@ TEST_BINARY_VX_SIGNED_0(T) /* { dg-final { scan-assembler-not {vrem.vx} } } */ /* { dg-final { scan-assembler-not {vmax.vx} } } */ /* { dg-final { scan-assembler-not {vmin.vx} } } */ +/* { dg-final { scan-assembler-not {vsadd.vx} } } */ diff --git a/gcc/testsuite/gcc.target/riscv/rvv/autovec/vx_vf/vx-3-i32.c b/gcc/testsuite/gcc.target/riscv/rvv/autovec/vx_vf/vx-3-i32.c index e7815e9..fa0ef42 100644 --- a/gcc/testsuite/gcc.target/riscv/rvv/autovec/vx_vf/vx-3-i32.c +++ b/gcc/testsuite/gcc.target/riscv/rvv/autovec/vx_vf/vx-3-i32.c @@ -18,3 +18,4 @@ TEST_BINARY_VX_SIGNED_0(T) /* { dg-final { scan-assembler-not {vrem.vx} } } */ /* { dg-final { scan-assembler-not {vmax.vx} } } */ /* { dg-final { scan-assembler-not {vmin.vx} } } */ +/* { dg-final { scan-assembler-not {vsadd.vx} } } */ diff --git a/gcc/testsuite/gcc.target/riscv/rvv/autovec/vx_vf/vx-3-i64.c b/gcc/testsuite/gcc.target/riscv/rvv/autovec/vx_vf/vx-3-i64.c index 063a7a1..7d8358a 100644 --- a/gcc/testsuite/gcc.target/riscv/rvv/autovec/vx_vf/vx-3-i64.c +++ b/gcc/testsuite/gcc.target/riscv/rvv/autovec/vx_vf/vx-3-i64.c @@ -18,3 +18,4 @@ TEST_BINARY_VX_SIGNED_0(T) /* { dg-final { scan-assembler-not {vrem.vx} } } */ /* { dg-final { scan-assembler-not {vmax.vx} } } */ /* { dg-final { scan-assembler-not {vmin.vx} } } */ +/* { dg-final { scan-assembler-not {vsadd.vx} } } */ diff --git a/gcc/testsuite/gcc.target/riscv/rvv/autovec/vx_vf/vx-3-i8.c b/gcc/testsuite/gcc.target/riscv/rvv/autovec/vx_vf/vx-3-i8.c index 0efb60c..4657932 100644 --- a/gcc/testsuite/gcc.target/riscv/rvv/autovec/vx_vf/vx-3-i8.c +++ b/gcc/testsuite/gcc.target/riscv/rvv/autovec/vx_vf/vx-3-i8.c @@ -18,3 +18,4 @@ TEST_BINARY_VX_SIGNED_0(T) /* { dg-final { scan-assembler-not {vrem.vx} } } */ /* { dg-final { scan-assembler-not {vmax.vx} } } */ /* { dg-final { scan-assembler-not {vmin.vx} } } */ +/* { dg-final { scan-assembler-not {vsadd.vx} } } */ diff --git a/gcc/testsuite/gcc.target/riscv/rvv/autovec/vx_vf/vx-4-i16.c b/gcc/testsuite/gcc.target/riscv/rvv/autovec/vx_vf/vx-4-i16.c index 199f8a7..92f1b7b 100644 --- a/gcc/testsuite/gcc.target/riscv/rvv/autovec/vx_vf/vx-4-i16.c +++ b/gcc/testsuite/gcc.target/riscv/rvv/autovec/vx_vf/vx-4-i16.c @@ -18,6 +18,7 @@ DEF_VX_BINARY_CASE_3_WRAP(T, MAX_FUNC_0_WARP(T), max, VX_BINARY_FUNC_BODY_X8) DEF_VX_BINARY_CASE_3_WRAP(T, MAX_FUNC_1_WARP(T), max, VX_BINARY_FUNC_BODY_X8) DEF_VX_BINARY_CASE_3_WRAP(T, MIN_FUNC_0_WARP(T), min, VX_BINARY_FUNC_BODY_X8) DEF_VX_BINARY_CASE_3_WRAP(T, MIN_FUNC_1_WARP(T), min, VX_BINARY_FUNC_BODY_X8) +DEF_VX_BINARY_CASE_3_WRAP(T, SAT_S_ADD_FUNC_WRAP(T), sat_add, VX_BINARY_FUNC_BODY_X8) /* { dg-final { scan-assembler {vadd.vx} } } */ /* { dg-final { scan-assembler {vsub.vx} } } */ @@ -30,3 +31,4 @@ DEF_VX_BINARY_CASE_3_WRAP(T, MIN_FUNC_1_WARP(T), min, VX_BINARY_FUNC_BODY_X8) /* { dg-final { scan-assembler {vrem.vx} } } */ /* { dg-final { scan-assembler {vmax.vx} } } */ /* { dg-final { scan-assembler {vmin.vx} } } */ +/* { dg-final { scan-assembler {vsadd.vx} } } */ diff --git a/gcc/testsuite/gcc.target/riscv/rvv/autovec/vx_vf/vx-4-i32.c b/gcc/testsuite/gcc.target/riscv/rvv/autovec/vx_vf/vx-4-i32.c index 392f4fe..31594ce 100644 --- a/gcc/testsuite/gcc.target/riscv/rvv/autovec/vx_vf/vx-4-i32.c +++ b/gcc/testsuite/gcc.target/riscv/rvv/autovec/vx_vf/vx-4-i32.c @@ -18,6 +18,7 @@ DEF_VX_BINARY_CASE_3_WRAP(T, MAX_FUNC_0_WARP(T), max, VX_BINARY_FUNC_BODY_X4) DEF_VX_BINARY_CASE_3_WRAP(T, MAX_FUNC_1_WARP(T), max, VX_BINARY_FUNC_BODY_X4) DEF_VX_BINARY_CASE_3_WRAP(T, MIN_FUNC_0_WARP(T), min, VX_BINARY_FUNC_BODY_X4) DEF_VX_BINARY_CASE_3_WRAP(T, MIN_FUNC_1_WARP(T), min, VX_BINARY_FUNC_BODY_X4) +DEF_VX_BINARY_CASE_3_WRAP(T, SAT_S_ADD_FUNC_WRAP(T), sat_add, VX_BINARY_FUNC_BODY_X4) /* { dg-final { scan-assembler {vadd.vx} } } */ /* { dg-final { scan-assembler {vsub.vx} } } */ @@ -30,3 +31,4 @@ DEF_VX_BINARY_CASE_3_WRAP(T, MIN_FUNC_1_WARP(T), min, VX_BINARY_FUNC_BODY_X4) /* { dg-final { scan-assembler {vrem.vx} } } */ /* { dg-final { scan-assembler {vmax.vx} } } */ /* { dg-final { scan-assembler {vmin.vx} } } */ +/* { dg-final { scan-assembler {vsadd.vx} } } */ diff --git a/gcc/testsuite/gcc.target/riscv/rvv/autovec/vx_vf/vx-4-i64.c b/gcc/testsuite/gcc.target/riscv/rvv/autovec/vx_vf/vx-4-i64.c index d22c387..02e03ec 100644 --- a/gcc/testsuite/gcc.target/riscv/rvv/autovec/vx_vf/vx-4-i64.c +++ b/gcc/testsuite/gcc.target/riscv/rvv/autovec/vx_vf/vx-4-i64.c @@ -18,6 +18,7 @@ DEF_VX_BINARY_CASE_3_WRAP(T, MAX_FUNC_0_WARP(T), max, VX_BINARY_FUNC_BODY) DEF_VX_BINARY_CASE_3_WRAP(T, MAX_FUNC_1_WARP(T), max, VX_BINARY_FUNC_BODY) DEF_VX_BINARY_CASE_3_WRAP(T, MIN_FUNC_0_WARP(T), min, VX_BINARY_FUNC_BODY) DEF_VX_BINARY_CASE_3_WRAP(T, MIN_FUNC_1_WARP(T), min, VX_BINARY_FUNC_BODY) +DEF_VX_BINARY_CASE_3_WRAP(T, SAT_S_ADD_FUNC_WRAP(T), sat_add, VX_BINARY_FUNC_BODY) /* { dg-final { scan-assembler {vadd.vx} } } */ /* { dg-final { scan-assembler {vsub.vx} } } */ @@ -30,3 +31,4 @@ DEF_VX_BINARY_CASE_3_WRAP(T, MIN_FUNC_1_WARP(T), min, VX_BINARY_FUNC_BODY) /* { dg-final { scan-assembler {vrem.vx} } } */ /* { dg-final { scan-assembler {vmax.vx} } } */ /* { dg-final { scan-assembler {vmin.vx} } } */ +/* { dg-final { scan-assembler-not {vsadd.vx} } } */ diff --git a/gcc/testsuite/gcc.target/riscv/rvv/autovec/vx_vf/vx-4-i8.c b/gcc/testsuite/gcc.target/riscv/rvv/autovec/vx_vf/vx-4-i8.c index 9a832a2..2c296ad 100644 --- a/gcc/testsuite/gcc.target/riscv/rvv/autovec/vx_vf/vx-4-i8.c +++ b/gcc/testsuite/gcc.target/riscv/rvv/autovec/vx_vf/vx-4-i8.c @@ -18,6 +18,7 @@ DEF_VX_BINARY_CASE_3_WRAP(T, MAX_FUNC_0_WARP(T), max, VX_BINARY_FUNC_BODY_X8) DEF_VX_BINARY_CASE_3_WRAP(T, MAX_FUNC_1_WARP(T), max, VX_BINARY_FUNC_BODY_X8) DEF_VX_BINARY_CASE_3_WRAP(T, MIN_FUNC_0_WARP(T), min, VX_BINARY_FUNC_BODY_X8) DEF_VX_BINARY_CASE_3_WRAP(T, MIN_FUNC_1_WARP(T), min, VX_BINARY_FUNC_BODY_X8) +DEF_VX_BINARY_CASE_3_WRAP(T, SAT_S_ADD_FUNC_WRAP(T), sat_add, VX_BINARY_FUNC_BODY_X8) /* { dg-final { scan-assembler {vadd.vx} } } */ /* { dg-final { scan-assembler {vsub.vx} } } */ @@ -30,3 +31,4 @@ DEF_VX_BINARY_CASE_3_WRAP(T, MIN_FUNC_1_WARP(T), min, VX_BINARY_FUNC_BODY_X8) /* { dg-final { scan-assembler {vrem.vx} } } */ /* { dg-final { scan-assembler {vmax.vx} } } */ /* { dg-final { scan-assembler {vmin.vx} } } */ +/* { dg-final { scan-assembler {vsadd.vx} } } */ diff --git a/gcc/testsuite/gcc.target/riscv/rvv/autovec/vx_vf/vx-5-i16.c b/gcc/testsuite/gcc.target/riscv/rvv/autovec/vx_vf/vx-5-i16.c index f15fec5..3ea8f0f 100644 --- a/gcc/testsuite/gcc.target/riscv/rvv/autovec/vx_vf/vx-5-i16.c +++ b/gcc/testsuite/gcc.target/riscv/rvv/autovec/vx_vf/vx-5-i16.c @@ -18,6 +18,7 @@ DEF_VX_BINARY_CASE_3_WRAP(T, MAX_FUNC_0_WARP(T), max, VX_BINARY_FUNC_BODY_X8) DEF_VX_BINARY_CASE_3_WRAP(T, MAX_FUNC_1_WARP(T), max, VX_BINARY_FUNC_BODY_X8) DEF_VX_BINARY_CASE_3_WRAP(T, MIN_FUNC_0_WARP(T), min, VX_BINARY_FUNC_BODY_X8) DEF_VX_BINARY_CASE_3_WRAP(T, MIN_FUNC_1_WARP(T), min, VX_BINARY_FUNC_BODY_X8) +DEF_VX_BINARY_CASE_3_WRAP(T, SAT_S_ADD_FUNC_WRAP(T), sat_add, VX_BINARY_FUNC_BODY_X8) /* { dg-final { scan-assembler-not {vadd.vx} } } */ /* { dg-final { scan-assembler {vsub.vx} } } */ @@ -30,3 +31,4 @@ DEF_VX_BINARY_CASE_3_WRAP(T, MIN_FUNC_1_WARP(T), min, VX_BINARY_FUNC_BODY_X8) /* { dg-final { scan-assembler {vrem.vx} } } */ /* { dg-final { scan-assembler {vmax.vx} } } */ /* { dg-final { scan-assembler {vmin.vx} } } */ +/* { dg-final { scan-assembler {vsadd.vx} } } */ diff --git a/gcc/testsuite/gcc.target/riscv/rvv/autovec/vx_vf/vx-5-i32.c b/gcc/testsuite/gcc.target/riscv/rvv/autovec/vx_vf/vx-5-i32.c index 8d21c47..cb742aa 100644 --- a/gcc/testsuite/gcc.target/riscv/rvv/autovec/vx_vf/vx-5-i32.c +++ b/gcc/testsuite/gcc.target/riscv/rvv/autovec/vx_vf/vx-5-i32.c @@ -18,6 +18,7 @@ DEF_VX_BINARY_CASE_3_WRAP(T, MAX_FUNC_0_WARP(T), max, VX_BINARY_FUNC_BODY_X4) DEF_VX_BINARY_CASE_3_WRAP(T, MAX_FUNC_1_WARP(T), max, VX_BINARY_FUNC_BODY_X4) DEF_VX_BINARY_CASE_3_WRAP(T, MIN_FUNC_0_WARP(T), min, VX_BINARY_FUNC_BODY_X4) DEF_VX_BINARY_CASE_3_WRAP(T, MIN_FUNC_1_WARP(T), min, VX_BINARY_FUNC_BODY_X4) +DEF_VX_BINARY_CASE_3_WRAP(T, SAT_S_ADD_FUNC_WRAP(T), sat_add, VX_BINARY_FUNC_BODY_X4) /* { dg-final { scan-assembler {vadd.vx} } } */ /* { dg-final { scan-assembler {vsub.vx} } } */ @@ -30,3 +31,4 @@ DEF_VX_BINARY_CASE_3_WRAP(T, MIN_FUNC_1_WARP(T), min, VX_BINARY_FUNC_BODY_X4) /* { dg-final { scan-assembler {vrem.vx} } } */ /* { dg-final { scan-assembler {vmax.vx} } } */ /* { dg-final { scan-assembler {vmin.vx} } } */ +/* { dg-final { scan-assembler-not {vsadd.vx} } } */ diff --git a/gcc/testsuite/gcc.target/riscv/rvv/autovec/vx_vf/vx-5-i64.c b/gcc/testsuite/gcc.target/riscv/rvv/autovec/vx_vf/vx-5-i64.c index 0660000..1580073 100644 --- a/gcc/testsuite/gcc.target/riscv/rvv/autovec/vx_vf/vx-5-i64.c +++ b/gcc/testsuite/gcc.target/riscv/rvv/autovec/vx_vf/vx-5-i64.c @@ -18,6 +18,7 @@ DEF_VX_BINARY_CASE_3_WRAP(T, MAX_FUNC_0_WARP(T), max, VX_BINARY_FUNC_BODY) DEF_VX_BINARY_CASE_3_WRAP(T, MAX_FUNC_1_WARP(T), max, VX_BINARY_FUNC_BODY) DEF_VX_BINARY_CASE_3_WRAP(T, MIN_FUNC_0_WARP(T), min, VX_BINARY_FUNC_BODY) DEF_VX_BINARY_CASE_3_WRAP(T, MIN_FUNC_1_WARP(T), min, VX_BINARY_FUNC_BODY) +DEF_VX_BINARY_CASE_3_WRAP(T, SAT_S_ADD_FUNC_WRAP(T), sat_add, VX_BINARY_FUNC_BODY) /* { dg-final { scan-assembler {vadd.vx} } } */ /* { dg-final { scan-assembler {vsub.vx} } } */ @@ -30,3 +31,4 @@ DEF_VX_BINARY_CASE_3_WRAP(T, MIN_FUNC_1_WARP(T), min, VX_BINARY_FUNC_BODY) /* { dg-final { scan-assembler {vrem.vx} } } */ /* { dg-final { scan-assembler {vmax.vx} } } */ /* { dg-final { scan-assembler {vmin.vx} } } */ +/* { dg-final { scan-assembler-not {vsadd.vx} } } */ diff --git a/gcc/testsuite/gcc.target/riscv/rvv/autovec/vx_vf/vx-5-i8.c b/gcc/testsuite/gcc.target/riscv/rvv/autovec/vx_vf/vx-5-i8.c index ce33461..16b2e6a 100644 --- a/gcc/testsuite/gcc.target/riscv/rvv/autovec/vx_vf/vx-5-i8.c +++ b/gcc/testsuite/gcc.target/riscv/rvv/autovec/vx_vf/vx-5-i8.c @@ -18,6 +18,7 @@ DEF_VX_BINARY_CASE_3_WRAP(T, MAX_FUNC_0_WARP(T), max, VX_BINARY_FUNC_BODY_X8) DEF_VX_BINARY_CASE_3_WRAP(T, MAX_FUNC_1_WARP(T), max, VX_BINARY_FUNC_BODY_X8) DEF_VX_BINARY_CASE_3_WRAP(T, MIN_FUNC_0_WARP(T), min, VX_BINARY_FUNC_BODY_X8) DEF_VX_BINARY_CASE_3_WRAP(T, MIN_FUNC_1_WARP(T), min, VX_BINARY_FUNC_BODY_X8) +DEF_VX_BINARY_CASE_3_WRAP(T, SAT_S_ADD_FUNC_WRAP(T), sat_add, VX_BINARY_FUNC_BODY_X8) /* { dg-final { scan-assembler-not {vadd.vx} } } */ /* { dg-final { scan-assembler {vsub.vx} } } */ @@ -30,3 +31,4 @@ DEF_VX_BINARY_CASE_3_WRAP(T, MIN_FUNC_1_WARP(T), min, VX_BINARY_FUNC_BODY_X8) /* { dg-final { scan-assembler {vrem.vx} } } */ /* { dg-final { scan-assembler {vmax.vx} } } */ /* { dg-final { scan-assembler {vmin.vx} } } */ +/* { dg-final { scan-assembler {vsadd.vx} } } */ diff --git a/gcc/testsuite/gcc.target/riscv/rvv/autovec/vx_vf/vx-6-i16.c b/gcc/testsuite/gcc.target/riscv/rvv/autovec/vx_vf/vx-6-i16.c index 3c9afdd..60e2029 100644 --- a/gcc/testsuite/gcc.target/riscv/rvv/autovec/vx_vf/vx-6-i16.c +++ b/gcc/testsuite/gcc.target/riscv/rvv/autovec/vx_vf/vx-6-i16.c @@ -18,6 +18,7 @@ DEF_VX_BINARY_CASE_3_WRAP(T, MAX_FUNC_0_WARP(T), max, VX_BINARY_FUNC_BODY_X8) DEF_VX_BINARY_CASE_3_WRAP(T, MAX_FUNC_1_WARP(T), max, VX_BINARY_FUNC_BODY_X8) DEF_VX_BINARY_CASE_3_WRAP(T, MIN_FUNC_0_WARP(T), min, VX_BINARY_FUNC_BODY_X8) DEF_VX_BINARY_CASE_3_WRAP(T, MIN_FUNC_1_WARP(T), min, VX_BINARY_FUNC_BODY_X8) +DEF_VX_BINARY_CASE_3_WRAP(T, SAT_S_ADD_FUNC_WRAP(T), sat_add, VX_BINARY_FUNC_BODY_X8) /* { dg-final { scan-assembler-not {vadd.vx} } } */ /* { dg-final { scan-assembler {vsub.vx} } } */ @@ -30,3 +31,4 @@ DEF_VX_BINARY_CASE_3_WRAP(T, MIN_FUNC_1_WARP(T), min, VX_BINARY_FUNC_BODY_X8) /* { dg-final { scan-assembler {vrem.vx} } } */ /* { dg-final { scan-assembler {vmax.vx} } } */ /* { dg-final { scan-assembler {vmin.vx} } } */ +/* { dg-final { scan-assembler {vsadd.vx} } } */ diff --git a/gcc/testsuite/gcc.target/riscv/rvv/autovec/vx_vf/vx-6-i32.c b/gcc/testsuite/gcc.target/riscv/rvv/autovec/vx_vf/vx-6-i32.c index b80a6b3..073d83d3 100644 --- a/gcc/testsuite/gcc.target/riscv/rvv/autovec/vx_vf/vx-6-i32.c +++ b/gcc/testsuite/gcc.target/riscv/rvv/autovec/vx_vf/vx-6-i32.c @@ -18,6 +18,7 @@ DEF_VX_BINARY_CASE_3_WRAP(T, MAX_FUNC_0_WARP(T), max, VX_BINARY_FUNC_BODY_X4) DEF_VX_BINARY_CASE_3_WRAP(T, MAX_FUNC_1_WARP(T), max, VX_BINARY_FUNC_BODY_X4) DEF_VX_BINARY_CASE_3_WRAP(T, MIN_FUNC_0_WARP(T), min, VX_BINARY_FUNC_BODY_X4) DEF_VX_BINARY_CASE_3_WRAP(T, MIN_FUNC_1_WARP(T), min, VX_BINARY_FUNC_BODY_X4) +DEF_VX_BINARY_CASE_3_WRAP(T, SAT_S_ADD_FUNC_WRAP(T), sat_add, VX_BINARY_FUNC_BODY_X4) /* { dg-final { scan-assembler {vadd.vx} } } */ /* { dg-final { scan-assembler {vsub.vx} } } */ @@ -30,3 +31,4 @@ DEF_VX_BINARY_CASE_3_WRAP(T, MIN_FUNC_1_WARP(T), min, VX_BINARY_FUNC_BODY_X4) /* { dg-final { scan-assembler {vrem.vx} } } */ /* { dg-final { scan-assembler {vmax.vx} } } */ /* { dg-final { scan-assembler {vmin.vx} } } */ +/* { dg-final { scan-assembler-not {vsadd.vx} } } */ diff --git a/gcc/testsuite/gcc.target/riscv/rvv/autovec/vx_vf/vx-6-i64.c b/gcc/testsuite/gcc.target/riscv/rvv/autovec/vx_vf/vx-6-i64.c index 15bfe60..9a718c6 100644 --- a/gcc/testsuite/gcc.target/riscv/rvv/autovec/vx_vf/vx-6-i64.c +++ b/gcc/testsuite/gcc.target/riscv/rvv/autovec/vx_vf/vx-6-i64.c @@ -18,6 +18,7 @@ DEF_VX_BINARY_CASE_3_WRAP(T, MAX_FUNC_0_WARP(T), max, VX_BINARY_FUNC_BODY) DEF_VX_BINARY_CASE_3_WRAP(T, MAX_FUNC_1_WARP(T), max, VX_BINARY_FUNC_BODY) DEF_VX_BINARY_CASE_3_WRAP(T, MIN_FUNC_0_WARP(T), min, VX_BINARY_FUNC_BODY) DEF_VX_BINARY_CASE_3_WRAP(T, MIN_FUNC_1_WARP(T), min, VX_BINARY_FUNC_BODY) +DEF_VX_BINARY_CASE_3_WRAP(T, SAT_S_ADD_FUNC_WRAP(T), sat_add, VX_BINARY_FUNC_BODY) /* { dg-final { scan-assembler-not {vadd.vx} } } */ /* { dg-final { scan-assembler-not {vsub.vx} } } */ @@ -30,3 +31,4 @@ DEF_VX_BINARY_CASE_3_WRAP(T, MIN_FUNC_1_WARP(T), min, VX_BINARY_FUNC_BODY) /* { dg-final { scan-assembler-not {vrem.vx} } } */ /* { dg-final { scan-assembler-not {vmax.vx} } } */ /* { dg-final { scan-assembler-not {vmin.vx} } } */ +/* { dg-final { scan-assembler-not {vsadd.vx} } } */ diff --git a/gcc/testsuite/gcc.target/riscv/rvv/autovec/vx_vf/vx-6-i8.c b/gcc/testsuite/gcc.target/riscv/rvv/autovec/vx_vf/vx-6-i8.c index 4d529fe..02ad831 100644 --- a/gcc/testsuite/gcc.target/riscv/rvv/autovec/vx_vf/vx-6-i8.c +++ b/gcc/testsuite/gcc.target/riscv/rvv/autovec/vx_vf/vx-6-i8.c @@ -18,6 +18,7 @@ DEF_VX_BINARY_CASE_3_WRAP(T, MAX_FUNC_0_WARP(T), max, VX_BINARY_FUNC_BODY_X8) DEF_VX_BINARY_CASE_3_WRAP(T, MAX_FUNC_1_WARP(T), max, VX_BINARY_FUNC_BODY_X8) DEF_VX_BINARY_CASE_3_WRAP(T, MIN_FUNC_0_WARP(T), min, VX_BINARY_FUNC_BODY_X8) DEF_VX_BINARY_CASE_3_WRAP(T, MIN_FUNC_1_WARP(T), min, VX_BINARY_FUNC_BODY_X8) +DEF_VX_BINARY_CASE_3_WRAP(T, SAT_S_ADD_FUNC_WRAP(T), sat_add, VX_BINARY_FUNC_BODY_X8) /* { dg-final { scan-assembler-not {vadd.vx} } } */ /* { dg-final { scan-assembler {vsub.vx} } } */ @@ -30,3 +31,4 @@ DEF_VX_BINARY_CASE_3_WRAP(T, MIN_FUNC_1_WARP(T), min, VX_BINARY_FUNC_BODY_X8) /* { dg-final { scan-assembler {vrem.vx} } } */ /* { dg-final { scan-assembler {vmax.vx} } } */ /* { dg-final { scan-assembler {vmin.vx} } } */ +/* { dg-final { scan-assembler {vsadd.vx} } } */ diff --git a/gcc/testsuite/gcc.target/riscv/rvv/autovec/vx_vf/vx_binary.h b/gcc/testsuite/gcc.target/riscv/rvv/autovec/vx_vf/vx_binary.h index f12d1d1..944a863 100644 --- a/gcc/testsuite/gcc.target/riscv/rvv/autovec/vx_vf/vx_binary.h +++ b/gcc/testsuite/gcc.target/riscv/rvv/autovec/vx_vf/vx_binary.h @@ -294,26 +294,47 @@ DEF_SAT_U_SUB(uint16_t) DEF_SAT_U_SUB(uint32_t) DEF_SAT_U_SUB(uint64_t) +#define DEF_SAT_S_ADD(T, UT, MIN, MAX) \ +T \ +test_##T##_sat_add (T x, T y) \ +{ \ + T sum = (UT)x + (UT)y; \ + return (x ^ y) < 0 \ + ? sum \ + : (sum ^ x) >= 0 \ + ? sum \ + : x < 0 ? MIN : MAX; \ +} + +DEF_SAT_S_ADD(int8_t, uint8_t, INT8_MIN, INT8_MAX) +DEF_SAT_S_ADD(int16_t, uint16_t, INT16_MIN, INT16_MAX) +DEF_SAT_S_ADD(int32_t, uint32_t, INT32_MIN, INT32_MAX) +DEF_SAT_S_ADD(int64_t, uint64_t, INT64_MIN, INT64_MAX) + #define SAT_U_ADD_FUNC(T) test_##T##_sat_add #define SAT_U_ADD_FUNC_WRAP(T) SAT_U_ADD_FUNC(T) #define SAT_U_SUB_FUNC(T) test_##T##_sat_sub #define SAT_U_SUB_FUNC_WRAP(T) SAT_U_SUB_FUNC(T) -#define TEST_BINARY_VX_SIGNED_0(T) \ - DEF_VX_BINARY_CASE_0_WRAP(T, +, add) \ - DEF_VX_BINARY_CASE_0_WRAP(T, -, sub) \ - DEF_VX_BINARY_REVERSE_CASE_0_WRAP(T, -, rsub) \ - DEF_VX_BINARY_CASE_0_WRAP(T, &, and) \ - DEF_VX_BINARY_CASE_0_WRAP(T, |, or) \ - DEF_VX_BINARY_CASE_0_WRAP(T, ^, xor) \ - DEF_VX_BINARY_CASE_0_WRAP(T, *, mul) \ - DEF_VX_BINARY_CASE_0_WRAP(T, /, div) \ - DEF_VX_BINARY_CASE_0_WRAP(T, %, rem) \ - DEF_VX_BINARY_CASE_2_WRAP(T, MAX_FUNC_0_WARP(T), max) \ - DEF_VX_BINARY_CASE_2_WRAP(T, MAX_FUNC_1_WARP(T), max) \ - DEF_VX_BINARY_CASE_2_WRAP(T, MIN_FUNC_0_WARP(T), min) \ - DEF_VX_BINARY_CASE_2_WRAP(T, MIN_FUNC_1_WARP(T), min) +#define SAT_S_ADD_FUNC(T) test_##T##_sat_add +#define SAT_S_ADD_FUNC_WRAP(T) SAT_S_ADD_FUNC(T) + +#define TEST_BINARY_VX_SIGNED_0(T) \ + DEF_VX_BINARY_CASE_0_WRAP(T, +, add) \ + DEF_VX_BINARY_CASE_0_WRAP(T, -, sub) \ + DEF_VX_BINARY_REVERSE_CASE_0_WRAP(T, -, rsub) \ + DEF_VX_BINARY_CASE_0_WRAP(T, &, and) \ + DEF_VX_BINARY_CASE_0_WRAP(T, |, or) \ + DEF_VX_BINARY_CASE_0_WRAP(T, ^, xor) \ + DEF_VX_BINARY_CASE_0_WRAP(T, *, mul) \ + DEF_VX_BINARY_CASE_0_WRAP(T, /, div) \ + DEF_VX_BINARY_CASE_0_WRAP(T, %, rem) \ + DEF_VX_BINARY_CASE_2_WRAP(T, MAX_FUNC_0_WARP(T), max) \ + DEF_VX_BINARY_CASE_2_WRAP(T, MAX_FUNC_1_WARP(T), max) \ + DEF_VX_BINARY_CASE_2_WRAP(T, MIN_FUNC_0_WARP(T), min) \ + DEF_VX_BINARY_CASE_2_WRAP(T, MIN_FUNC_1_WARP(T), min) \ + DEF_VX_BINARY_CASE_2_WRAP(T, SAT_S_ADD_FUNC(T), sat_add) \ #define TEST_BINARY_VX_UNSIGNED_0(T) \ DEF_VX_BINARY_CASE_0_WRAP(T, +, add) \ diff --git a/gcc/testsuite/gcc.target/riscv/rvv/autovec/vx_vf/vx_binary_data.h b/gcc/testsuite/gcc.target/riscv/rvv/autovec/vx_vf/vx_binary_data.h index f475e36..9020eaf 100644 --- a/gcc/testsuite/gcc.target/riscv/rvv/autovec/vx_vf/vx_binary_data.h +++ b/gcc/testsuite/gcc.target/riscv/rvv/autovec/vx_vf/vx_binary_data.h @@ -4514,4 +4514,200 @@ uint64_t TEST_BINARY_DATA(uint64_t, sat_sub)[][3][N] = }, }; +int8_t TEST_BINARY_DATA(int8_t, sat_add)[][3][N] = +{ + { + { 0 }, + { + 2, 2, 2, 2, + 1, 1, 1, 1, + 0, 0, 0, 0, + 4, 4, 4, 4, + }, + { + 2, 2, 2, 2, + 1, 1, 1, 1, + 0, 0, 0, 0, + 4, 4, 4, 4, + }, + }, + { + { 127 }, + { + 127, 127, 127, 127, + -128, -128, -128, -128, + -127, -127, -127, -127, + 1, 1, 1, 1, + }, + { + 127, 127, 127, 127, + -1, -1, -1, -1, + 0, 0, 0, 0, + 127, 127, 127, 127, + }, + }, + { + { -128 }, + { + 127, 127, 127, 127, + -1, -1, -1, -1, + -128, -128, -128, -128, + 1, 1, 1, 1, + }, + { + -1, -1, -1, -1, + -128, -128, -128, -128, + -128, -128, -128, -128, + -127, -127, -127, -127, + }, + }, +}; + +int16_t TEST_BINARY_DATA(int16_t, sat_add)[][3][N] = +{ + { + { 0 }, + { + 2, 2, 2, 2, + 1, 1, 1, 1, + 0, 0, 0, 0, + 4, 4, 4, 4, + }, + { + 2, 2, 2, 2, + 1, 1, 1, 1, + 0, 0, 0, 0, + 4, 4, 4, 4, + }, + }, + { + { 32767 }, + { + 32767, 32767, 32767, 32767, + -32768, -32768, -32768, -32768, + -32767, -32767, -32767, -32767, + 1, 1, 1, 1, + }, + { + 32767, 32767, 32767, 32767, + -1, -1, -1, -1, + 0, 0, 0, 0, + 32767, 32767, 32767, 32767, + }, + }, + { + { -32768 }, + { + 32767, 32767, 32767, 32767, + -1, -1, -1, -1, + -32768, -32768, -32768, -32768, + 1, 1, 1, 1, + }, + { + -1, -1, -1, -1, + -32768, -32768, -32768, -32768, + -32768, -32768, -32768, -32768, + -32767, -32767, -32767, -32767, + }, + }, +}; + +int32_t TEST_BINARY_DATA(int32_t, sat_add)[][3][N] = +{ + { + { 0 }, + { + 2, 2, 2, 2, + 1, 1, 1, 1, + 0, 0, 0, 0, + 4, 4, 4, 4, + }, + { + 2, 2, 2, 2, + 1, 1, 1, 1, + 0, 0, 0, 0, + 4, 4, 4, 4, + }, + }, + { + { 2147483647 }, + { + 2147483647, 2147483647, 2147483647, 2147483647, + -2147483648, -2147483648, -2147483648, -2147483648, + -2147483647, -2147483647, -2147483647, -2147483647, + 1, 1, 1, 1, + }, + { + 2147483647, 2147483647, 2147483647, 2147483647, + -1, -1, -1, -1, + 0, 0, 0, 0, + 2147483647, 2147483647, 2147483647, 2147483647, + }, + }, + { + { -2147483648 }, + { + 2147483647, 2147483647, 2147483647, 2147483647, + -1, -1, -1, -1, + -2147483648, -2147483648, -2147483648, -2147483648, + 1, 1, 1, 1, + }, + { + -1, -1, -1, -1, + -2147483648, -2147483648, -2147483648, -2147483648, + -2147483648, -2147483648, -2147483648, -2147483648, + -2147483647, -2147483647, -2147483647, -2147483647, + }, + }, +}; + +int64_t TEST_BINARY_DATA(int64_t, sat_add)[][3][N] = +{ + { + { 0 }, + { + 2, 2, 2, 2, + 1, 1, 1, 1, + 0, 0, 0, 0, + 4, 4, 4, 4, + }, + { + 2, 2, 2, 2, + 1, 1, 1, 1, + 0, 0, 0, 0, + 4, 4, 4, 4, + }, + }, + { + { 9223372036854775807ull }, + { + 9223372036854775807ull, 9223372036854775807ull, 9223372036854775807ull, 9223372036854775807ull, + -9223372036854775808ull, -9223372036854775808ull, -9223372036854775808ull, -9223372036854775808ull, + -9223372036854775807ull, -9223372036854775807ull, -9223372036854775807ull, -9223372036854775807ull, + 1, 1, 1, 1, + }, + { + 9223372036854775807ull, 9223372036854775807ull, 9223372036854775807ull, 9223372036854775807ull, + -1, -1, -1, -1, + 0, 0, 0, 0, + 9223372036854775807ull, 9223372036854775807ull, 9223372036854775807ull, 9223372036854775807ull, + }, + }, + { + { -9223372036854775808ull }, + { + 9223372036854775807ull, 9223372036854775807ull, 9223372036854775807ull, 9223372036854775807ull, + -1, -1, -1, -1, + -9223372036854775808ull, -9223372036854775808ull, -9223372036854775808ull, -9223372036854775808ull, + 1, 1, 1, 1, + }, + { + -1, -1, -1, -1, + -9223372036854775808ull, -9223372036854775808ull, -9223372036854775808ull, -9223372036854775808ull, + -9223372036854775808ull, -9223372036854775808ull, -9223372036854775808ull, -9223372036854775808ull, + -9223372036854775807ull, -9223372036854775807ull, -9223372036854775807ull, -9223372036854775807ull, + }, + }, +}; + #endif diff --git a/gcc/testsuite/gcc.target/riscv/rvv/autovec/vx_vf/vx_vsadd-run-1-i16.c b/gcc/testsuite/gcc.target/riscv/rvv/autovec/vx_vf/vx_vsadd-run-1-i16.c new file mode 100644 index 0000000..1f0fd46 --- /dev/null +++ b/gcc/testsuite/gcc.target/riscv/rvv/autovec/vx_vf/vx_vsadd-run-1-i16.c @@ -0,0 +1,17 @@ +/* { dg-do run { target { riscv_v } } } */ +/* { dg-additional-options "-std=c99 --param=gpr2vr-cost=0" } */ + +#include "vx_binary.h" +#include "vx_binary_data.h" + +#define T int16_t +#define NAME sat_add +#define FUNC SAT_S_ADD_FUNC_WRAP(T) +#define TEST_DATA TEST_BINARY_DATA_WRAP(T, NAME) + +DEF_VX_BINARY_CASE_2_WRAP(T, FUNC, NAME) + +#define TEST_RUN(T, NAME, out, in, x, n) \ + RUN_VX_BINARY_CASE_2_WRAP(T, NAME, FUNC, out, in, x, n) + +#include "vx_binary_run.h" diff --git a/gcc/testsuite/gcc.target/riscv/rvv/autovec/vx_vf/vx_vsadd-run-1-i32.c b/gcc/testsuite/gcc.target/riscv/rvv/autovec/vx_vf/vx_vsadd-run-1-i32.c new file mode 100644 index 0000000..4a8df0c --- /dev/null +++ b/gcc/testsuite/gcc.target/riscv/rvv/autovec/vx_vf/vx_vsadd-run-1-i32.c @@ -0,0 +1,17 @@ +/* { dg-do run { target { riscv_v } } } */ +/* { dg-additional-options "-std=c99 --param=gpr2vr-cost=0" } */ + +#include "vx_binary.h" +#include "vx_binary_data.h" + +#define T int32_t +#define NAME sat_add +#define FUNC SAT_S_ADD_FUNC_WRAP(T) +#define TEST_DATA TEST_BINARY_DATA_WRAP(T, NAME) + +DEF_VX_BINARY_CASE_2_WRAP(T, FUNC, NAME) + +#define TEST_RUN(T, NAME, out, in, x, n) \ + RUN_VX_BINARY_CASE_2_WRAP(T, NAME, FUNC, out, in, x, n) + +#include "vx_binary_run.h" diff --git a/gcc/testsuite/gcc.target/riscv/rvv/autovec/vx_vf/vx_vsadd-run-1-i64.c b/gcc/testsuite/gcc.target/riscv/rvv/autovec/vx_vf/vx_vsadd-run-1-i64.c new file mode 100644 index 0000000..534cd25 --- /dev/null +++ b/gcc/testsuite/gcc.target/riscv/rvv/autovec/vx_vf/vx_vsadd-run-1-i64.c @@ -0,0 +1,17 @@ +/* { dg-do run { target { riscv_v } } } */ +/* { dg-additional-options "-std=c99 --param=gpr2vr-cost=0" } */ + +#include "vx_binary.h" +#include "vx_binary_data.h" + +#define T int64_t +#define NAME sat_add +#define FUNC SAT_S_ADD_FUNC_WRAP(T) +#define TEST_DATA TEST_BINARY_DATA_WRAP(T, NAME) + +DEF_VX_BINARY_CASE_2_WRAP(T, FUNC, NAME) + +#define TEST_RUN(T, NAME, out, in, x, n) \ + RUN_VX_BINARY_CASE_2_WRAP(T, NAME, FUNC, out, in, x, n) + +#include "vx_binary_run.h" diff --git a/gcc/testsuite/gcc.target/riscv/rvv/autovec/vx_vf/vx_vsadd-run-1-i8.c b/gcc/testsuite/gcc.target/riscv/rvv/autovec/vx_vf/vx_vsadd-run-1-i8.c new file mode 100644 index 0000000..de2a9b6 --- /dev/null +++ b/gcc/testsuite/gcc.target/riscv/rvv/autovec/vx_vf/vx_vsadd-run-1-i8.c @@ -0,0 +1,17 @@ +/* { dg-do run { target { riscv_v } } } */ +/* { dg-additional-options "-std=c99 --param=gpr2vr-cost=0" } */ + +#include "vx_binary.h" +#include "vx_binary_data.h" + +#define T int8_t +#define NAME sat_add +#define FUNC SAT_S_ADD_FUNC_WRAP(T) +#define TEST_DATA TEST_BINARY_DATA_WRAP(T, NAME) + +DEF_VX_BINARY_CASE_2_WRAP(T, FUNC, NAME) + +#define TEST_RUN(T, NAME, out, in, x, n) \ + RUN_VX_BINARY_CASE_2_WRAP(T, NAME, FUNC, out, in, x, n) + +#include "vx_binary_run.h" diff --git a/gcc/tree-ssa-sccvn.cc b/gcc/tree-ssa-sccvn.cc index 9cdbf3d..45fb79c 100644 --- a/gcc/tree-ssa-sccvn.cc +++ b/gcc/tree-ssa-sccvn.cc @@ -2809,7 +2809,8 @@ vn_reference_lookup_3 (ao_ref *ref, tree vuse, void *data_, we find a VN result with exactly the same value as the possible clobber. In this case we can ignore the clobber and return the found value. */ - if (is_gimple_reg_type (TREE_TYPE (lhs)) + if (!gimple_has_volatile_ops (def_stmt) + && is_gimple_reg_type (TREE_TYPE (lhs)) && types_compatible_p (TREE_TYPE (lhs), vr->type) && (ref->ref || data->orig_ref.ref) && !data->mask @@ -3093,7 +3094,8 @@ vn_reference_lookup_3 (ao_ref *ref, tree vuse, void *data_, else if (is_gimple_reg_type (vr->type) && gimple_assign_single_p (def_stmt) && gimple_assign_rhs_code (def_stmt) == CONSTRUCTOR - && CONSTRUCTOR_NELTS (gimple_assign_rhs1 (def_stmt)) == 0) + && CONSTRUCTOR_NELTS (gimple_assign_rhs1 (def_stmt)) == 0 + && !TREE_THIS_VOLATILE (gimple_assign_lhs (def_stmt))) { tree base2; poly_int64 offset2, size2, maxsize2; @@ -3149,6 +3151,7 @@ vn_reference_lookup_3 (ao_ref *ref, tree vuse, void *data_, && !reverse_storage_order_for_component_p (vr->operands) && !contains_storage_order_barrier_p (vr->operands) && gimple_assign_single_p (def_stmt) + && !TREE_THIS_VOLATILE (gimple_assign_lhs (def_stmt)) && CHAR_BIT == 8 && BITS_PER_UNIT == 8 && BYTES_BIG_ENDIAN == WORDS_BIG_ENDIAN @@ -3307,6 +3310,7 @@ vn_reference_lookup_3 (ao_ref *ref, tree vuse, void *data_, && !reverse_storage_order_for_component_p (vr->operands) && !contains_storage_order_barrier_p (vr->operands) && gimple_assign_single_p (def_stmt) + && !TREE_THIS_VOLATILE (gimple_assign_lhs (def_stmt)) && TREE_CODE (gimple_assign_rhs1 (def_stmt)) == SSA_NAME) { tree lhs = gimple_assign_lhs (def_stmt); @@ -3518,6 +3522,7 @@ vn_reference_lookup_3 (ao_ref *ref, tree vuse, void *data_, the copy kills ref. */ else if (data->vn_walk_kind == VN_WALKREWRITE && gimple_assign_single_p (def_stmt) + && !gimple_has_volatile_ops (def_stmt) && (DECL_P (gimple_assign_rhs1 (def_stmt)) || TREE_CODE (gimple_assign_rhs1 (def_stmt)) == MEM_REF || handled_component_p (gimple_assign_rhs1 (def_stmt)))) diff --git a/gcc/tree-vect-data-refs.cc b/gcc/tree-vect-data-refs.cc index ee040eb..c84cd29 100644 --- a/gcc/tree-vect-data-refs.cc +++ b/gcc/tree-vect-data-refs.cc @@ -1501,10 +1501,17 @@ vect_compute_data_ref_alignment (vec_info *vinfo, dr_vec_info *dr_info, /* We can only use base and misalignment information relative to an innermost loop if the misalignment stays the same throughout the execution of the loop. As above, this is the case if the stride of - the dataref evenly divides by the alignment. */ - poly_uint64 vf = LOOP_VINFO_VECT_FACTOR (loop_vinfo); - step_preserves_misalignment_p - = multiple_p (drb->step_alignment * vf, vect_align_c); + the dataref evenly divides by the alignment. Make sure to check + previous epilogues and the main loop. */ + step_preserves_misalignment_p = true; + auto lvinfo = loop_vinfo; + while (lvinfo) + { + poly_uint64 vf = LOOP_VINFO_VECT_FACTOR (lvinfo); + step_preserves_misalignment_p + &= multiple_p (drb->step_alignment * vf, vect_align_c); + lvinfo = LOOP_VINFO_ORIG_LOOP_INFO (lvinfo); + } if (!step_preserves_misalignment_p && dump_enabled_p ()) dump_printf_loc (MSG_MISSED_OPTIMIZATION, vect_location, @@ -1571,6 +1578,7 @@ vect_compute_data_ref_alignment (vec_info *vinfo, dr_vec_info *dr_info, unsigned int max_alignment; tree base = get_base_for_alignment (drb->base_address, &max_alignment); if (max_alignment < vect_align_c + || (loop_vinfo && LOOP_VINFO_EPILOGUE_P (loop_vinfo)) || !vect_can_force_dr_alignment_p (base, vect_align_c * BITS_PER_UNIT)) { |