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 <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
Arnaud Charlet
parent
6f639c9866
commit
5e1c00fac7
@ -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 --
|
||||
|
||||
@ -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
|
||||
|
||||
Loading…
Reference in New Issue
Block a user