Make_Selected_Component (Loc,
Prefix => New_Reference_To (Temp, Loc),
Selector_Name =>
- New_Reference_To (Tag_Component (T), Loc)),
+ New_Reference_To (First_Tag_Component (T), Loc)),
Expression =>
Unchecked_Convert_To (RTE (RE_Tag),
- New_Reference_To (Access_Disp_Table (T), Loc)));
+ New_Reference_To
+ (Elists.Node (First_Elmt (Access_Disp_Table (T))),
+ Loc)));
-- The previous assignment has to be done in any case
Make_Selected_Component (Loc,
Prefix => Ref,
Selector_Name =>
- New_Reference_To (Tag_Component (Utyp), Loc)),
+ New_Reference_To (First_Tag_Component (Utyp), Loc)),
Expression =>
Unchecked_Convert_To (RTE (RE_Tag),
New_Reference_To (
- Access_Disp_Table (Utyp), Loc)));
+ Elists.Node (First_Elmt (Access_Disp_Table (Utyp))),
+ Loc)));
Set_Assignment_OK (Name (Tag_Assign));
Insert_Action (N, Tag_Assign);
Test := Expand_Composite_Equality
(Nod, Component_Type (Typ), L, R, Decls);
- -- If some (sub)component is an unchecked_union, the whole
- -- operation will raise program error.
+ -- If some (sub)component is an unchecked_union, the whole operation
+ -- will raise program error.
if Nkind (Test) = N_Raise_Program_Error then
+
+ -- This node is going to be inserted at a location where a
+ -- statement is expected: clear its Etype so analysis will
+ -- set it to the expected Standard_Void_Type.
+
+ Set_Etype (Test, Empty);
return Test;
else
Handle_One_Dimension (N + 1, Next_Index (Index)));
if Need_Separate_Indexes then
+
-- Generate guard for loop, followed by increments of indices
Append_To (Stm_List,
Expressions => New_List (New_Reference_To (Bn, Loc)))));
end if;
- -- If separate indexes, we need a declare block for An and Bn,
- -- and a loop without an iteration scheme.
+ -- If separate indexes, we need a declare block for An and Bn, and a
+ -- loop without an iteration scheme.
if Need_Separate_Indexes then
Loop_Stm :=
Typ : constant Entity_Id := Etype (N);
begin
- if Is_Bit_Packed_Array (Typ) then
+ -- Special case of bit packed array where both operands are known
+ -- to be properly aligned. In this case we use an efficient run time
+ -- routine to carry out the operation (see System.Bit_Ops).
+
+ if Is_Bit_Packed_Array (Typ)
+ and then not Is_Possibly_Unaligned_Object (Left_Opnd (N))
+ and then not Is_Possibly_Unaligned_Object (Right_Opnd (N))
+ then
Expand_Packed_Boolean_Operator (N);
+ return;
+ end if;
- else
- -- For the normal non-packed case, the general expansion is
- -- to build a function for carrying out the comparison (using
- -- Make_Boolean_Array_Op) and then inserting it into the tree.
- -- The original operator node is then rewritten as a call to
- -- this function.
+ -- For the normal non-packed case, the general expansion is to build
+ -- function for carrying out the comparison (use Make_Boolean_Array_Op)
+ -- and then inserting it into the tree. The original operator node is
+ -- then rewritten as a call to this function. We also use this in the
+ -- packed case if either operand is a possibly unaligned object.
- declare
- Loc : constant Source_Ptr := Sloc (N);
- L : constant Node_Id := Relocate_Node (Left_Opnd (N));
- R : constant Node_Id := Relocate_Node (Right_Opnd (N));
- Func_Body : Node_Id;
- Func_Name : Entity_Id;
+ declare
+ Loc : constant Source_Ptr := Sloc (N);
+ L : constant Node_Id := Relocate_Node (Left_Opnd (N));
+ R : constant Node_Id := Relocate_Node (Right_Opnd (N));
+ Func_Body : Node_Id;
+ Func_Name : Entity_Id;
- begin
- Convert_To_Actual_Subtype (L);
- Convert_To_Actual_Subtype (R);
- Ensure_Defined (Etype (L), N);
- Ensure_Defined (Etype (R), N);
- Apply_Length_Check (R, Etype (L));
-
- if Nkind (Parent (N)) = N_Assignment_Statement
- and then Safe_In_Place_Array_Op (Name (Parent (N)), L, R)
- then
- Build_Boolean_Array_Proc_Call (Parent (N), L, R);
+ begin
+ Convert_To_Actual_Subtype (L);
+ Convert_To_Actual_Subtype (R);
+ Ensure_Defined (Etype (L), N);
+ Ensure_Defined (Etype (R), N);
+ Apply_Length_Check (R, Etype (L));
+
+ if Nkind (Parent (N)) = N_Assignment_Statement
+ and then Safe_In_Place_Array_Op (Name (Parent (N)), L, R)
+ then
+ Build_Boolean_Array_Proc_Call (Parent (N), L, R);
- elsif Nkind (Parent (N)) = N_Op_Not
- and then Nkind (N) = N_Op_And
- and then
- Safe_In_Place_Array_Op (Name (Parent (Parent (N))), L, R)
- then
- return;
- else
+ elsif Nkind (Parent (N)) = N_Op_Not
+ and then Nkind (N) = N_Op_And
+ and then
+ Safe_In_Place_Array_Op (Name (Parent (Parent (N))), L, R)
+ then
+ return;
+ else
- Func_Body := Make_Boolean_Array_Op (Etype (L), N);
- Func_Name := Defining_Unit_Name (Specification (Func_Body));
- Insert_Action (N, Func_Body);
+ Func_Body := Make_Boolean_Array_Op (Etype (L), N);
+ Func_Name := Defining_Unit_Name (Specification (Func_Body));
+ Insert_Action (N, Func_Body);
- -- Now rewrite the expression with a call
+ -- Now rewrite the expression with a call
- Rewrite (N,
- Make_Function_Call (Loc,
- Name => New_Reference_To (Func_Name, Loc),
- Parameter_Associations =>
- New_List
- (L, Make_Type_Conversion
- (Loc, New_Reference_To (Etype (L), Loc), R))));
+ Rewrite (N,
+ Make_Function_Call (Loc,
+ Name => New_Reference_To (Func_Name, Loc),
+ Parameter_Associations =>
+ New_List (
+ L,
+ Make_Type_Conversion
+ (Loc, New_Reference_To (Etype (L), Loc), R))));
- Analyze_And_Resolve (N, Typ);
- end if;
- end;
- end if;
+ Analyze_And_Resolve (N, Typ);
+ end if;
+ end;
end Expand_Boolean_Operator;
-------------------------------
(Typ : Node_Id) return Boolean
is
Tdef : constant Node_Id :=
- Type_Definition (Declaration_Node (Typ));
+ Type_Definition (Declaration_Node (Base_Type (Typ)));
Clist : Node_Id;
Vpart : Node_Id;
Force_Validity_Checks := Save_Force_Validity_Checks;
end;
- -- Packed case
+ -- Packed case where both operands are known aligned
- elsif Is_Bit_Packed_Array (Typl) then
+ elsif Is_Bit_Packed_Array (Typl)
+ and then not Is_Possibly_Unaligned_Object (Lhs)
+ and then not Is_Possibly_Unaligned_Object (Rhs)
+ then
Expand_Packed_Eq (N);
-- 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).
+ -- to load elements independently) and possibly unaligned arrays.
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 not Is_Possibly_Unaligned_Object (Lhs)
+ and then not Is_Possibly_Unaligned_Object (Rhs)
and then Support_Composite_Compare_On_Target
then
null;
return;
end if;
- -- Case of array operand. If bit packed, handle it in Exp_Pakd
+ -- Case of array operand. If bit packed with a component size of 1,
+ -- handle it in Exp_Pakd if the operand is known to be aligned.
- if Is_Bit_Packed_Array (Typ) and then Component_Size (Typ) = 1 then
+ if Is_Bit_Packed_Array (Typ)
+ and then Component_Size (Typ) = 1
+ and then not Is_Possibly_Unaligned_Object (Right_Opnd (N))
+ then
Expand_Packed_Not (N);
return;
end if;
Obj_Tag :=
Make_Selected_Component (Loc,
Prefix => Relocate_Node (Left),
- Selector_Name => New_Reference_To (Tag_Component (Left_Type), Loc));
+ Selector_Name =>
+ New_Reference_To (First_Tag_Component (Left_Type), Loc));
if Is_Class_Wide_Type (Right_Type) then
return
Action => CW_Membership,
Args => New_List (
Obj_Tag,
- New_Reference_To (
- Access_Disp_Table (Root_Type (Right_Type)), Loc)));
+ New_Reference_To
+ (Node (First_Elmt
+ (Access_Disp_Table (Root_Type (Right_Type)))),
+ Loc)));
else
return
Make_Op_Eq (Loc,
Left_Opnd => Obj_Tag,
Right_Opnd =>
- New_Reference_To (Access_Disp_Table (Right_Type), Loc));
+ New_Reference_To
+ (Node (First_Elmt (Access_Disp_Table (Right_Type))), Loc));
end if;
end Tagged_Membership;
OSDN Git Service
