OpenE2K/gcc
2
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

exp_ch4.adb (Expand_N_Op_Eq): Make sure we expand a loop for array compares if the component is atomic.

Browse Source 
2004-10-26  Robert Dewar  <dewar@gnat.com>

	* 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
This commit is contained in:
Robert Dewar 2004-10-27 15:01:38 +02:00 committed by Arnaud Charlet
parent 6f639c9866
commit 5e1c00fac7
2 changed files with 67 additions and 45 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

86
gcc/ada/exp_ch4.adb
View File

@ -250,7 +250,7 @@ package body Exp_Ch4 is
if Kind = N_Op_Not then if Kind = N_Op_Not then
if Nkind (Op1) in N_Binary_Op 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 if Nkind (Op1) = N_Op_And then
Proc_Name := RTE (RE_Vector_Nand); Proc_Name := RTE (RE_Vector_Nand);
@ -428,7 +428,7 @@ package body Exp_Ch4 is
if Controlled_Type (T) if Controlled_Type (T)
and then Ekind (PtrT) = E_Anonymous_Access_Type and then Ekind (PtrT) = E_Anonymous_Access_Type
then 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); Flist := Get_Allocator_Final_List (N, Base_Type (T), PtrT);
end if; end if;
@ -535,7 +535,7 @@ package body Exp_Ch4 is
if Controlled_Type (T) if Controlled_Type (T)
and then Ekind (PtrT) = E_Anonymous_Access_Type and then Ekind (PtrT) = E_Anonymous_Access_Type
then then
-- Create local finalization list for access parameter. -- Create local finalization list for access parameter
Flist := Flist :=
Get_Allocator_Final_List (N, Base_Type (T), PtrT); Get_Allocator_Final_List (N, Base_Type (T), PtrT);
@ -964,7 +964,7 @@ package body Exp_Ch4 is
(Arr : Entity_Id; (Arr : Entity_Id;
Nam : Name_Id; Nam : Name_Id;
Num : Int) return Node_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; function Component_Equality (Typ : Entity_Id) return Node_Id;
-- Create one statement to compare corresponding components, -- Create one statement to compare corresponding components,
@ -1152,7 +1152,7 @@ package body Exp_Ch4 is
Handle_One_Dimension (N + 1, Next_Index (Index))); Handle_One_Dimension (N + 1, Next_Index (Index)));
if Need_Separate_Indexes then 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, Append_To (Stm_List,
Make_Exit_Statement (Loc, Make_Exit_Statement (Loc,
@ -1852,48 +1852,48 @@ package body Exp_Ch4 is
-- L := Si'First; otherwise (where I is the input param given) -- L := Si'First; otherwise (where I is the input param given)
function H return Node_Id; function H return Node_Id;
-- Builds reference to identifier H. -- Builds reference to identifier H
function Ind_Val (E : Node_Id) return Node_Id; function Ind_Val (E : Node_Id) return Node_Id;
-- Builds expression Ind_Typ'Val (E); -- Builds expression Ind_Typ'Val (E);
function L return Node_Id; function L return Node_Id;
-- Builds reference to identifier L. -- Builds reference to identifier L
function L_Pos return Node_Id; function L_Pos return Node_Id;
-- Builds expression Integer_Type'(Ind_Typ'Pos (L)). -- Builds expression Integer_Type'(Ind_Typ'Pos (L)). We qualify the
-- We qualify the expression to avoid universal_integer computations -- expression to avoid universal_integer computations whenever possible,
-- whenever possible, in the expression for the upper bound H. -- in the expression for the upper bound H.
function L_Succ return Node_Id; function L_Succ return Node_Id;
-- Builds expression Ind_Typ'Succ (L). -- Builds expression Ind_Typ'Succ (L)
function One return Node_Id; function One return Node_Id;
-- Builds integer literal one. -- Builds integer literal one
function P return Node_Id; function P return Node_Id;
-- Builds reference to identifier P. -- Builds reference to identifier P
function P_Succ return Node_Id; function P_Succ return Node_Id;
-- Builds expression Ind_Typ'Succ (P). -- Builds expression Ind_Typ'Succ (P)
function R return Node_Id; function R return Node_Id;
-- Builds reference to identifier R. -- Builds reference to identifier R
function S (I : Nat) return Node_Id; 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; 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; 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; 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; 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 -- -- Copy_Into_R_S --
@ -3957,8 +3957,8 @@ package body Exp_Ch4 is
-- Lhs of equality -- Lhs of equality
if Nkind (Lhs) = N_Selected_Component if Nkind (Lhs) = N_Selected_Component
and then Has_Per_Object_Constraint ( and then Has_Per_Object_Constraint
Entity (Selector_Name (Lhs))) (Entity (Selector_Name (Lhs)))
then then
-- Enclosing record is an Unchecked_Union, use formal A -- Enclosing record is an Unchecked_Union, use formal A
@ -3977,11 +3977,11 @@ package body Exp_Ch4 is
Make_Selected_Component (Loc, Make_Selected_Component (Loc,
Prefix => Prefix (Lhs), Prefix => Prefix (Lhs),
Selector_Name => Selector_Name =>
New_Copy (Get_Discriminant_Value ( New_Copy
First_Discriminant (Lhs_Type), (Get_Discriminant_Value
(First_Discriminant (Lhs_Type),
Lhs_Type, Lhs_Type,
Stored_Constraint (Lhs_Type)))); Stored_Constraint (Lhs_Type))));
end if; end if;
-- Comment needed here ??? -- Comment needed here ???
@ -3990,21 +3990,21 @@ package body Exp_Ch4 is
-- Infer the discriminant value -- Infer the discriminant value
Lhs_Discr_Val := Lhs_Discr_Val :=
New_Copy (Get_Discriminant_Value ( New_Copy
First_Discriminant (Lhs_Type), (Get_Discriminant_Value
(First_Discriminant (Lhs_Type),
Lhs_Type, Lhs_Type,
Stored_Constraint (Lhs_Type))); Stored_Constraint (Lhs_Type)));
end if; end if;
-- Rhs of equality -- Rhs of equality
if Nkind (Rhs) = N_Selected_Component if Nkind (Rhs) = N_Selected_Component
and then Has_Per_Object_Constraint ( and then Has_Per_Object_Constraint
Entity (Selector_Name (Rhs))) (Entity (Selector_Name (Rhs)))
then then
if Is_Unchecked_Union (Scope if Is_Unchecked_Union
(Entity (Selector_Name (Rhs)))) (Scope (Entity (Selector_Name (Rhs))))
then then
Rhs_Discr_Val := Rhs_Discr_Val :=
Make_Identifier (Loc, Make_Identifier (Loc,
@ -4260,12 +4260,15 @@ package body Exp_Ch4 is
elsif Is_Bit_Packed_Array (Typl) then elsif Is_Bit_Packed_Array (Typl) then
Expand_Packed_Eq (N); Expand_Packed_Eq (N);
-- For non-floating-point elementary types, the primitive equality -- Where the component type is elementary we can use a block bit
-- always applies, and block-bit comparison is fine. Floating-point -- comparison (if supported on the target) exception in the case
-- is an exception because of negative zeroes. -- 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)) elsif Is_Elementary_Type (Component_Type (Typl))
and then not Is_Floating_Point_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 and then Support_Composite_Compare_On_Target
then then
null; null;
@ -4337,7 +4340,6 @@ package body Exp_Ch4 is
end if; end if;
Prim := First_Elmt (Primitive_Operations (Typl)); Prim := First_Elmt (Primitive_Operations (Typl));
while Present (Prim) loop while Present (Prim) loop
exit when Chars (Node (Prim)) = Name_Op_Eq exit when Chars (Node (Prim)) = Name_Op_Eq
and then Etype (First_Formal (Node (Prim))) = 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); Build_Boolean_Array_Proc_Call (Parent (N), Opnd, Empty);
return; return;
-- Special case the negation of a binary operation. -- Special case the negation of a binary operation
elsif (Nkind (Opnd) = N_Op_And elsif (Nkind (Opnd) = N_Op_And
or else Nkind (Opnd) = N_Op_Or or else Nkind (Opnd) = N_Op_Or
@ -5324,14 +5326,14 @@ package body Exp_Ch4 is
if N = Op1 if N = Op1
and then Nkind (Op2) = N_Op_Not and then Nkind (Op2) = N_Op_Not
then 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; return;
elsif N = Op2 elsif N = Op2
and then Nkind (Parent (N)) = N_Op_Xor and then Nkind (Parent (N)) = N_Op_Xor
then then
-- A xor (not B) can also be special-cased. -- A xor (not B) can also be special-cased
return; return;
end if; end if;
@ -6878,7 +6880,9 @@ package body Exp_Ch4 is
-- only if Conversion_OK is set, i.e. if the fixed-point values -- only if Conversion_OK is set, i.e. if the fixed-point values
-- are to be treated as integers. -- 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 -- 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. -- 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. -- is safe. The operand can be empty in the case of negation.
function Is_Unaliased (N : Node_Id) return Boolean; 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 -- -- Is_Unaliased --

18
gcc/ada/exp_ch5.adb
View File

@ -330,6 +330,24 @@ package body Exp_Ch5 is
elsif Has_Controlled_Component (L_Type) then elsif Has_Controlled_Component (L_Type) then
Loop_Required := True; 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 -- Case where no slice is involved
elsif not L_Slice and not R_Slice then elsif not L_Slice and not R_Slice then