with Atree; use Atree;
with Checks; use Checks;
with Einfo; use Einfo;
with Exp_Dbug; use Exp_Dbug;
with Exp_Util; use Exp_Util;
with Nlists; use Nlists;
with Nmake; use Nmake;
with Opt; use Opt;
with Rtsfind; use Rtsfind;
with Sem; use Sem;
with Sem_Ch8; use Sem_Ch8;
with Sem_Ch13; use Sem_Ch13;
with Sem_Eval; use Sem_Eval;
with Sem_Res; use Sem_Res;
with Sem_Util; use Sem_Util;
with Sinfo; use Sinfo;
with Snames; use Snames;
with Stand; use Stand;
with Targparm; use Targparm;
with Tbuild; use Tbuild;
with Ttypes; use Ttypes;
with Uintp; use Uintp;
package body Exp_Pakd is
type E_Array is array (Int range 01 .. 63) of RE_Id;
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);
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);
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);
Set_Id : 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);
SetU_Id : 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);
procedure Compute_Linear_Subscript
(Atyp : Entity_Id;
N : Node_Id;
Subscr : out Node_Id);
procedure Convert_To_PAT_Type (Aexp : Node_Id);
function Known_Aligned_Enough (Obj : Node_Id; Csiz : Nat) return Boolean;
function Make_Shift_Left (N : Node_Id; S : Node_Id) return Node_Id;
function Make_Shift_Right (N : Node_Id; S : Node_Id) return Node_Id;
function RJ_Unchecked_Convert_To
(Typ : Entity_Id;
Expr : Node_Id)
return Node_Id;
procedure Setup_Enumeration_Packed_Array_Reference (N : Node_Id);
procedure Setup_Inline_Packed_Array_Reference
(N : Node_Id;
Atyp : Entity_Id;
Obj : in out Node_Id;
Cmask : out Uint;
Shift : out Node_Id);
procedure Compute_Linear_Subscript
(Atyp : Entity_Id;
N : Node_Id;
Subscr : out Node_Id)
is
Loc : constant Source_Ptr := Sloc (N);
Oldsub : Node_Id;
Newsub : Node_Id;
Indx : Node_Id;
Styp : Entity_Id;
begin
Subscr := Empty;
Indx := First_Index (Atyp);
Oldsub := First (Expressions (N));
while Present (Indx) loop
Styp := Etype (Indx);
Newsub := Relocate_Node (Oldsub);
if Do_Range_Check (Newsub)
and then Etype (Newsub) /= Styp
then
Newsub := Convert_To (Styp, Newsub);
end if;
if Is_Integer_Type (Styp) then
if Esize (Styp) < Esize (Standard_Integer) then
Newsub :=
Make_Op_Subtract (Loc,
Left_Opnd => Convert_To (Standard_Integer, Newsub),
Right_Opnd =>
Convert_To (Standard_Integer,
Make_Attribute_Reference (Loc,
Prefix => New_Occurrence_Of (Styp, Loc),
Attribute_Name => Name_First)));
else
Newsub :=
Convert_To (Standard_Integer,
Make_Op_Subtract (Loc,
Left_Opnd => Newsub,
Right_Opnd =>
Make_Attribute_Reference (Loc,
Prefix => New_Occurrence_Of (Styp, Loc),
Attribute_Name => Name_First)));
end if;
else
pragma Assert (Is_Enumeration_Type (Styp));
Newsub :=
Make_Op_Subtract (Loc,
Left_Opnd => Convert_To (Standard_Integer,
Make_Attribute_Reference (Loc,
Prefix => New_Occurrence_Of (Styp, Loc),
Attribute_Name => Name_Pos,
Expressions => New_List (Newsub))),
Right_Opnd =>
Convert_To (Standard_Integer,
Make_Attribute_Reference (Loc,
Prefix => New_Occurrence_Of (Styp, Loc),
Attribute_Name => Name_Pos,
Expressions => New_List (
Make_Attribute_Reference (Loc,
Prefix => New_Occurrence_Of (Styp, Loc),
Attribute_Name => Name_First)))));
end if;
Set_Paren_Count (Newsub, 1);
if No (Subscr) then
Subscr := Newsub;
else
Subscr :=
Make_Op_Add (Loc,
Left_Opnd =>
Make_Op_Multiply (Loc,
Left_Opnd => Subscr,
Right_Opnd =>
Make_Attribute_Reference (Loc,
Attribute_Name => Name_Range_Length,
Prefix => New_Occurrence_Of (Styp, Loc))),
Right_Opnd => Newsub);
end if;
Next_Index (Indx);
Next (Oldsub);
end loop;
end Compute_Linear_Subscript;
procedure Convert_To_PAT_Type (Aexp : Entity_Id) is
Act_ST : Entity_Id;
begin
Convert_To_Actual_Subtype (Aexp);
Act_ST := Underlying_Type (Etype (Aexp));
Create_Packed_Array_Type (Act_ST);
Set_Etype (Aexp, Packed_Array_Type (Act_ST));
end Convert_To_PAT_Type;
procedure Create_Packed_Array_Type (Typ : Entity_Id) is
Loc : constant Source_Ptr := Sloc (Typ);
Ctyp : constant Entity_Id := Component_Type (Typ);
Csize : constant Uint := Component_Size (Typ);
Ancest : Entity_Id;
PB_Type : Entity_Id;
Esiz : Uint;
Decl : Node_Id;
PAT : Entity_Id;
Len_Dim : Node_Id;
Len_Expr : Node_Id;
Len_Bits : Uint;
Bits_U1 : Node_Id;
PAT_High : Node_Id;
Btyp : Entity_Id;
Lit : Node_Id;
procedure Install_PAT;
procedure Set_PB_Type;
procedure Install_PAT is
Pushed_Scope : Boolean := False;
begin
if Is_Itype (Typ) then
Set_Parent (Decl, Associated_Node_For_Itype (Typ));
else
Set_Parent (Decl, Declaration_Node (Typ));
end if;
if Scope (Typ) /= Current_Scope then
New_Scope (Scope (Typ));
Pushed_Scope := True;
end if;
Set_Is_Itype (PAT, True);
Set_Packed_Array_Type (Typ, PAT);
Analyze (Decl, Suppress => All_Checks);
if Pushed_Scope then
Pop_Scope;
end if;
Set_Esize (PAT, Esiz);
if Unknown_RM_Size (PAT) then
Set_RM_Size (PAT, Esiz);
end if;
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);
Set_Has_Delayed_Freeze (PAT, False);
Set_Has_Delayed_Freeze (Etype (PAT), False);
end Install_PAT;
procedure Set_PB_Type is
begin
if Csize <= 2 or else Csize = 4 or else Csize mod 2 /= 0
or else Alignment (Typ) = 1
or else Component_Alignment (Typ) = Calign_Storage_Unit
then
PB_Type := RTE (RE_Packed_Bytes1);
elsif Csize mod 4 /= 0
or else Alignment (Typ) = 2
then
PB_Type := RTE (RE_Packed_Bytes2);
else
PB_Type := RTE (RE_Packed_Bytes4);
end if;
end Set_PB_Type;
begin
if Present (Packed_Array_Type (Typ)) then
return;
end if;
if Ekind (Typ) = E_Array_Subtype then
Ancest := Ancestor_Subtype (Typ);
if Present (Ancest)
and then Is_Constrained (Ancest)
and then Present (Packed_Array_Type (Ancest))
then
Set_Packed_Array_Type (Typ, Packed_Array_Type (Ancest));
return;
end if;
end if;
Esiz := Esize (Typ);
if not Is_Bit_Packed_Array (Typ) then
PAT :=
Make_Defining_Identifier (Loc,
Chars => New_External_Name (Chars (Typ), 'P'));
Set_Packed_Array_Type (Typ, PAT);
declare
Indexes : List_Id := New_List;
Indx : Node_Id;
Indx_Typ : Entity_Id;
Enum_Case : Boolean;
Typedef : Node_Id;
begin
Indx := First_Index (Typ);
while Present (Indx) loop
Indx_Typ := Etype (Indx);
Enum_Case := Is_Enumeration_Type (Indx_Typ)
and then Has_Non_Standard_Rep (Indx_Typ);
if not Is_Constrained (Typ) then
if Enum_Case then
Indx_Typ := Standard_Natural;
end if;
Append_To (Indexes, New_Occurrence_Of (Indx_Typ, Loc));
else
if not Enum_Case then
Append_To (Indexes, New_Occurrence_Of (Indx_Typ, Loc));
else
Append_To (Indexes,
Make_Subtype_Indication (Loc,
Subtype_Mark =>
New_Occurrence_Of (Standard_Natural, Loc),
Constraint =>
Make_Range_Constraint (Loc,
Range_Expression =>
Make_Range (Loc,
Low_Bound =>
Make_Attribute_Reference (Loc,
Prefix =>
New_Occurrence_Of (Indx_Typ, Loc),
Attribute_Name => Name_Pos,
Expressions => New_List (
Make_Attribute_Reference (Loc,
Prefix =>
New_Occurrence_Of (Indx_Typ, Loc),
Attribute_Name => Name_First))),
High_Bound =>
Make_Attribute_Reference (Loc,
Prefix =>
New_Occurrence_Of (Indx_Typ, Loc),
Attribute_Name => Name_Pos,
Expressions => New_List (
Make_Attribute_Reference (Loc,
Prefix =>
New_Occurrence_Of (Indx_Typ, Loc),
Attribute_Name => Name_Last)))))));
end if;
end if;
Next_Index (Indx);
end loop;
if not Is_Constrained (Typ) then
Typedef :=
Make_Unconstrained_Array_Definition (Loc,
Subtype_Marks => Indexes,
Subtype_Indication =>
New_Occurrence_Of (Ctyp, Loc));
else
Typedef :=
Make_Constrained_Array_Definition (Loc,
Discrete_Subtype_Definitions => Indexes,
Subtype_Indication =>
New_Occurrence_Of (Ctyp, Loc));
end if;
Decl :=
Make_Full_Type_Declaration (Loc,
Defining_Identifier => PAT,
Type_Definition => Typedef);
end;
Set_Is_Packed_Array_Type (PAT);
Install_PAT;
return;
elsif not Is_Constrained (Typ) then
PAT :=
Make_Defining_Identifier (Loc,
Chars => Make_Packed_Array_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;
else
PAT :=
Make_Defining_Identifier (Loc,
Chars => Make_Packed_Array_Type_Name (Typ, Csize));
Set_Packed_Array_Type (Typ, PAT);
declare
J : Nat := 1;
begin
Len_Expr := Empty;
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;
Set_Parent (Len_Expr, Typ);
Analyze_And_Resolve (Len_Expr, Standard_Integer);
if Compile_Time_Known_Value (Len_Expr) then
Len_Bits := Expr_Value (Len_Expr) * Csize;
if Len_Bits > 0
and then
(Len_Bits <= System_Word_Size
or else (Len_Bits <= System_Max_Binary_Modulus_Power
and then (not No_Run_Time
or else
Long_Shifts_Inlined_On_Target)))
then
if Len_Bits <= Standard_Integer_Size then
Btyp := RTE (RE_Unsigned);
else
Btyp := RTE (RE_Long_Long_Unsigned);
end if;
Lit := Make_Integer_Literal (Loc, 2 ** Len_Bits - 1);
Set_Print_In_Hex (Lit);
Decl :=
Make_Subtype_Declaration (Loc,
Defining_Identifier => PAT,
Subtype_Indication =>
Make_Subtype_Indication (Loc,
Subtype_Mark => New_Occurrence_Of (Btyp, Loc),
Constraint =>
Make_Range_Constraint (Loc,
Range_Expression =>
Make_Range (Loc,
Low_Bound =>
Make_Integer_Literal (Loc, 0),
High_Bound => Lit))));
if Esiz = Uint_0 then
Esiz := Len_Bits;
end if;
Install_PAT;
return;
end if;
end if;
Set_PB_Type;
Bits_U1 :=
Make_Op_Add (Loc,
Left_Opnd =>
Make_Op_Multiply (Loc,
Left_Opnd =>
Make_Integer_Literal (Loc, Csize),
Right_Opnd => Len_Expr),
Right_Opnd =>
Make_Integer_Literal (Loc, 7));
Set_Paren_Count (Bits_U1, 1);
PAT_High :=
Make_Op_Subtract (Loc,
Left_Opnd =>
Make_Op_Divide (Loc,
Left_Opnd => Bits_U1,
Right_Opnd => Make_Integer_Literal (Loc, 8)),
Right_Opnd => Make_Integer_Literal (Loc, 1));
Decl :=
Make_Subtype_Declaration (Loc,
Defining_Identifier => PAT,
Subtype_Indication =>
Make_Subtype_Indication (Loc,
Subtype_Mark => New_Occurrence_Of (PB_Type, Loc),
Constraint =>
Make_Index_Or_Discriminant_Constraint (Loc,
Constraints => New_List (
Make_Range (Loc,
Low_Bound =>
Make_Integer_Literal (Loc, 0),
High_Bound => PAT_High)))));
Install_PAT;
end if;
end Create_Packed_Array_Type;
procedure Expand_Bit_Packed_Element_Set (N : Node_Id) is
Loc : constant Source_Ptr := Sloc (N);
Lhs : constant Node_Id := Name (N);
Ass_OK : constant Boolean := Assignment_OK (Lhs);
Rhs : Node_Id := Expression (N);
Obj : Node_Id;
Atyp : Entity_Id;
PAT : Entity_Id;
Ctyp : Entity_Id;
Csiz : Int;
Shift : Node_Id;
Cmask : Uint;
New_Lhs : Node_Id;
New_Rhs : Node_Id;
Rhs_Val_Known : Boolean;
Rhs_Val : Uint;
begin
pragma Assert (Is_Bit_Packed_Array (Etype (Prefix (Lhs))));
Obj := Relocate_Node (Prefix (Lhs));
Convert_To_Actual_Subtype (Obj);
Atyp := Etype (Obj);
PAT := Packed_Array_Type (Atyp);
Ctyp := Component_Type (Atyp);
Csiz := UI_To_Int (Component_Size (Atyp));
Rhs := Convert_To (Ctyp, Rhs);
Set_Parent (Rhs, N);
Analyze_And_Resolve (Rhs, Ctyp);
if Csiz = 1 or else Csiz = 2 or else Csiz = 4
or else (Present (PAT) and then Is_Modular_Integer_Type (PAT))
then
Setup_Inline_Packed_Array_Reference (Lhs, Atyp, Obj, Cmask, Shift);
if Compile_Time_Known_Value (Rhs) then
Rhs_Val := Expr_Rep_Value (Rhs);
Rhs_Val_Known := True;
elsif Nkind (Rhs) = N_Unchecked_Type_Conversion
and then Compile_Time_Known_Value (Expression (Rhs))
then
Rhs_Val := Expr_Rep_Value (Expression (Rhs));
Rhs_Val_Known := True;
else
Rhs_Val := No_Uint;
Rhs_Val_Known := False;
end if;
if Rhs_Val_Known then
if Has_Biased_Representation (Ctyp) then
Rhs_Val := Rhs_Val - Expr_Rep_Value (Type_Low_Bound (Ctyp));
end if;
if Rhs_Val < 0 then
Rhs_Val := 2 ** UI_From_Int (Csiz) + Rhs_Val;
end if;
end if;
New_Lhs := Duplicate_Subexpr (Obj, True);
New_Rhs := Duplicate_Subexpr (Obj);
if not Rhs_Val_Known or else Rhs_Val /= Cmask then
declare
Mask1 : Node_Id;
Lit : Node_Id;
begin
if Compile_Time_Known_Value (Shift) then
Mask1 :=
Make_Integer_Literal (Loc,
Modulus (Etype (Obj)) - 1 -
(Cmask * (2 ** Expr_Value (Shift))));
Set_Print_In_Hex (Mask1);
else
Lit := Make_Integer_Literal (Loc, Cmask);
Set_Print_In_Hex (Lit);
Mask1 :=
Make_Op_Not (Loc,
Right_Opnd => Make_Shift_Left (Lit, Shift));
end if;
New_Rhs :=
Make_Op_And (Loc,
Left_Opnd => New_Rhs,
Right_Opnd => Mask1);
end;
end if;
if not Rhs_Val_Known or else Rhs_Val /= 0 then
declare
Or_Rhs : Node_Id;
procedure Fixup_Rhs;
procedure Fixup_Rhs is
Etyp : constant Entity_Id := Etype (Rhs);
begin
if Has_Biased_Representation (Ctyp) then
Rhs := Convert_To (Ctyp, Rhs);
elsif Is_Signed_Integer_Type (Ctyp) then
Rhs := Unchecked_Convert_To (RTE (Bits_Id (Csiz)), Rhs);
end if;
Set_Etype (Rhs, Etyp);
Rhs := RJ_Unchecked_Convert_To (Etype (Obj), Rhs);
end Fixup_Rhs;
begin
if Rhs_Val_Known
and then Compile_Time_Known_Value (Shift)
then
Or_Rhs :=
Make_Integer_Literal (Loc,
Rhs_Val * (2 ** Expr_Value (Shift)));
Set_Print_In_Hex (Or_Rhs);
else
if Nkind (Rhs) = N_Attribute_Reference
and then Attribute_Name (Rhs) = Name_Val
and then Etype (First (Expressions (Rhs))) = Etype (Obj)
then
Rhs := Relocate_Node (First (Expressions (Rhs)));
Fixup_Rhs;
elsif Rhs_Val_Known then
Rhs :=
Make_Integer_Literal (Loc, Rhs_Val);
else
Fixup_Rhs;
end if;
Or_Rhs := Make_Shift_Left (Rhs, Shift);
end if;
if Nkind (New_Rhs) = N_Op_And then
Set_Paren_Count (New_Rhs, 1);
end if;
New_Rhs :=
Make_Op_Or (Loc,
Left_Opnd => New_Rhs,
Right_Opnd => Or_Rhs);
end;
end if;
Rewrite (N,
Make_Assignment_Statement (Loc,
Name => New_Lhs,
Expression =>
Unchecked_Convert_To (Etype (New_Lhs), New_Rhs)));
Set_Assignment_OK (Name (N), Ass_OK);
else
declare
Bits_nn : constant Entity_Id := RTE (Bits_Id (Csiz));
Set_nn : Entity_Id;
Subscr : Node_Id;
Atyp : Entity_Id;
begin
if Known_Aligned_Enough (Obj, Csiz) then
Set_nn := RTE (Set_Id (Csiz));
else
Set_nn := RTE (SetU_Id (Csiz));
end if;
Obj := Relocate_Node (Prefix (Lhs));
Convert_To_Actual_Subtype (Obj);
Atyp := Etype (Obj);
Compute_Linear_Subscript (Atyp, Lhs, Subscr);
Rewrite (N,
Make_Procedure_Call_Statement (Loc,
Name => New_Occurrence_Of (Set_nn, Loc),
Parameter_Associations => New_List (
Make_Byte_Aligned_Attribute_Reference (Loc,
Attribute_Name => Name_Address,
Prefix => Obj),
Subscr,
Unchecked_Convert_To (Bits_nn,
Convert_To (Ctyp, Rhs)))));
end;
end if;
Analyze (N, Suppress => All_Checks);
end Expand_Bit_Packed_Element_Set;
procedure Expand_Packed_Address_Reference (N : Node_Id) is
Loc : constant Source_Ptr := Sloc (N);
Ploc : Source_Ptr;
Pref : Node_Id;
Expr : Node_Id;
Term : Node_Id;
Atyp : Entity_Id;
Subscr : Node_Id;
begin
Pref := Prefix (N);
Expr := Empty;
loop
Ploc := Sloc (Pref);
if Nkind (Pref) = N_Indexed_Component then
Convert_To_Actual_Subtype (Prefix (Pref));
Atyp := Etype (Prefix (Pref));
Compute_Linear_Subscript (Atyp, Pref, Subscr);
Term :=
Make_Op_Multiply (Ploc,
Left_Opnd => Subscr,
Right_Opnd =>
Make_Attribute_Reference (Ploc,
Prefix => New_Occurrence_Of (Atyp, Ploc),
Attribute_Name => Name_Component_Size));
elsif Nkind (Pref) = N_Selected_Component then
Term :=
Make_Attribute_Reference (Ploc,
Prefix => Selector_Name (Pref),
Attribute_Name => Name_Bit_Position);
else
exit;
end if;
Term := Convert_To (RTE (RE_Integer_Address), Term);
if No (Expr) then
Expr := Term;
else
Expr :=
Make_Op_Add (Ploc,
Left_Opnd => Expr,
Right_Opnd => Term);
end if;
Pref := Prefix (Pref);
end loop;
Rewrite (N,
Unchecked_Convert_To (RTE (RE_Address),
Make_Op_Add (Loc,
Left_Opnd =>
Unchecked_Convert_To (RTE (RE_Integer_Address),
Make_Attribute_Reference (Loc,
Prefix => Pref,
Attribute_Name => Name_Address)),
Right_Opnd =>
Make_Op_Divide (Loc,
Left_Opnd => Expr,
Right_Opnd =>
Make_Integer_Literal (Loc, System_Storage_Unit)))));
Analyze_And_Resolve (N, RTE (RE_Address));
end Expand_Packed_Address_Reference;
procedure Expand_Packed_Boolean_Operator (N : Node_Id) is
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));
Ltyp : Entity_Id;
Rtyp : Entity_Id;
PAT : 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));
Ltyp := Etype (L);
Rtyp := Etype (R);
if Nkind (N) = N_Op_Xor then
declare
CT : constant Entity_Id := Component_Type (Rtyp);
BT : constant Entity_Id := Base_Type (CT);
begin
Insert_Action (N,
Make_Raise_Constraint_Error (Loc,
Condition =>
Make_Op_And (Loc,
Left_Opnd =>
Make_Op_Eq (Loc,
Left_Opnd =>
Make_Attribute_Reference (Loc,
Prefix => New_Occurrence_Of (CT, Loc),
Attribute_Name => Name_First),
Right_Opnd =>
Convert_To (BT,
New_Occurrence_Of (Standard_True, Loc))),
Right_Opnd =>
Make_Op_Eq (Loc,
Left_Opnd =>
Make_Attribute_Reference (Loc,
Prefix => New_Occurrence_Of (CT, Loc),
Attribute_Name => Name_Last),
Right_Opnd =>
Convert_To (BT,
New_Occurrence_Of (Standard_True, Loc)))),
Reason => CE_Range_Check_Failed));
end;
end if;
Convert_To_PAT_Type (L);
Convert_To_PAT_Type (R);
PAT := Etype (L);
if Is_Modular_Integer_Type (PAT) then
declare
P : Node_Id;
begin
if Nkind (N) = N_Op_And then
P := Make_Op_And (Loc, L, R);
elsif Nkind (N) = N_Op_Or then
P := Make_Op_Or (Loc, L, R);
else P := Make_Op_Xor (Loc, L, R);
end if;
Rewrite (N, Unchecked_Convert_To (Rtyp, P));
end;
else
declare
Result_Ent : constant Entity_Id :=
Make_Defining_Identifier (Loc,
Chars => New_Internal_Name ('T'));
E_Id : RE_Id;
begin
if Nkind (N) = N_Op_And then
E_Id := RE_Bit_And;
elsif Nkind (N) = N_Op_Or then
E_Id := RE_Bit_Or;
else E_Id := RE_Bit_Xor;
end if;
Insert_Actions (N, New_List (
Make_Object_Declaration (Loc,
Defining_Identifier => Result_Ent,
Object_Definition => New_Occurrence_Of (Ltyp, Loc)),
Make_Procedure_Call_Statement (Loc,
Name => New_Occurrence_Of (RTE (E_Id), Loc),
Parameter_Associations => New_List (
Make_Byte_Aligned_Attribute_Reference (Loc,
Attribute_Name => Name_Address,
Prefix => L),
Make_Op_Multiply (Loc,
Left_Opnd =>
Make_Attribute_Reference (Loc,
Prefix =>
New_Occurrence_Of
(Etype (First_Index (Ltyp)), Loc),
Attribute_Name => Name_Range_Length),
Right_Opnd =>
Make_Integer_Literal (Loc, Component_Size (Ltyp))),
Make_Byte_Aligned_Attribute_Reference (Loc,
Attribute_Name => Name_Address,
Prefix => R),
Make_Op_Multiply (Loc,
Left_Opnd =>
Make_Attribute_Reference (Loc,
Prefix =>
New_Occurrence_Of
(Etype (First_Index (Rtyp)), Loc),
Attribute_Name => Name_Range_Length),
Right_Opnd =>
Make_Integer_Literal (Loc, Component_Size (Rtyp))),
Make_Byte_Aligned_Attribute_Reference (Loc,
Attribute_Name => Name_Address,
Prefix => New_Occurrence_Of (Result_Ent, Loc))))));
Rewrite (N,
New_Occurrence_Of (Result_Ent, Loc));
end;
end if;
Analyze_And_Resolve (N, Typ, Suppress => All_Checks);
end Expand_Packed_Boolean_Operator;
procedure Expand_Packed_Element_Reference (N : Node_Id) is
Loc : constant Source_Ptr := Sloc (N);
Obj : Node_Id;
Atyp : Entity_Id;
PAT : Entity_Id;
Ctyp : Entity_Id;
Csiz : Int;
Shift : Node_Id;
Cmask : Uint;
Lit : Node_Id;
Arg : Node_Id;
begin
if not Is_Bit_Packed_Array (Etype (Prefix (N))) then
Setup_Enumeration_Packed_Array_Reference (N);
return;
end if;
Obj := Relocate_Node (Prefix (N));
Convert_To_Actual_Subtype (Obj);
Atyp := Etype (Obj);
PAT := Packed_Array_Type (Atyp);
Ctyp := Component_Type (Atyp);
Csiz := UI_To_Int (Component_Size (Atyp));
if Csiz = 1 or else Csiz = 2 or else Csiz = 4
or else (Present (PAT) and then Is_Modular_Integer_Type (PAT))
then
Setup_Inline_Packed_Array_Reference (N, Atyp, Obj, Cmask, Shift);
Lit := Make_Integer_Literal (Loc, Cmask);
Set_Print_In_Hex (Lit);
Arg :=
Make_Op_And (Loc,
Left_Opnd => Make_Shift_Right (Obj, Shift),
Right_Opnd => Lit);
Analyze_And_Resolve (Arg);
Rewrite (N,
RJ_Unchecked_Convert_To (Ctyp, Arg));
else
declare
Get_nn : Entity_Id;
Subscr : Node_Id;
begin
if Known_Aligned_Enough (Obj, Csiz) then
Get_nn := RTE (Get_Id (Csiz));
else
Get_nn := RTE (GetU_Id (Csiz));
end if;
Compute_Linear_Subscript (Atyp, N, Subscr);
Rewrite (N,
Unchecked_Convert_To (Ctyp,
Make_Function_Call (Loc,
Name => New_Occurrence_Of (Get_nn, Loc),
Parameter_Associations => New_List (
Make_Byte_Aligned_Attribute_Reference (Loc,
Attribute_Name => Name_Address,
Prefix => Obj),
Subscr))));
end;
end if;
Analyze_And_Resolve (N, Ctyp, Suppress => All_Checks);
end Expand_Packed_Element_Reference;
procedure Expand_Packed_Eq (N : Node_Id) is
Loc : constant Source_Ptr := Sloc (N);
L : constant Node_Id := Relocate_Node (Left_Opnd (N));
R : constant Node_Id := Relocate_Node (Right_Opnd (N));
LLexpr : Node_Id;
RLexpr : Node_Id;
Ltyp : Entity_Id;
Rtyp : Entity_Id;
PAT : Entity_Id;
begin
Convert_To_Actual_Subtype (L);
Convert_To_Actual_Subtype (R);
Ltyp := Underlying_Type (Etype (L));
Rtyp := Underlying_Type (Etype (R));
Convert_To_PAT_Type (L);
Convert_To_PAT_Type (R);
PAT := Etype (L);
LLexpr :=
Make_Op_Multiply (Loc,
Left_Opnd =>
Make_Attribute_Reference (Loc,
Attribute_Name => Name_Length,
Prefix => New_Occurrence_Of (Ltyp, Loc)),
Right_Opnd =>
Make_Integer_Literal (Loc, Component_Size (Ltyp)));
RLexpr :=
Make_Op_Multiply (Loc,
Left_Opnd =>
Make_Attribute_Reference (Loc,
Attribute_Name => Name_Length,
Prefix => New_Occurrence_Of (Rtyp, Loc)),
Right_Opnd =>
Make_Integer_Literal (Loc, Component_Size (Rtyp)));
if Is_Modular_Integer_Type (PAT) then
Rewrite (N,
Make_And_Then (Loc,
Left_Opnd =>
Make_Op_Eq (Loc,
Left_Opnd => LLexpr,
Right_Opnd => RLexpr),
Right_Opnd =>
Make_Op_Eq (Loc,
Left_Opnd => L,
Right_Opnd => R)));
else
Rewrite (N,
Make_Function_Call (Loc,
Name => New_Occurrence_Of (RTE (RE_Bit_Eq), Loc),
Parameter_Associations => New_List (
Make_Byte_Aligned_Attribute_Reference (Loc,
Attribute_Name => Name_Address,
Prefix => L),
LLexpr,
Make_Byte_Aligned_Attribute_Reference (Loc,
Attribute_Name => Name_Address,
Prefix => R),
RLexpr)));
end if;
Analyze_And_Resolve (N, Standard_Boolean, Suppress => All_Checks);
end Expand_Packed_Eq;
procedure Expand_Packed_Not (N : Node_Id) is
Loc : constant Source_Ptr := Sloc (N);
Typ : constant Entity_Id := Etype (N);
Opnd : constant Node_Id := Relocate_Node (Right_Opnd (N));
Rtyp : Entity_Id;
PAT : Entity_Id;
Lit : Node_Id;
begin
Convert_To_Actual_Subtype (Opnd);
Rtyp := Etype (Opnd);
declare
CT : constant Entity_Id := Component_Type (Rtyp);
begin
Insert_Action (N,
Make_Raise_Constraint_Error (Loc,
Condition =>
Make_Op_Eq (Loc,
Left_Opnd =>
Make_Attribute_Reference (Loc,
Prefix => New_Occurrence_Of (CT, Loc),
Attribute_Name => Name_First),
Right_Opnd =>
Make_Attribute_Reference (Loc,
Prefix => New_Occurrence_Of (CT, Loc),
Attribute_Name => Name_Last)),
Reason => CE_Range_Check_Failed));
end;
Convert_To_PAT_Type (Opnd);
PAT := Etype (Opnd);
Lit := Make_Integer_Literal (Loc, 2 ** Esize (PAT) - 1);
Set_Print_In_Hex (Lit);
if not Is_Array_Type (PAT) then
Rewrite (N,
Unchecked_Convert_To (Rtyp,
Make_Op_Xor (Loc,
Left_Opnd => Opnd,
Right_Opnd => Lit)));
else
declare
Result_Ent : constant Entity_Id :=
Make_Defining_Identifier (Loc,
Chars => New_Internal_Name ('T'));
begin
Insert_Actions (N, New_List (
Make_Object_Declaration (Loc,
Defining_Identifier => Result_Ent,
Object_Definition => New_Occurrence_Of (Rtyp, Loc)),
Make_Procedure_Call_Statement (Loc,
Name => New_Occurrence_Of (RTE (RE_Bit_Not), Loc),
Parameter_Associations => New_List (
Make_Byte_Aligned_Attribute_Reference (Loc,
Attribute_Name => Name_Address,
Prefix => Opnd),
Make_Op_Multiply (Loc,
Left_Opnd =>
Make_Attribute_Reference (Loc,
Prefix =>
New_Occurrence_Of
(Etype (First_Index (Rtyp)), Loc),
Attribute_Name => Name_Range_Length),
Right_Opnd =>
Make_Integer_Literal (Loc, Component_Size (Rtyp))),
Make_Byte_Aligned_Attribute_Reference (Loc,
Attribute_Name => Name_Address,
Prefix => New_Occurrence_Of (Result_Ent, Loc))))));
Rewrite (N,
New_Occurrence_Of (Result_Ent, Loc));
end;
end if;
Analyze_And_Resolve (N, Typ, Suppress => All_Checks);
end Expand_Packed_Not;
function Involves_Packed_Array_Reference (N : Node_Id) return Boolean is
begin
if Nkind (N) = N_Indexed_Component
and then Is_Bit_Packed_Array (Etype (Prefix (N)))
then
return True;
elsif Nkind (N) = N_Selected_Component then
return Involves_Packed_Array_Reference (Prefix (N));
else
return False;
end if;
end Involves_Packed_Array_Reference;
function Known_Aligned_Enough (Obj : Node_Id; Csiz : Nat) return Boolean is
Typ : constant Entity_Id := Etype (Obj);
function In_Partially_Packed_Record (Comp : Entity_Id) return Boolean;
function In_Partially_Packed_Record (Comp : Entity_Id) return Boolean is
Rec_Type : constant Entity_Id := Scope (Comp);
Prev_Comp : Entity_Id;
begin
Prev_Comp := First_Entity (Rec_Type);
while Present (Prev_Comp) loop
if Is_Packed (Etype (Prev_Comp)) then
return True;
elsif Prev_Comp = Comp then
return False;
end if;
Next_Entity (Prev_Comp);
end loop;
return False;
end In_Partially_Packed_Record;
begin
if Csiz mod 2 = 1 then
return True;
elsif Known_Alignment (Etype (Obj)) then
if Alignment (Etype (Obj)) < 4 - (Csiz mod 4) then
return False;
end if;
end if;
if Strict_Alignment (Typ) then
return True;
elsif Nkind (Obj) = N_Indexed_Component then
if Is_Access_Type (Etype (Prefix (Obj))) then
return True;
else
return Known_Aligned_Enough (Prefix (Obj), Csiz);
end if;
elsif Nkind (Obj) = N_Selected_Component then
if Is_Record_Type (Etype (Prefix (Obj)))
and then Is_Packed (Etype (Prefix (Obj)))
then
return False;
elsif Present (Component_Clause (Entity (Selector_Name (Obj)))) then
return False;
elsif In_Partially_Packed_Record (Entity (Selector_Name (Obj))) then
return False;
else
return Known_Aligned_Enough (Prefix (Obj), Csiz);
end if;
else
return True;
end if;
end Known_Aligned_Enough;
function Make_Shift_Left (N : Node_Id; S : Node_Id) return Node_Id is
Nod : Node_Id;
begin
if Compile_Time_Known_Value (S) and then Expr_Value (S) = 0 then
return N;
else
Nod :=
Make_Op_Shift_Left (Sloc (N),
Left_Opnd => N,
Right_Opnd => S);
Set_Shift_Count_OK (Nod, True);
return Nod;
end if;
end Make_Shift_Left;
function Make_Shift_Right (N : Node_Id; S : Node_Id) return Node_Id is
Nod : Node_Id;
begin
if Compile_Time_Known_Value (S) and then Expr_Value (S) = 0 then
return N;
else
Nod :=
Make_Op_Shift_Right (Sloc (N),
Left_Opnd => N,
Right_Opnd => S);
Set_Shift_Count_OK (Nod, True);
return Nod;
end if;
end Make_Shift_Right;
function RJ_Unchecked_Convert_To
(Typ : Entity_Id;
Expr : Node_Id)
return Node_Id
is
Source_Typ : constant Entity_Id := Etype (Expr);
Target_Typ : constant Entity_Id := Typ;
Src : Node_Id := Expr;
Source_Siz : Nat;
Target_Siz : Nat;
begin
Source_Siz := UI_To_Int (RM_Size (Source_Typ));
Target_Siz := UI_To_Int (RM_Size (Target_Typ));
if Bytes_Big_Endian and then Source_Siz /= Target_Siz then
if not Is_Discrete_Type (Source_Typ) then
Src := Unchecked_Convert_To (RTE (Bits_Id (Source_Siz)), Src);
end if;
if not Is_Discrete_Type (Target_Typ) then
Src := Unchecked_Convert_To (RTE (Bits_Id (Target_Siz)), Src);
end if;
end if;
return Unchecked_Convert_To (Target_Typ, Src);
end RJ_Unchecked_Convert_To;
procedure Setup_Enumeration_Packed_Array_Reference (N : Node_Id) is
Pfx : constant Node_Id := Prefix (N);
Typ : constant Entity_Id := Etype (N);
Exprs : constant List_Id := Expressions (N);
Expr : Node_Id;
begin
if not Is_Constrained (Packed_Array_Type (Etype (Pfx))) then
Convert_To_Actual_Subtype (Pfx);
end if;
Expr := First (Exprs);
while Present (Expr) loop
declare
Loc : constant Source_Ptr := Sloc (Expr);
Expr_Typ : constant Entity_Id := Etype (Expr);
begin
if Is_Enumeration_Type (Expr_Typ)
and then Has_Non_Standard_Rep (Expr_Typ)
then
Rewrite (Expr,
Make_Attribute_Reference (Loc,
Prefix => New_Occurrence_Of (Expr_Typ, Loc),
Attribute_Name => Name_Pos,
Expressions => New_List (Relocate_Node (Expr))));
Analyze_And_Resolve (Expr, Standard_Natural);
end if;
end;
Next (Expr);
end loop;
Rewrite (N,
Make_Indexed_Component (Sloc (N),
Prefix =>
Unchecked_Convert_To (Packed_Array_Type (Etype (Pfx)), Pfx),
Expressions => Exprs));
Analyze_And_Resolve (N, Typ);
end Setup_Enumeration_Packed_Array_Reference;
procedure Setup_Inline_Packed_Array_Reference
(N : Node_Id;
Atyp : Entity_Id;
Obj : in out Node_Id;
Cmask : out Uint;
Shift : out Node_Id)
is
Loc : constant Source_Ptr := Sloc (N);
Ctyp : Entity_Id;
PAT : Entity_Id;
Otyp : Entity_Id;
Csiz : Uint;
Osiz : Uint;
begin
Ctyp := Component_Type (Atyp);
Csiz := Component_Size (Atyp);
Convert_To_PAT_Type (Obj);
PAT := Etype (Obj);
Cmask := 2 ** Csiz - 1;
if Is_Array_Type (PAT) then
Otyp := Component_Type (PAT);
Osiz := Esize (Otyp);
else
Otyp := PAT;
Osiz := UI_From_Int (Minimum_Size (Otyp));
end if;
Compute_Linear_Subscript (Atyp, N, Shift);
if Csiz /= 1 then
Shift :=
Make_Op_Multiply (Loc,
Left_Opnd => Make_Integer_Literal (Loc, Csiz),
Right_Opnd => Shift);
end if;
if Is_Array_Type (PAT) then
declare
New_Shift : Node_Id;
begin
Set_Parent (Shift, N);
Analyze_And_Resolve
(Shift, Standard_Integer, Suppress => All_Checks);
New_Shift :=
Make_Op_Mod (Loc,
Left_Opnd => Duplicate_Subexpr (Shift),
Right_Opnd => Make_Integer_Literal (Loc, Osiz));
Obj :=
Make_Indexed_Component (Loc,
Prefix => Obj,
Expressions => New_List (
Make_Op_Divide (Loc,
Left_Opnd => Duplicate_Subexpr (Shift),
Right_Opnd => Make_Integer_Literal (Loc, Osiz))));
Shift := New_Shift;
end;
else
null;
end if;
if Bytes_Big_Endian then
Shift :=
Make_Op_Subtract (Loc,
Left_Opnd => Make_Integer_Literal (Loc, Osiz - Csiz),
Right_Opnd => Shift);
end if;
Set_Parent (Shift, N);
Set_Parent (Obj, N);
Analyze_And_Resolve (Obj, Otyp, Suppress => All_Checks);
Analyze_And_Resolve (Shift, Standard_Integer, Suppress => All_Checks);
Set_Etype (Obj, Otyp);
end Setup_Inline_Packed_Array_Reference;
end Exp_Pakd;