From 5e1c00fac7db1ff2c586a8664dec5745bbf50fa6 Mon Sep 17 00:00:00 2001 From: Robert Dewar Date: Wed, 27 Oct 2004 15:01:38 +0200 Subject: [PATCH] exp_ch4.adb (Expand_N_Op_Eq): Make sure we expand a loop for array compares if the component is atomic. 2004-10-26 Robert Dewar * exp_ch4.adb (Expand_N_Op_Eq): Make sure we expand a loop for array compares if the component is atomic. * exp_ch5.adb (Expand_Assign_Array): Make sure we expand a loop for array assignment if the component type is atomic. From-SVN: r89650 --- gcc/ada/exp_ch4.adb | 94 +++++++++++++++++++++++---------------------- gcc/ada/exp_ch5.adb | 18 +++++++++ 2 files changed, 67 insertions(+), 45 deletions(-) diff --git a/gcc/ada/exp_ch4.adb b/gcc/ada/exp_ch4.adb index ac3c3894585..c89582b3a4e 100644 --- a/gcc/ada/exp_ch4.adb +++ b/gcc/ada/exp_ch4.adb @@ -250,7 +250,7 @@ package body Exp_Ch4 is if Kind = N_Op_Not then if Nkind (Op1) in N_Binary_Op then - -- Use negated version of the binary operators. + -- Use negated version of the binary operators if Nkind (Op1) = N_Op_And then Proc_Name := RTE (RE_Vector_Nand); @@ -428,7 +428,7 @@ package body Exp_Ch4 is if Controlled_Type (T) and then Ekind (PtrT) = E_Anonymous_Access_Type then - -- Create local finalization list for access parameter. + -- Create local finalization list for access parameter Flist := Get_Allocator_Final_List (N, Base_Type (T), PtrT); end if; @@ -535,7 +535,7 @@ package body Exp_Ch4 is if Controlled_Type (T) and then Ekind (PtrT) = E_Anonymous_Access_Type then - -- Create local finalization list for access parameter. + -- Create local finalization list for access parameter Flist := Get_Allocator_Final_List (N, Base_Type (T), PtrT); @@ -964,7 +964,7 @@ package body Exp_Ch4 is (Arr : Entity_Id; Nam : Name_Id; Num : Int) return Node_Id; - -- This builds the attribute reference Arr'Nam (Expr). + -- This builds the attribute reference Arr'Nam (Expr) function Component_Equality (Typ : Entity_Id) return Node_Id; -- Create one statement to compare corresponding components, @@ -1152,7 +1152,7 @@ package body Exp_Ch4 is Handle_One_Dimension (N + 1, Next_Index (Index))); if Need_Separate_Indexes then - -- Generate guard for loop, followed by increments of indices. + -- Generate guard for loop, followed by increments of indices Append_To (Stm_List, Make_Exit_Statement (Loc, @@ -1852,48 +1852,48 @@ package body Exp_Ch4 is -- L := Si'First; otherwise (where I is the input param given) function H return Node_Id; - -- Builds reference to identifier H. + -- Builds reference to identifier H function Ind_Val (E : Node_Id) return Node_Id; -- Builds expression Ind_Typ'Val (E); function L return Node_Id; - -- Builds reference to identifier L. + -- Builds reference to identifier L function L_Pos return Node_Id; - -- Builds expression Integer_Type'(Ind_Typ'Pos (L)). - -- We qualify the expression to avoid universal_integer computations - -- whenever possible, in the expression for the upper bound H. + -- Builds expression Integer_Type'(Ind_Typ'Pos (L)). We qualify the + -- expression to avoid universal_integer computations whenever possible, + -- in the expression for the upper bound H. function L_Succ return Node_Id; - -- Builds expression Ind_Typ'Succ (L). + -- Builds expression Ind_Typ'Succ (L) function One return Node_Id; - -- Builds integer literal one. + -- Builds integer literal one function P return Node_Id; - -- Builds reference to identifier P. + -- Builds reference to identifier P function P_Succ return Node_Id; - -- Builds expression Ind_Typ'Succ (P). + -- Builds expression Ind_Typ'Succ (P) function R return Node_Id; - -- Builds reference to identifier R. + -- Builds reference to identifier R function S (I : Nat) return Node_Id; - -- Builds reference to identifier Si, where I is the value given. + -- Builds reference to identifier Si, where I is the value given function S_First (I : Nat) return Node_Id; - -- Builds expression Si'First, where I is the value given. + -- Builds expression Si'First, where I is the value given function S_Last (I : Nat) return Node_Id; - -- Builds expression Si'Last, where I is the value given. + -- Builds expression Si'Last, where I is the value given function S_Length (I : Nat) return Node_Id; - -- Builds expression Si'Length, where I is the value given. + -- Builds expression Si'Length, where I is the value given function S_Length_Test (I : Nat) return Node_Id; - -- Builds expression Si'Length /= 0, where I is the value given. + -- Builds expression Si'Length /= 0, where I is the value given ------------------- -- Copy_Into_R_S -- @@ -3957,8 +3957,8 @@ package body Exp_Ch4 is -- Lhs of equality if Nkind (Lhs) = N_Selected_Component - and then Has_Per_Object_Constraint ( - Entity (Selector_Name (Lhs))) + and then Has_Per_Object_Constraint + (Entity (Selector_Name (Lhs))) then -- Enclosing record is an Unchecked_Union, use formal A @@ -3977,11 +3977,11 @@ package body Exp_Ch4 is Make_Selected_Component (Loc, Prefix => Prefix (Lhs), Selector_Name => - New_Copy (Get_Discriminant_Value ( - First_Discriminant (Lhs_Type), - Lhs_Type, - Stored_Constraint (Lhs_Type)))); - + New_Copy + (Get_Discriminant_Value + (First_Discriminant (Lhs_Type), + Lhs_Type, + Stored_Constraint (Lhs_Type)))); end if; -- Comment needed here ??? @@ -3990,21 +3990,21 @@ package body Exp_Ch4 is -- Infer the discriminant value Lhs_Discr_Val := - New_Copy (Get_Discriminant_Value ( - First_Discriminant (Lhs_Type), - Lhs_Type, - Stored_Constraint (Lhs_Type))); - + New_Copy + (Get_Discriminant_Value + (First_Discriminant (Lhs_Type), + Lhs_Type, + Stored_Constraint (Lhs_Type))); end if; -- Rhs of equality if Nkind (Rhs) = N_Selected_Component - and then Has_Per_Object_Constraint ( - Entity (Selector_Name (Rhs))) + and then Has_Per_Object_Constraint + (Entity (Selector_Name (Rhs))) then - if Is_Unchecked_Union (Scope - (Entity (Selector_Name (Rhs)))) + if Is_Unchecked_Union + (Scope (Entity (Selector_Name (Rhs)))) then Rhs_Discr_Val := Make_Identifier (Loc, @@ -4260,12 +4260,15 @@ package body Exp_Ch4 is elsif Is_Bit_Packed_Array (Typl) then Expand_Packed_Eq (N); - -- For non-floating-point elementary types, the primitive equality - -- always applies, and block-bit comparison is fine. Floating-point - -- is an exception because of negative zeroes. + -- Where the component type is elementary we can use a block bit + -- comparison (if supported on the target) exception in the case + -- of floating-point (negative zero issues require element by + -- element comparison), and atomic types (where we must be sure + -- to load elements independently). elsif Is_Elementary_Type (Component_Type (Typl)) and then not Is_Floating_Point_Type (Component_Type (Typl)) + and then not Is_Atomic (Component_Type (Typl)) and then Support_Composite_Compare_On_Target then null; @@ -4337,7 +4340,6 @@ package body Exp_Ch4 is end if; Prim := First_Elmt (Primitive_Operations (Typl)); - while Present (Prim) loop exit when Chars (Node (Prim)) = Name_Op_Eq and then Etype (First_Formal (Node (Prim))) = @@ -5299,7 +5301,7 @@ package body Exp_Ch4 is Build_Boolean_Array_Proc_Call (Parent (N), Opnd, Empty); return; - -- Special case the negation of a binary operation. + -- Special case the negation of a binary operation elsif (Nkind (Opnd) = N_Op_And or else Nkind (Opnd) = N_Op_Or @@ -5324,14 +5326,14 @@ package body Exp_Ch4 is if N = Op1 and then Nkind (Op2) = N_Op_Not then - -- (not A) op (not B) can be reduced to a single call. + -- (not A) op (not B) can be reduced to a single call return; elsif N = Op2 and then Nkind (Parent (N)) = N_Op_Xor then - -- A xor (not B) can also be special-cased. + -- A xor (not B) can also be special-cased return; end if; @@ -6878,7 +6880,9 @@ package body Exp_Ch4 is -- only if Conversion_OK is set, i.e. if the fixed-point values -- are to be treated as integers. - -- No other conversions should be passed to Gigi. + -- No other conversions should be passed to Gigi + + -- Check: are these rules stated in sinfo??? if so, why restate here??? -- The only remaining step is to generate a range check if we still -- have a type conversion at this stage and Do_Range_Check is set. @@ -7867,7 +7871,7 @@ package body Exp_Ch4 is -- is safe. The operand can be empty in the case of negation. function Is_Unaliased (N : Node_Id) return Boolean; - -- Check that N is a stand-alone entity. + -- Check that N is a stand-alone entity ------------------ -- Is_Unaliased -- diff --git a/gcc/ada/exp_ch5.adb b/gcc/ada/exp_ch5.adb index 1d982eeea4b..198d216b7b8 100644 --- a/gcc/ada/exp_ch5.adb +++ b/gcc/ada/exp_ch5.adb @@ -330,6 +330,24 @@ package body Exp_Ch5 is elsif Has_Controlled_Component (L_Type) then Loop_Required := True; + -- If object is atomic, we cannot tolerate a loop + + elsif Is_Atomic_Object (Act_Lhs) + or else + Is_Atomic_Object (Act_Rhs) + then + return; + + -- Loop is required if we have atomic components since we have to + -- be sure to do any accesses on an element by element basis. + + elsif Has_Atomic_Components (L_Type) + or else Has_Atomic_Components (R_Type) + or else Is_Atomic (Component_Type (L_Type)) + or else Is_Atomic (Component_Type (R_Type)) + then + Loop_Required := True; + -- Case where no slice is involved elsif not L_Slice and not R_Slice then