-- --
-- B o d y --
-- --
--- Copyright (C) 1992-2013, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2019, Free Software Foundation, Inc. --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
with Exp_Dbug; use Exp_Dbug;
with Exp_Util; use Exp_Util;
with Layout; use Layout;
+with Lib.Xref; use Lib.Xref;
with Namet; use Namet;
with Nlists; use Nlists;
with Nmake; use Nmake;
with Opt; use Opt;
-with Rtsfind; use Rtsfind;
with Sem; use Sem;
with Sem_Aux; use Sem_Aux;
with Sem_Ch3; use Sem_Ch3;
-- right rotate into a left rotate, avoiding the subtract, if the machine
-- architecture provides such an instruction.
- ----------------------------------------------
- -- Entity Tables for Packed Access Routines --
- ----------------------------------------------
-
- -- For the cases of component size = 3,5-7,9-15,17-31,33-63 we call library
- -- routines. This table provides the entity for the proper routine.
-
- type E_Array is array (Int range 01 .. 63) of RE_Id;
-
- -- Array of Bits_nn entities. Note that we do not use library routines
- -- for the 8-bit and 16-bit cases, but we still fill in the table, using
- -- entries from System.Unsigned, because we also use this table for
- -- certain special unchecked conversions in the big-endian case.
-
- Bits_Id : constant E_Array :=
- (01 => RE_Bits_1,
- 02 => RE_Bits_2,
- 03 => RE_Bits_03,
- 04 => RE_Bits_4,
- 05 => RE_Bits_05,
- 06 => RE_Bits_06,
- 07 => RE_Bits_07,
- 08 => RE_Unsigned_8,
- 09 => RE_Bits_09,
- 10 => RE_Bits_10,
- 11 => RE_Bits_11,
- 12 => RE_Bits_12,
- 13 => RE_Bits_13,
- 14 => RE_Bits_14,
- 15 => RE_Bits_15,
- 16 => RE_Unsigned_16,
- 17 => RE_Bits_17,
- 18 => RE_Bits_18,
- 19 => RE_Bits_19,
- 20 => RE_Bits_20,
- 21 => RE_Bits_21,
- 22 => RE_Bits_22,
- 23 => RE_Bits_23,
- 24 => RE_Bits_24,
- 25 => RE_Bits_25,
- 26 => RE_Bits_26,
- 27 => RE_Bits_27,
- 28 => RE_Bits_28,
- 29 => RE_Bits_29,
- 30 => RE_Bits_30,
- 31 => RE_Bits_31,
- 32 => RE_Unsigned_32,
- 33 => RE_Bits_33,
- 34 => RE_Bits_34,
- 35 => RE_Bits_35,
- 36 => RE_Bits_36,
- 37 => RE_Bits_37,
- 38 => RE_Bits_38,
- 39 => RE_Bits_39,
- 40 => RE_Bits_40,
- 41 => RE_Bits_41,
- 42 => RE_Bits_42,
- 43 => RE_Bits_43,
- 44 => RE_Bits_44,
- 45 => RE_Bits_45,
- 46 => RE_Bits_46,
- 47 => RE_Bits_47,
- 48 => RE_Bits_48,
- 49 => RE_Bits_49,
- 50 => RE_Bits_50,
- 51 => RE_Bits_51,
- 52 => RE_Bits_52,
- 53 => RE_Bits_53,
- 54 => RE_Bits_54,
- 55 => RE_Bits_55,
- 56 => RE_Bits_56,
- 57 => RE_Bits_57,
- 58 => RE_Bits_58,
- 59 => RE_Bits_59,
- 60 => RE_Bits_60,
- 61 => RE_Bits_61,
- 62 => RE_Bits_62,
- 63 => RE_Bits_63);
-
- -- Array of Get routine entities. These are used to obtain an element from
- -- a packed array. The N'th entry is used to obtain elements from a packed
- -- array whose component size is N. RE_Null is used as a null entry, for
- -- the cases where a library routine is not used.
-
- Get_Id : constant E_Array :=
- (01 => RE_Null,
- 02 => RE_Null,
- 03 => RE_Get_03,
- 04 => RE_Null,
- 05 => RE_Get_05,
- 06 => RE_Get_06,
- 07 => RE_Get_07,
- 08 => RE_Null,
- 09 => RE_Get_09,
- 10 => RE_Get_10,
- 11 => RE_Get_11,
- 12 => RE_Get_12,
- 13 => RE_Get_13,
- 14 => RE_Get_14,
- 15 => RE_Get_15,
- 16 => RE_Null,
- 17 => RE_Get_17,
- 18 => RE_Get_18,
- 19 => RE_Get_19,
- 20 => RE_Get_20,
- 21 => RE_Get_21,
- 22 => RE_Get_22,
- 23 => RE_Get_23,
- 24 => RE_Get_24,
- 25 => RE_Get_25,
- 26 => RE_Get_26,
- 27 => RE_Get_27,
- 28 => RE_Get_28,
- 29 => RE_Get_29,
- 30 => RE_Get_30,
- 31 => RE_Get_31,
- 32 => RE_Null,
- 33 => RE_Get_33,
- 34 => RE_Get_34,
- 35 => RE_Get_35,
- 36 => RE_Get_36,
- 37 => RE_Get_37,
- 38 => RE_Get_38,
- 39 => RE_Get_39,
- 40 => RE_Get_40,
- 41 => RE_Get_41,
- 42 => RE_Get_42,
- 43 => RE_Get_43,
- 44 => RE_Get_44,
- 45 => RE_Get_45,
- 46 => RE_Get_46,
- 47 => RE_Get_47,
- 48 => RE_Get_48,
- 49 => RE_Get_49,
- 50 => RE_Get_50,
- 51 => RE_Get_51,
- 52 => RE_Get_52,
- 53 => RE_Get_53,
- 54 => RE_Get_54,
- 55 => RE_Get_55,
- 56 => RE_Get_56,
- 57 => RE_Get_57,
- 58 => RE_Get_58,
- 59 => RE_Get_59,
- 60 => RE_Get_60,
- 61 => RE_Get_61,
- 62 => RE_Get_62,
- 63 => RE_Get_63);
-
- -- Array of Get routine entities to be used in the case where the packed
- -- array is itself a component of a packed structure, and therefore may not
- -- be fully aligned. This only affects the even sizes, since for the odd
- -- sizes, we do not get any fixed alignment in any case.
-
- GetU_Id : constant E_Array :=
- (01 => RE_Null,
- 02 => RE_Null,
- 03 => RE_Get_03,
- 04 => RE_Null,
- 05 => RE_Get_05,
- 06 => RE_GetU_06,
- 07 => RE_Get_07,
- 08 => RE_Null,
- 09 => RE_Get_09,
- 10 => RE_GetU_10,
- 11 => RE_Get_11,
- 12 => RE_GetU_12,
- 13 => RE_Get_13,
- 14 => RE_GetU_14,
- 15 => RE_Get_15,
- 16 => RE_Null,
- 17 => RE_Get_17,
- 18 => RE_GetU_18,
- 19 => RE_Get_19,
- 20 => RE_GetU_20,
- 21 => RE_Get_21,
- 22 => RE_GetU_22,
- 23 => RE_Get_23,
- 24 => RE_GetU_24,
- 25 => RE_Get_25,
- 26 => RE_GetU_26,
- 27 => RE_Get_27,
- 28 => RE_GetU_28,
- 29 => RE_Get_29,
- 30 => RE_GetU_30,
- 31 => RE_Get_31,
- 32 => RE_Null,
- 33 => RE_Get_33,
- 34 => RE_GetU_34,
- 35 => RE_Get_35,
- 36 => RE_GetU_36,
- 37 => RE_Get_37,
- 38 => RE_GetU_38,
- 39 => RE_Get_39,
- 40 => RE_GetU_40,
- 41 => RE_Get_41,
- 42 => RE_GetU_42,
- 43 => RE_Get_43,
- 44 => RE_GetU_44,
- 45 => RE_Get_45,
- 46 => RE_GetU_46,
- 47 => RE_Get_47,
- 48 => RE_GetU_48,
- 49 => RE_Get_49,
- 50 => RE_GetU_50,
- 51 => RE_Get_51,
- 52 => RE_GetU_52,
- 53 => RE_Get_53,
- 54 => RE_GetU_54,
- 55 => RE_Get_55,
- 56 => RE_GetU_56,
- 57 => RE_Get_57,
- 58 => RE_GetU_58,
- 59 => RE_Get_59,
- 60 => RE_GetU_60,
- 61 => RE_Get_61,
- 62 => RE_GetU_62,
- 63 => RE_Get_63);
-
- -- Array of Set routine entities. These are used to assign an element of a
- -- packed array. The N'th entry is used to assign elements for a packed
- -- array whose component size is N. RE_Null is used as a null entry, for
- -- the cases where a library routine is not used.
-
- Set_Id : constant E_Array :=
- (01 => RE_Null,
- 02 => RE_Null,
- 03 => RE_Set_03,
- 04 => RE_Null,
- 05 => RE_Set_05,
- 06 => RE_Set_06,
- 07 => RE_Set_07,
- 08 => RE_Null,
- 09 => RE_Set_09,
- 10 => RE_Set_10,
- 11 => RE_Set_11,
- 12 => RE_Set_12,
- 13 => RE_Set_13,
- 14 => RE_Set_14,
- 15 => RE_Set_15,
- 16 => RE_Null,
- 17 => RE_Set_17,
- 18 => RE_Set_18,
- 19 => RE_Set_19,
- 20 => RE_Set_20,
- 21 => RE_Set_21,
- 22 => RE_Set_22,
- 23 => RE_Set_23,
- 24 => RE_Set_24,
- 25 => RE_Set_25,
- 26 => RE_Set_26,
- 27 => RE_Set_27,
- 28 => RE_Set_28,
- 29 => RE_Set_29,
- 30 => RE_Set_30,
- 31 => RE_Set_31,
- 32 => RE_Null,
- 33 => RE_Set_33,
- 34 => RE_Set_34,
- 35 => RE_Set_35,
- 36 => RE_Set_36,
- 37 => RE_Set_37,
- 38 => RE_Set_38,
- 39 => RE_Set_39,
- 40 => RE_Set_40,
- 41 => RE_Set_41,
- 42 => RE_Set_42,
- 43 => RE_Set_43,
- 44 => RE_Set_44,
- 45 => RE_Set_45,
- 46 => RE_Set_46,
- 47 => RE_Set_47,
- 48 => RE_Set_48,
- 49 => RE_Set_49,
- 50 => RE_Set_50,
- 51 => RE_Set_51,
- 52 => RE_Set_52,
- 53 => RE_Set_53,
- 54 => RE_Set_54,
- 55 => RE_Set_55,
- 56 => RE_Set_56,
- 57 => RE_Set_57,
- 58 => RE_Set_58,
- 59 => RE_Set_59,
- 60 => RE_Set_60,
- 61 => RE_Set_61,
- 62 => RE_Set_62,
- 63 => RE_Set_63);
-
- -- Array of Set routine entities to be used in the case where the packed
- -- array is itself a component of a packed structure, and therefore may not
- -- be fully aligned. This only affects the even sizes, since for the odd
- -- sizes, we do not get any fixed alignment in any case.
-
- SetU_Id : constant E_Array :=
- (01 => RE_Null,
- 02 => RE_Null,
- 03 => RE_Set_03,
- 04 => RE_Null,
- 05 => RE_Set_05,
- 06 => RE_SetU_06,
- 07 => RE_Set_07,
- 08 => RE_Null,
- 09 => RE_Set_09,
- 10 => RE_SetU_10,
- 11 => RE_Set_11,
- 12 => RE_SetU_12,
- 13 => RE_Set_13,
- 14 => RE_SetU_14,
- 15 => RE_Set_15,
- 16 => RE_Null,
- 17 => RE_Set_17,
- 18 => RE_SetU_18,
- 19 => RE_Set_19,
- 20 => RE_SetU_20,
- 21 => RE_Set_21,
- 22 => RE_SetU_22,
- 23 => RE_Set_23,
- 24 => RE_SetU_24,
- 25 => RE_Set_25,
- 26 => RE_SetU_26,
- 27 => RE_Set_27,
- 28 => RE_SetU_28,
- 29 => RE_Set_29,
- 30 => RE_SetU_30,
- 31 => RE_Set_31,
- 32 => RE_Null,
- 33 => RE_Set_33,
- 34 => RE_SetU_34,
- 35 => RE_Set_35,
- 36 => RE_SetU_36,
- 37 => RE_Set_37,
- 38 => RE_SetU_38,
- 39 => RE_Set_39,
- 40 => RE_SetU_40,
- 41 => RE_Set_41,
- 42 => RE_SetU_42,
- 43 => RE_Set_43,
- 44 => RE_SetU_44,
- 45 => RE_Set_45,
- 46 => RE_SetU_46,
- 47 => RE_Set_47,
- 48 => RE_SetU_48,
- 49 => RE_Set_49,
- 50 => RE_SetU_50,
- 51 => RE_Set_51,
- 52 => RE_SetU_52,
- 53 => RE_Set_53,
- 54 => RE_SetU_54,
- 55 => RE_Set_55,
- 56 => RE_SetU_56,
- 57 => RE_Set_57,
- 58 => RE_SetU_58,
- 59 => RE_Set_59,
- 60 => RE_SetU_60,
- 61 => RE_Set_61,
- 62 => RE_SetU_62,
- 63 => RE_Set_63);
-
-----------------------
-- Local Subprograms --
-----------------------
-- Standard.Integer representing the zero-based linear subscript value.
-- This expression includes any required range checks.
+ function Compute_Number_Components
+ (N : Node_Id;
+ Typ : Entity_Id) return Node_Id;
+ -- Build an expression that multiplies the length of the dimensions of the
+ -- array, used to control array equality checks.
+
procedure Convert_To_PAT_Type (Aexp : Node_Id);
-- Given an expression of a packed array type, builds a corresponding
-- expression whose type is the implementation type used to represent
Expr : Node_Id) return Node_Id;
-- The packed array code does unchecked conversions which in some cases
-- may involve non-discrete types with differing sizes. The semantics of
- -- such conversions is potentially endian dependent, and the effect we
- -- want here for such a conversion is to do the conversion in size as
+ -- such conversions is potentially endianness dependent, and the effect
+ -- we want here for such a conversion is to do the conversion in size as
-- though numeric items are involved, and we extend or truncate on the
-- left side. This happens naturally in the little-endian case, but in
-- the big endian case we can get left justification, when what we want
--
-- Atyp is the constrained array type (the actual subtype has been
-- computed if necessary to obtain the constraints, but this is still
- -- the original array type, not the Packed_Array_Type value).
+ -- the original array type, not the Packed_Array_Impl_Type value).
--
-- Obj is the object which is to be indexed. It is always of type Atyp.
--
-- array type on the fly). Such actions are inserted into the tree
-- directly using Insert_Action.
- function Byte_Swap (N : Node_Id) return Node_Id;
- -- Wrap N in a call to a byte swapping function, with appropriate type
- -- conversions.
+ function Revert_Storage_Order (N : Node_Id) return Node_Id;
+ -- Perform appropriate justification and byte ordering adjustments for N,
+ -- an element of a packed array type, when both the component type and
+ -- the enclosing packed array type have reverse scalar storage order.
+ -- On little-endian targets, the value is left justified before byte
+ -- swapping. The Etype of the returned expression is an integer type of
+ -- an appropriate power-of-2 size.
- ---------------
- -- Byte_Swap --
- ---------------
+ --------------------------
+ -- Revert_Storage_Order --
+ --------------------------
- function Byte_Swap (N : Node_Id) return Node_Id is
+ function Revert_Storage_Order (N : Node_Id) return Node_Id is
Loc : constant Source_Ptr := Sloc (N);
T : constant Entity_Id := Etype (N);
+ T_Size : constant Uint := RM_Size (T);
+
Swap_RE : RE_Id;
Swap_F : Entity_Id;
+ Swap_T : Entity_Id;
+ -- Swapping function
+
+ Arg : Node_Id;
+ Adjusted : Node_Id;
+ Shift : Uint;
begin
- pragma Assert (Esize (T) > 8);
-
- if Esize (T) <= 16 then
- Swap_RE := RE_Bswap_16;
- elsif Esize (T) <= 32 then
- Swap_RE := RE_Bswap_32;
- else pragma Assert (Esize (T) <= 64);
- Swap_RE := RE_Bswap_64;
+ if T_Size <= 8 then
+
+ -- Array component size is less than a byte: no swapping needed
+
+ Swap_F := Empty;
+ Swap_T := RTE (RE_Unsigned_8);
+
+ else
+ -- Select byte swapping function depending on array component size
+
+ if T_Size <= 16 then
+ Swap_RE := RE_Bswap_16;
+
+ elsif T_Size <= 32 then
+ Swap_RE := RE_Bswap_32;
+
+ else pragma Assert (T_Size <= 64);
+ Swap_RE := RE_Bswap_64;
+ end if;
+
+ Swap_F := RTE (Swap_RE);
+ Swap_T := Etype (Swap_F);
+
+ end if;
+
+ Shift := Esize (Swap_T) - T_Size;
+
+ Arg := RJ_Unchecked_Convert_To (Swap_T, N);
+
+ if not Bytes_Big_Endian and then Shift > Uint_0 then
+ Arg :=
+ Make_Op_Shift_Left (Loc,
+ Left_Opnd => Arg,
+ Right_Opnd => Make_Integer_Literal (Loc, Shift));
end if;
- Swap_F := RTE (Swap_RE);
+ if Present (Swap_F) then
+ Adjusted :=
+ Make_Function_Call (Loc,
+ Name => New_Occurrence_Of (Swap_F, Loc),
+ Parameter_Associations => New_List (Arg));
+ else
+ Adjusted := Arg;
+ end if;
- return
- Unchecked_Convert_To (T,
- Make_Function_Call (Loc,
- Name => New_Occurrence_Of (Swap_F, Loc),
- Parameter_Associations =>
- New_List (Unchecked_Convert_To (Etype (Swap_F), N))));
- end Byte_Swap;
+ Set_Etype (Adjusted, Swap_T);
+ return Adjusted;
+ end Revert_Storage_Order;
------------------------------
-- Compute_Linear_Subscript --
end loop;
end Compute_Linear_Subscript;
+ -------------------------------
+ -- Compute_Number_Components --
+ -------------------------------
+
+ function Compute_Number_Components
+ (N : Node_Id;
+ Typ : Entity_Id) return Node_Id
+ is
+ Loc : constant Source_Ptr := Sloc (N);
+ Len_Expr : Node_Id;
+
+ begin
+ Len_Expr :=
+ Make_Attribute_Reference (Loc,
+ Attribute_Name => Name_Length,
+ Prefix => New_Occurrence_Of (Typ, Loc),
+ Expressions => New_List (Make_Integer_Literal (Loc, 1)));
+
+ for J in 2 .. Number_Dimensions (Typ) loop
+ Len_Expr :=
+ Make_Op_Multiply (Loc,
+ Left_Opnd => Len_Expr,
+ Right_Opnd =>
+ Make_Attribute_Reference (Loc,
+ Attribute_Name => Name_Length,
+ Prefix => New_Occurrence_Of (Typ, Loc),
+ Expressions => New_List (Make_Integer_Literal (Loc, J))));
+ end loop;
+
+ return Len_Expr;
+ end Compute_Number_Components;
+
-------------------------
-- Convert_To_PAT_Type --
-------------------------
begin
Convert_To_Actual_Subtype (Aexp);
Act_ST := Underlying_Type (Etype (Aexp));
- Create_Packed_Array_Type (Act_ST);
+ Create_Packed_Array_Impl_Type (Act_ST);
-- Just replace the etype with the packed array type. This works because
-- the expression will not be further analyzed, and Gigi considers the
-- more complex packed expressions in actuals is confused. Probably the
-- problem only remains for actuals in calls.
- Set_Etype (Aexp, Packed_Array_Type (Act_ST));
+ Set_Etype (Aexp, Packed_Array_Impl_Type (Act_ST));
if Is_Entity_Name (Aexp)
or else
end if;
end Convert_To_PAT_Type;
- ------------------------------
- -- Create_Packed_Array_Type --
- ------------------------------
+ -----------------------------------
+ -- Create_Packed_Array_Impl_Type --
+ -----------------------------------
- procedure Create_Packed_Array_Type (Typ : Entity_Id) is
+ procedure Create_Packed_Array_Impl_Type (Typ : Entity_Id) is
Loc : constant Source_Ptr := Sloc (Typ);
Ctyp : constant Entity_Id := Component_Type (Typ);
Csize : constant Uint := Component_Size (Typ);
PASize : Uint;
Decl : Node_Id;
PAT : Entity_Id;
- Len_Dim : Node_Id;
Len_Expr : Node_Id;
Len_Bits : Uint;
Bits_U1 : Node_Id;
-- the resulting type as an Itype in the packed array type field of
-- the original type, so that no explicit declaration is required.
- -- Note: the packed type is created in the scope of its parent
- -- type. There are at least some cases where the current scope
- -- is deeper, and so when this is the case, we temporarily reset
- -- the scope for the definition. This is clearly safe, since the
- -- first use of the packed array type will be the implicit
- -- reference from the corresponding unpacked type when it is
- -- elaborated.
+ -- Note: the packed type is created in the scope of its parent type.
+ -- There are at least some cases where the current scope is deeper,
+ -- and so when this is the case, we temporarily reset the scope
+ -- for the definition. This is clearly safe, since the first use
+ -- of the packed array type will be the implicit reference from
+ -- the corresponding unpacked type when it is elaborated.
if Is_Itype (Typ) then
Set_Parent (Decl, Associated_Node_For_Itype (Typ));
end if;
Set_Is_Itype (PAT, True);
- Set_Packed_Array_Type (Typ, PAT);
+ Set_Is_Packed_Array_Impl_Type (PAT, True);
+ Set_Packed_Array_Impl_Type (Typ, PAT);
Analyze (Decl, Suppress => All_Checks);
if Pushed_Scope then
Init_Alignment (PAT);
Set_Parent (PAT, Empty);
Set_Associated_Node_For_Itype (PAT, Typ);
- Set_Is_Packed_Array_Type (PAT, True);
Set_Original_Array_Type (PAT, Typ);
+ -- Propagate representation aspects
+
+ Set_Is_Atomic (PAT, Is_Atomic (Typ));
+ Set_Is_Independent (PAT, Is_Independent (Typ));
+ Set_Is_Volatile (PAT, Is_Volatile (Typ));
+ Set_Is_Volatile_Full_Access (PAT, Is_Volatile_Full_Access (Typ));
+ Set_Treat_As_Volatile (PAT, Treat_As_Volatile (Typ));
+
+ -- For a non-bit-packed array, propagate reverse storage order
+ -- flag from original base type to packed array base type.
+
+ if not Is_Bit_Packed_Array (Typ) then
+ Set_Reverse_Storage_Order
+ (Etype (PAT), Reverse_Storage_Order (Base_Type (Typ)));
+ end if;
+
-- We definitely do not want to delay freezing for packed array
- -- types. This is of particular importance for the itypes that
- -- are generated for record components depending on discriminants
- -- where there is no place to put the freeze node.
+ -- types. This is of particular importance for the itypes that are
+ -- generated for record components depending on discriminants where
+ -- there is no place to put the freeze node.
Set_Has_Delayed_Freeze (PAT, False);
Set_Has_Delayed_Freeze (Etype (PAT), False);
end if;
end Set_PB_Type;
- -- Start of processing for Create_Packed_Array_Type
+ -- Start of processing for Create_Packed_Array_Impl_Type
begin
-- If we already have a packed array type, nothing to do
- if Present (Packed_Array_Type (Typ)) then
+ if Present (Packed_Array_Impl_Type (Typ)) then
return;
end if;
if Present (Ancest)
and then Is_Array_Type (Ancest)
and then Is_Constrained (Ancest)
- and then Present (Packed_Array_Type (Ancest))
+ and then Present (Packed_Array_Impl_Type (Ancest))
then
- Set_Packed_Array_Type (Typ, Packed_Array_Type (Ancest));
+ Set_Packed_Array_Impl_Type (Typ, Packed_Array_Impl_Type (Ancest));
return;
end if;
end if;
-- Natural range Enum_Type'Pos (Enum_Type'First) ..
-- Enum_Type'Pos (Enum_Type'Last);
+ -- Note that tttP is created even if no index subtype is a non
+ -- standard enumeration, because we still need to remove padding
+ -- normally inserted for component alignment.
+
PAT :=
Make_Defining_Identifier (Loc,
Chars => New_External_Name (Chars (Typ), 'P'));
- Set_Packed_Array_Type (Typ, PAT);
-
declare
Indexes : constant List_Id := New_List;
Indx : Node_Id;
Decl :=
Make_Full_Type_Declaration (Loc,
Defining_Identifier => PAT,
- Type_Definition => Typedef);
+ Type_Definition => Typedef);
end;
- -- Set type as packed array type and install it
-
- Set_Is_Packed_Array_Type (PAT);
Install_PAT;
return;
-- a subtype that is equivalent to use Packed_Bytes{1,2,4} as needed.
elsif not Is_Constrained (Typ) then
+
+ -- When generating standard DWARF (i.e when GNAT_Encodings is
+ -- DWARF_GNAT_Encodings_Minimal), the ___XP suffix will be stripped
+ -- by the back-end but generate it anyway to ease compiler debugging.
+ -- This will help to distinguish implementation types from original
+ -- packed arrays.
+
PAT :=
Make_Defining_Identifier (Loc,
- Chars => Make_Packed_Array_Type_Name (Typ, Csize));
+ Chars => Make_Packed_Array_Impl_Type_Name (Typ, Csize));
- Set_Packed_Array_Type (Typ, PAT);
Set_PB_Type;
Decl :=
Make_Subtype_Declaration (Loc,
Defining_Identifier => PAT,
Subtype_Indication => New_Occurrence_Of (PB_Type, Loc));
+
Install_PAT;
return;
-- The name of the packed array subtype is
- -- ttt___Xsss
+ -- ttt___XPsss
-- where sss is the component size in bits and ttt is the name of
-- the parent packed type.
else
PAT :=
Make_Defining_Identifier (Loc,
- Chars => Make_Packed_Array_Type_Name (Typ, Csize));
-
- Set_Packed_Array_Type (Typ, PAT);
+ Chars => Make_Packed_Array_Impl_Type_Name (Typ, Csize));
-- Build an expression for the length of the array in bits.
-- This is the product of the length of each of the dimensions
- declare
- J : Nat := 1;
-
- begin
- Len_Expr := Empty; -- suppress junk warning
-
- loop
- Len_Dim :=
- Make_Attribute_Reference (Loc,
- Attribute_Name => Name_Length,
- Prefix => New_Occurrence_Of (Typ, Loc),
- Expressions => New_List (
- Make_Integer_Literal (Loc, J)));
-
- if J = 1 then
- Len_Expr := Len_Dim;
-
- else
- Len_Expr :=
- Make_Op_Multiply (Loc,
- Left_Opnd => Len_Expr,
- Right_Opnd => Len_Dim);
- end if;
-
- J := J + 1;
- exit when J > Number_Dimensions (Typ);
- end loop;
- end;
+ Len_Expr := Compute_Number_Components (Typ, Typ);
-- Temporarily attach the length expression to the tree and analyze
-- and resolve it, so that we can test its value. We assume that the
Set_Must_Be_On_Byte_Boundary (Typ);
end if;
end if;
- end Create_Packed_Array_Type;
+ end Create_Packed_Array_Impl_Type;
-----------------------------------
-- Expand_Bit_Packed_Element_Set --
Ass_OK : constant Boolean := Assignment_OK (Lhs);
-- Used to preserve assignment OK status when assignment is rewritten
- Rhs : Node_Id := Expression (N);
+ Expr : Node_Id;
+
+ Rhs : Node_Id := Expression (N);
-- Initially Rhs is the right hand side value, it will be replaced
-- later by an appropriate unchecked conversion for the assignment.
-- contains the value. Otherwise Rhs_Val_Known is set False, and
-- the Rhs_Val is undefined.
- Require_Byte_Swapping : Boolean := False;
- -- True if byte swapping required, for the Reverse_Storage_Order case
- -- when the packed array is a free-standing object. (If it is part
- -- of a composite type, and therefore potentially not aligned on a byte
- -- boundary, the swapping is done by the back-end).
-
function Get_Shift return Node_Id;
-- Function used to get the value of Shift, making sure that it
-- gets duplicated if the function is called more than once.
Obj := Relocate_Node (Prefix (Lhs));
Convert_To_Actual_Subtype (Obj);
Atyp := Etype (Obj);
- PAT := Packed_Array_Type (Atyp);
+ PAT := Packed_Array_Impl_Type (Atyp);
Ctyp := Component_Type (Atyp);
Csiz := UI_To_Int (Component_Size (Atyp));
-- If we are building the initialization procedure for a packed array,
-- and Initialize_Scalars is enabled, each component assignment is an
- -- out-of-range value by design. Compile this value without checks,
+ -- out-of-range value by design. Compile this value without checks,
-- because a call to the array init_proc must not raise an exception.
+ -- Condition is not consistent with description above, Within_Init_Proc
+ -- is True also when we are building the IP for a record or protected
+ -- type that has a packed array component???
+
if Within_Init_Proc
and then Initialize_Scalars
then
Analyze_And_Resolve (Rhs, Ctyp);
end if;
- -- For the AAMP target, indexing of certain packed array is passed
- -- through to the back end without expansion, because the expansion
- -- results in very inefficient code on that target. This allows the
- -- GNAAMP back end to generate specialized macros that support more
- -- efficient indexing of packed arrays with components having sizes
- -- that are small powers of two.
+ -- If any of the indices has a nonstandard representation, introduce
+ -- the proper Rep_To_Pos conversion, which in turn will generate index
+ -- checks when needed. We do this on a copy of the index expression,
+ -- rather that rewriting the LHS altogether.
- if AAMP_On_Target
- and then (Csiz = 1 or else Csiz = 2 or else Csiz = 4)
- then
- return;
- end if;
+ Expr := First (Expressions (Lhs));
+ while Present (Expr) loop
+ declare
+ Expr_Typ : constant Entity_Id := Etype (Expr);
+ Loc : constant Source_Ptr := Sloc (Expr);
+
+ Expr_Copy : Node_Id;
+
+ begin
+ if Is_Enumeration_Type (Expr_Typ)
+ and then Has_Non_Standard_Rep (Expr_Typ)
+ then
+ Expr_Copy :=
+ Make_Attribute_Reference (Loc,
+ Prefix => New_Occurrence_Of (Expr_Typ, Loc),
+ Attribute_Name => Name_Pos,
+ Expressions => New_List (Relocate_Node (Expr)));
+ Set_Parent (Expr_Copy, N);
+ Analyze_And_Resolve (Expr_Copy, Standard_Natural);
+ end if;
+ end;
+
+ Next (Expr);
+ end loop;
-- Case of component size 1,2,4 or any component size for the modular
-- case. These are the cases for which we can inline the code.
-- array type on Obj to get lost. So we save the type of Obj, and
-- make sure it is reset properly.
- declare
- T : constant Entity_Id := Etype (Obj);
- begin
- New_Lhs := Duplicate_Subexpr (Obj, True);
- New_Rhs := Duplicate_Subexpr_No_Checks (Obj);
- Set_Etype (Obj, T);
- Set_Etype (New_Lhs, T);
- Set_Etype (New_Rhs, T);
-
- if Reverse_Storage_Order (Base_Type (Atyp))
- and then Esize (T) > 8
- and then not In_Reverse_Storage_Order_Object (Obj)
- then
- Require_Byte_Swapping := True;
- New_Rhs := Byte_Swap (New_Rhs);
- end if;
- end;
+ New_Lhs := Duplicate_Subexpr (Obj, Name_Req => True);
+ New_Rhs := Duplicate_Subexpr_No_Checks (Obj);
-- First we deal with the "and"
-- not a left justified conversion.
Rhs := RJ_Unchecked_Convert_To (Etype (Obj), Rhs);
-
end Fixup_Rhs;
begin
if Nkind (New_Rhs) = N_Op_And then
Set_Paren_Count (New_Rhs, 1);
+ Set_Etype (New_Rhs, Etype (Left_Opnd (New_Rhs)));
end if;
New_Rhs :=
end;
end if;
- if Require_Byte_Swapping then
- Set_Etype (New_Rhs, Etype (Obj));
- New_Rhs := Byte_Swap (New_Rhs);
- end if;
-
-- Now do the rewrite
Rewrite (N,
Set_nn : Entity_Id;
Subscr : Node_Id;
Atyp : Entity_Id;
+ Rev_SSO : Node_Id;
begin
if No (Bits_nn) then
Atyp := Etype (Obj);
Compute_Linear_Subscript (Atyp, Lhs, Subscr);
+ -- Set indication of whether the packed array has reverse SSO
+
+ Rev_SSO :=
+ New_Occurrence_Of
+ (Boolean_Literals (Reverse_Storage_Order (Atyp)), Loc);
+
-- Below we must make the assumption that Obj is
-- at least byte aligned, since otherwise its address
-- cannot be taken. The assumption holds since the
Prefix => Obj,
Attribute_Name => Name_Address),
Subscr,
- Unchecked_Convert_To (Bits_nn,
- Convert_To (Ctyp, Rhs)))));
+ Unchecked_Convert_To (Bits_nn, Convert_To (Ctyp, Rhs)),
+ Rev_SSO)));
end;
end if;
Get_Base_And_Bit_Offset (Prefix (N), Base, Offset);
Rewrite (N,
- Unchecked_Convert_To (Universal_Integer,
+ Unchecked_Convert_To (Standard_Natural,
Make_Op_Mod (Loc,
Left_Opnd => Offset,
Right_Opnd => Make_Integer_Literal (Loc, System_Storage_Unit))));
- Analyze_And_Resolve (N, Universal_Integer);
+ Analyze_And_Resolve (N, Standard_Natural);
end Expand_Packed_Bit_Reference;
------------------------------------
Loc : constant Source_Ptr := Sloc (N);
Typ : constant Entity_Id := Etype (N);
L : constant Node_Id := Relocate_Node (Left_Opnd (N));
- R : constant Node_Id := Relocate_Node (Right_Opnd (N));
+ R : Node_Id := Relocate_Node (Right_Opnd (N));
Ltyp : Entity_Id;
Rtyp : Entity_Id;
-- True .. True where an exception must be raised.
if Nkind (N) = N_Op_Xor then
- Silly_Boolean_Array_Xor_Test (N, Rtyp);
+ R := Duplicate_Subexpr (R);
+ Silly_Boolean_Array_Xor_Test (N, R, Rtyp);
end if;
- -- Now that that silliness is taken care of, get packed array type
+ -- Now that silliness is taken care of, get packed array type
Convert_To_PAT_Type (L);
Convert_To_PAT_Type (R);
Expand_Packed_Element_Reference (Prefix (N));
end if;
+ -- The prefix may be rewritten below as a conversion. If it is a source
+ -- entity generate reference to it now, to prevent spurious warnings
+ -- about unused entities.
+
+ if Is_Entity_Name (Prefix (N))
+ and then Comes_From_Source (Prefix (N))
+ then
+ Generate_Reference (Entity (Prefix (N)), Prefix (N), 'r');
+ end if;
+
-- If not bit packed, we have the enumeration case, which is easily
-- dealt with (just adjust the subscripts of the indexed component)
Obj := Relocate_Node (Prefix (N));
Convert_To_Actual_Subtype (Obj);
Atyp := Etype (Obj);
- PAT := Packed_Array_Type (Atyp);
+ PAT := Packed_Array_Impl_Type (Atyp);
Ctyp := Component_Type (Atyp);
Csiz := UI_To_Int (Component_Size (Atyp));
- -- For the AAMP target, indexing of certain packed array is passed
- -- through to the back end without expansion, because the expansion
- -- results in very inefficient code on that target. This allows the
- -- GNAAMP back end to generate specialized macros that support more
- -- efficient indexing of packed arrays with components having sizes
- -- that are small powers of two.
-
- if AAMP_On_Target
- and then (Csiz = 1 or else Csiz = 2 or else Csiz = 4)
- then
- return;
- end if;
-
-- Case of component size 1,2,4 or any component size for the modular
-- case. These are the cases for which we can inline the code.
Lit := Make_Integer_Literal (Loc, Cmask);
Set_Print_In_Hex (Lit);
- -- Byte swapping required for the Reverse_Storage_Order case, but
- -- only for a free-standing object (see note on Require_Byte_Swapping
- -- in Expand_Bit_Packed_Element_Set).
-
- if Reverse_Storage_Order (Atyp)
- and then Esize (Atyp) > 8
- and then not In_Reverse_Storage_Order_Object (Obj)
- then
- Obj := Byte_Swap (Obj);
- end if;
-
-- We generate a shift right to position the field, followed by a
-- masking operation to extract the bit field, and we finally do an
-- unchecked conversion to convert the result to the required target.
Make_Op_And (Loc,
Left_Opnd => Make_Shift_Right (Obj, Shift),
Right_Opnd => Lit);
+ Set_Etype (Arg, Ctyp);
+
+ -- Component extraction is performed on a native endianness scalar
+ -- value: if Atyp has reverse storage order, then it has been byte
+ -- swapped, and if the component being extracted is itself of a
+ -- composite type with reverse storage order, then we need to swap
+ -- it back to its expected endianness after extraction.
+
+ if Reverse_Storage_Order (Atyp)
+ and then (Is_Record_Type (Ctyp) or else Is_Array_Type (Ctyp))
+ and then Reverse_Storage_Order (Ctyp)
+ then
+ Arg := Revert_Storage_Order (Arg);
+ end if;
-- We needed to analyze this before we do the unchecked convert
-- below, but we need it temporarily attached to the tree for
-- where Subscr is the computed linear subscript
declare
- Get_nn : Entity_Id;
- Subscr : Node_Id;
+ Get_nn : Entity_Id;
+ Subscr : Node_Id;
+ Rev_SSO : constant Node_Id :=
+ New_Occurrence_Of
+ (Boolean_Literals (Reverse_Storage_Order (Atyp)), Loc);
begin
-- Acquire proper Get entity. We use the aligned or unaligned
Make_Attribute_Reference (Loc,
Prefix => Obj,
Attribute_Name => Name_Address),
- Subscr))));
+ Subscr,
+ Rev_SSO))));
end;
end if;
Analyze_And_Resolve (N, Ctyp, Suppress => All_Checks);
-
end Expand_Packed_Element_Reference;
----------------------
LLexpr :=
Make_Op_Multiply (Loc,
- Left_Opnd =>
- Make_Attribute_Reference (Loc,
- Prefix => New_Occurrence_Of (Ltyp, Loc),
- Attribute_Name => Name_Length),
- Right_Opnd =>
- Make_Integer_Literal (Loc, Component_Size (Ltyp)));
+ Left_Opnd => Compute_Number_Components (N, Ltyp),
+ Right_Opnd => Make_Integer_Literal (Loc, Component_Size (Ltyp)));
RLexpr :=
Make_Op_Multiply (Loc,
- Left_Opnd =>
- Make_Attribute_Reference (Loc,
- Prefix => New_Occurrence_Of (Rtyp, Loc),
- Attribute_Name => Name_Length),
- Right_Opnd =>
- Make_Integer_Literal (Loc, Component_Size (Rtyp)));
+ Left_Opnd => Compute_Number_Components (N, Rtyp),
+ Right_Opnd => Make_Integer_Literal (Loc, Component_Size (Rtyp)));
-- For the modular case, we transform the comparison to:
Source_Siz := UI_To_Int (RM_Size (Source_Typ));
Target_Siz := UI_To_Int (RM_Size (Target_Typ));
+ -- For a little-endian target type stored byte-swapped on a
+ -- big-endian machine, do not mask to Target_Siz bits.
+
+ if Bytes_Big_Endian
+ and then (Is_Record_Type (Target_Typ)
+ or else
+ Is_Array_Type (Target_Typ))
+ and then Reverse_Storage_Order (Target_Typ)
+ then
+ Source_Siz := Target_Siz;
+ end if;
+
-- First step, if the source type is not a discrete type, then we first
-- convert to a modular type of the source length, since otherwise, on
-- a big-endian machine, we get left-justification. We do it for little-
-- endian machines as well, because there might be junk bits that are
- -- not cleared if the type is not numeric.
+ -- not cleared if the type is not numeric. This can be done only if the
+ -- source siz is different from 0 (i.e. known), otherwise we must trust
+ -- the type declarations (case of non-discrete components).
- if Source_Siz /= Target_Siz
+ if Source_Siz /= 0
+ and then Source_Siz /= Target_Siz
and then not Is_Discrete_Type (Source_Typ)
then
Src := Unchecked_Convert_To (RTE (Bits_Id (Source_Siz)), Src);
-- with its actual subtype. This actual subtype will have a packed array
-- type with appropriate bounds.
- if not Is_Constrained (Packed_Array_Type (Etype (Pfx))) then
+ if not Is_Constrained (Packed_Array_Impl_Type (Etype (Pfx))) then
Convert_To_Actual_Subtype (Pfx);
end if;
Rewrite (N,
Make_Indexed_Component (Sloc (N),
Prefix =>
- Unchecked_Convert_To (Packed_Array_Type (Etype (Pfx)), Pfx),
+ Unchecked_Convert_To (Packed_Array_Impl_Type (Etype (Pfx)), Pfx),
Expressions => Exprs));
Analyze_And_Resolve (N, Typ);
projects / thirdparty / gcc.git / blobdiff