gcc/ada/exp_pakd.adb

   1 ------------------------------------------------------------------------------
   2 --                                                                          --
   3 --                         GNAT COMPILER COMPONENTS                         --
   4 --                                                                          --
   5 --                             E X P _ P A K D                              --
   6 --                                                                          --
   7 --                                 B o d y                                  --
   8 --                                                                          --
   9 --          Copyright (C) 1992-2021, Free Software Foundation, Inc.         --
  10 --                                                                          --
  11 -- GNAT is free software;  you can  redistribute it  and/or modify it under --
  12 -- terms of the  GNU General Public License as published  by the Free Soft- --
  13 -- ware  Foundation;  either version 3,  or (at your option) any later ver- --
  14 -- sion.  GNAT is distributed in the hope that it will be useful, but WITH- --
  15 -- OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY --
  16 -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  17 -- for  more details.  You should have  received  a copy of the GNU General --
  18 -- Public License  distributed with GNAT; see file COPYING3.  If not, go to --
  19 -- http://www.gnu.org/licenses for a complete copy of the license.          --
  20 --                                                                          --
  21 -- GNAT was originally developed  by the GNAT team at  New York University. --
  22 -- Extensive contributions were provided by Ada Core Technologies Inc.      --
  23 --                                                                          --
  24 ------------------------------------------------------------------------------
  25
  26 with Atree;          use Atree;
  27 with Checks;         use Checks;
  28 with Einfo;          use Einfo;
  29 with Einfo.Entities; use Einfo.Entities;
  30 with Einfo.Utils;    use Einfo.Utils;
  31 with Errout;         use Errout;
  32 with Exp_Dbug;       use Exp_Dbug;
  33 with Exp_Util;       use Exp_Util;
  34 with Layout;         use Layout;
  35 with Lib.Xref;       use Lib.Xref;
  36 with Namet;          use Namet;
  37 with Nlists;         use Nlists;
  38 with Nmake;          use Nmake;
  39 with Opt;            use Opt;
  40 with Sem;            use Sem;
  41 with Sem_Aux;        use Sem_Aux;
  42 with Sem_Ch3;        use Sem_Ch3;
  43 with Sem_Ch8;        use Sem_Ch8;
  44 with Sem_Ch13;       use Sem_Ch13;
  45 with Sem_Eval;       use Sem_Eval;
  46 with Sem_Res;        use Sem_Res;
  47 with Sem_Util;       use Sem_Util;
  48 with Sinfo;          use Sinfo;
  49 with Sinfo.Nodes;    use Sinfo.Nodes;
  50 with Sinfo.Utils;    use Sinfo.Utils;
  51 with Snames;         use Snames;
  52 with Stand;          use Stand;
  53 with Targparm;       use Targparm;
  54 with Tbuild;         use Tbuild;
  55 with Ttypes;         use Ttypes;
  56 with Uintp;          use Uintp;
  57
  58 package body Exp_Pakd is
  59
  60    ---------------------------
  61    -- Endian Considerations --
  62    ---------------------------
  63
  64    --  As described in the specification, bit numbering in a packed array
  65    --  is consistent with bit numbering in a record representation clause,
  66    --  and hence dependent on the endianness of the machine:
  67
  68    --    For little-endian machines, element zero is at the right hand end
  69    --    (low order end) of a bit field.
  70
  71    --    For big-endian machines, element zero is at the left hand end
  72    --    (high order end) of a bit field.
  73
  74    --  The shifts that are used to right justify a field therefore differ in
  75    --  the two cases. For the little-endian case, we can simply use the bit
  76    --  number (i.e. the element number * element size) as the count for a right
  77    --  shift. For the big-endian case, we have to subtract the shift count from
  78    --  an appropriate constant to use in the right shift. We use rotates
  79    --  instead of shifts (which is necessary in the store case to preserve
  80    --  other fields), and we expect that the backend will be able to change the
  81    --  right rotate into a left rotate, avoiding the subtract, if the machine
  82    --  architecture provides such an instruction.
  83
  84    -----------------------
  85    -- Local Subprograms --
  86    -----------------------
  87
  88    procedure Compute_Linear_Subscript
  89      (Atyp   : Entity_Id;
  90       N      : Node_Id;
  91       Subscr : out Node_Id);
  92    --  Given a constrained array type Atyp, and an indexed component node N
  93    --  referencing an array object of this type, build an expression of type
  94    --  Standard.Integer representing the zero-based linear subscript value.
  95    --  This expression includes any required range checks.
  96
  97    function Compute_Number_Components
  98       (N   : Node_Id;
  99        Typ : Entity_Id) return Node_Id;
 100    --  Build an expression that multiplies the length of the dimensions of the
 101    --  array, used to control array equality checks.
 102
 103    procedure Convert_To_PAT_Type (Aexp : Node_Id);
 104    --  Given an expression of a packed array type, builds a corresponding
 105    --  expression whose type is the implementation type used to represent
 106    --  the packed array. Aexp is analyzed and resolved on entry and on exit.
 107
 108    procedure Get_Base_And_Bit_Offset
 109      (N      : Node_Id;
 110       Base   : out Node_Id;
 111       Offset : out Node_Id);
 112    --  Given a node N for a name which involves a packed array reference,
 113    --  return the base object of the reference and build an expression of
 114    --  type Standard.Integer representing the zero-based offset in bits
 115    --  from Base'Address to the first bit of the reference.
 116
 117    function Known_Aligned_Enough (Obj : Node_Id; Csiz : Nat) return Boolean;
 118    --  There are two versions of the Set routines, the ones used when the
 119    --  object is known to be sufficiently well aligned given the number of
 120    --  bits, and the ones used when the object is not known to be aligned.
 121    --  This routine is used to determine which set to use. Obj is a reference
 122    --  to the object, and Csiz is the component size of the packed array.
 123    --  True is returned if the alignment of object is known to be sufficient,
 124    --  defined as 1 for odd bit sizes, 4 for bit sizes divisible by 4, and
 125    --  2 otherwise.
 126
 127    function Make_Shift_Left (N : Node_Id; S : Node_Id) return Node_Id;
 128    --  Build a left shift node, checking for the case of a shift count of zero
 129
 130    function Make_Shift_Right (N : Node_Id; S : Node_Id) return Node_Id;
 131    --  Build a right shift node, checking for the case of a shift count of zero
 132
 133    function RJ_Unchecked_Convert_To
 134      (Typ  : Entity_Id;
 135       Expr : Node_Id) return Node_Id;
 136    --  The packed array code does unchecked conversions which in some cases
 137    --  may involve non-discrete types with differing sizes. The semantics of
 138    --  such conversions is potentially endianness dependent, and the effect
 139    --  we want here for such a conversion is to do the conversion in size as
 140    --  though numeric items are involved, and we extend or truncate on the
 141    --  left side. This happens naturally in the little-endian case, but in
 142    --  the big endian case we can get left justification, when what we want
 143    --  is right justification. This routine does the unchecked conversion in
 144    --  a stepwise manner to ensure that it gives the expected result. Hence
 145    --  the name (RJ = Right justified). The parameters Typ and Expr are as
 146    --  for the case of a normal Unchecked_Convert_To call.
 147
 148    procedure Setup_Enumeration_Packed_Array_Reference (N : Node_Id);
 149    --  This routine is called in the Get and Set case for arrays that are
 150    --  packed but not bit-packed, meaning that they have at least one
 151    --  subscript that is of an enumeration type with a non-standard
 152    --  representation. This routine modifies the given node to properly
 153    --  reference the corresponding packed array type.
 154
 155    procedure Setup_Inline_Packed_Array_Reference
 156      (N      : Node_Id;
 157       Atyp   : Entity_Id;
 158       Obj    : in out Node_Id;
 159       Cmask  : out Uint;
 160       Shift  : out Node_Id);
 161    --  This procedure performs common processing on the N_Indexed_Component
 162    --  parameter given as N, whose prefix is a reference to a packed array.
 163    --  This is used for the get and set when the component size is 1, 2, 4,
 164    --  or for other component sizes when the packed array type is a modular
 165    --  type (i.e. the cases that are handled with inline code).
 166    --
 167    --  On entry:
 168    --
 169    --    N is the N_Indexed_Component node for the packed array reference
 170    --
 171    --    Atyp is the constrained array type (the actual subtype has been
 172    --    computed if necessary to obtain the constraints, but this is still
 173    --    the original array type, not the Packed_Array_Impl_Type value).
 174    --
 175    --    Obj is the object which is to be indexed. It is always of type Atyp.
 176    --
 177    --  On return:
 178    --
 179    --    Obj is the object containing the desired bit field. It is of type
 180    --    Unsigned, Long_Unsigned, or Long_Long_Unsigned, and is either the
 181    --    entire value, for the small static case, or the proper selected byte
 182    --    from the array in the large or dynamic case. This node is analyzed
 183    --    and resolved on return.
 184    --
 185    --    Shift is a node representing the shift count to be used in the
 186    --    rotate right instruction that positions the field for access.
 187    --    This node is analyzed and resolved on return.
 188    --
 189    --    Cmask is a mask corresponding to the width of the component field.
 190    --    Its value is 2 ** Csize - 1 (e.g. 2#1111# for component size of 4).
 191    --
 192    --  Note: in some cases the call to this routine may generate actions
 193    --  (for handling multi-use references and the generation of the packed
 194    --  array type on the fly). Such actions are inserted into the tree
 195    --  directly using Insert_Action.
 196
 197    function Revert_Storage_Order (N : Node_Id) return Node_Id;
 198    --  Perform appropriate justification and byte ordering adjustments for N,
 199    --  an element of a packed array type, when both the component type and
 200    --  the enclosing packed array type have reverse scalar storage order.
 201    --  On little-endian targets, the value is left justified before byte
 202    --  swapping. The Etype of the returned expression is an integer type of
 203    --  an appropriate power-of-2 size.
 204
 205    --------------------------
 206    -- Revert_Storage_Order --
 207    --------------------------
 208
 209    function Revert_Storage_Order (N : Node_Id) return Node_Id is
 210       Loc     : constant Source_Ptr := Sloc (N);
 211       T       : constant Entity_Id := Etype (N);
 212       T_Size  : constant Uint := RM_Size (T);
 213
 214       Swap_RE : RE_Id;
 215       Swap_F  : Entity_Id;
 216       Swap_T  : Entity_Id;
 217       --  Swapping function
 218
 219       Arg      : Node_Id;
 220       Adjusted : Node_Id;
 221       Shift    : Uint;
 222
 223    begin
 224       if T_Size <= 8 then
 225
 226          --  Array component size is less than a byte: no swapping needed
 227
 228          Swap_F := Empty;
 229          Swap_T := RTE (RE_Unsigned_8);
 230
 231       else
 232          --  Select byte swapping function depending on array component size
 233
 234          if T_Size <= 16 then
 235             Swap_RE := RE_Bswap_16;
 236
 237          elsif T_Size <= 32 then
 238             Swap_RE := RE_Bswap_32;
 239
 240          elsif T_Size <= 64 then
 241             Swap_RE := RE_Bswap_64;
 242
 243          else pragma Assert (T_Size <= 128);
 244             Swap_RE := RE_Bswap_128;
 245          end if;
 246
 247          Swap_F := RTE (Swap_RE);
 248          Swap_T := Etype (Swap_F);
 249
 250       end if;
 251
 252       Shift := Esize (Swap_T) - T_Size;
 253
 254       Arg := RJ_Unchecked_Convert_To (Swap_T, N);
 255
 256       if not Bytes_Big_Endian and then Shift > Uint_0 then
 257          Arg :=
 258            Make_Op_Shift_Left (Loc,
 259              Left_Opnd  => Arg,
 260              Right_Opnd => Make_Integer_Literal (Loc, Shift));
 261       end if;
 262
 263       if Present (Swap_F) then
 264          Adjusted :=
 265            Make_Function_Call (Loc,
 266              Name                   => New_Occurrence_Of (Swap_F, Loc),
 267              Parameter_Associations => New_List (Arg));
 268       else
 269          Adjusted := Arg;
 270       end if;
 271
 272       Set_Etype (Adjusted, Swap_T);
 273       return Adjusted;
 274    end Revert_Storage_Order;
 275
 276    ------------------------------
 277    -- Compute_Linear_Subscript --
 278    ------------------------------
 279
 280    procedure Compute_Linear_Subscript
 281      (Atyp   : Entity_Id;
 282       N      : Node_Id;
 283       Subscr : out Node_Id)
 284    is
 285       Loc    : constant Source_Ptr := Sloc (N);
 286       Oldsub : Node_Id;
 287       Newsub : Node_Id;
 288       Indx   : Node_Id;
 289       Styp   : Entity_Id;
 290
 291    begin
 292       Subscr := Empty;
 293
 294       --  Loop through dimensions
 295
 296       Indx   := First_Index (Atyp);
 297       Oldsub := First (Expressions (N));
 298
 299       while Present (Indx) loop
 300          Styp := Etype (Indx);
 301          Newsub := Relocate_Node (Oldsub);
 302
 303          --  Get expression for the subscript value. First, if Do_Range_Check
 304          --  is set on a subscript, then we must do a range check against the
 305          --  original bounds (not the bounds of the packed array type). We do
 306          --  this by introducing a subtype conversion.
 307
 308          if Do_Range_Check (Newsub)
 309            and then Etype (Newsub) /= Styp
 310          then
 311             Newsub := Convert_To (Styp, Newsub);
 312          end if;
 313
 314          --  Now evolve the expression for the subscript. First convert
 315          --  the subscript to be zero based and of an integer type.
 316
 317          --  Case of integer type, where we just subtract to get lower bound
 318
 319          if Is_Integer_Type (Styp) then
 320
 321             --  If length of integer type is smaller than standard integer,
 322             --  then we convert to integer first, then do the subtract
 323
 324             --  Integer (subscript) - Integer (Styp'First)
 325
 326             if Esize (Styp) < Standard_Integer_Size then
 327                Newsub :=
 328                  Make_Op_Subtract (Loc,
 329                    Left_Opnd => Convert_To (Standard_Integer, Newsub),
 330                  Right_Opnd =>
 331                    Convert_To (Standard_Integer,
 332                      Make_Attribute_Reference (Loc,
 333                        Prefix         => New_Occurrence_Of (Styp, Loc),
 334                        Attribute_Name => Name_First)));
 335
 336             --  For larger integer types, subtract first, then convert to
 337             --  integer, this deals with strange long long integer bounds.
 338
 339             --    Integer (subscript - Styp'First)
 340
 341             else
 342                Newsub :=
 343                  Convert_To (Standard_Integer,
 344                    Make_Op_Subtract (Loc,
 345                      Left_Opnd => Newsub,
 346                    Right_Opnd =>
 347                      Make_Attribute_Reference (Loc,
 348                        Prefix         => New_Occurrence_Of (Styp, Loc),
 349                        Attribute_Name => Name_First)));
 350             end if;
 351
 352          --  For the enumeration case, we have to use 'Pos to get the value
 353          --  to work with before subtracting the lower bound.
 354
 355          --    Integer (Styp'Pos (subscr)) - Integer (Styp'Pos (Styp'First));
 356
 357          --  This is not quite right for bizarre cases where the size of the
 358          --  enumeration type is > Integer'Size bits due to rep clause ???
 359
 360          else
 361             pragma Assert (Is_Enumeration_Type (Styp));
 362
 363             Newsub :=
 364               Make_Op_Subtract (Loc,
 365                 Left_Opnd => Convert_To (Standard_Integer,
 366                   Make_Attribute_Reference (Loc,
 367                     Prefix         => New_Occurrence_Of (Styp, Loc),
 368                     Attribute_Name => Name_Pos,
 369                     Expressions    => New_List (Newsub))),
 370
 371                 Right_Opnd =>
 372                   Convert_To (Standard_Integer,
 373                     Make_Attribute_Reference (Loc,
 374                       Prefix         => New_Occurrence_Of (Styp, Loc),
 375                       Attribute_Name => Name_Pos,
 376                       Expressions    => New_List (
 377                         Make_Attribute_Reference (Loc,
 378                           Prefix         => New_Occurrence_Of (Styp, Loc),
 379                           Attribute_Name => Name_First)))));
 380          end if;
 381
 382          Set_Paren_Count (Newsub, 1);
 383
 384          --  For the first subscript, we just copy that subscript value
 385
 386          if No (Subscr) then
 387             Subscr := Newsub;
 388
 389          --  Otherwise, we must multiply what we already have by the current
 390          --  stride and then add in the new value to the evolving subscript.
 391
 392          else
 393             Subscr :=
 394               Make_Op_Add (Loc,
 395                 Left_Opnd =>
 396                   Make_Op_Multiply (Loc,
 397                     Left_Opnd  => Subscr,
 398                     Right_Opnd =>
 399                       Make_Attribute_Reference (Loc,
 400                         Attribute_Name => Name_Range_Length,
 401                         Prefix         => New_Occurrence_Of (Styp, Loc))),
 402                 Right_Opnd => Newsub);
 403          end if;
 404
 405          --  Move to next subscript
 406
 407          Next_Index (Indx);
 408          Next (Oldsub);
 409       end loop;
 410    end Compute_Linear_Subscript;
 411
 412    -------------------------------
 413    -- Compute_Number_Components --
 414    -------------------------------
 415
 416    function Compute_Number_Components
 417       (N   : Node_Id;
 418        Typ : Entity_Id) return Node_Id
 419    is
 420       Loc      : constant Source_Ptr := Sloc (N);
 421       Len_Expr : Node_Id;
 422
 423    begin
 424       Len_Expr :=
 425         Make_Attribute_Reference (Loc,
 426           Attribute_Name => Name_Length,
 427           Prefix         => New_Occurrence_Of (Typ, Loc),
 428           Expressions    => New_List (Make_Integer_Literal (Loc, 1)));
 429
 430       for J in 2 .. Number_Dimensions (Typ) loop
 431          Len_Expr :=
 432            Make_Op_Multiply (Loc,
 433              Left_Opnd  => Len_Expr,
 434              Right_Opnd =>
 435                Make_Attribute_Reference (Loc,
 436                 Attribute_Name => Name_Length,
 437                 Prefix         => New_Occurrence_Of (Typ, Loc),
 438                 Expressions    => New_List (Make_Integer_Literal (Loc, J))));
 439       end loop;
 440
 441       return Len_Expr;
 442    end Compute_Number_Components;
 443
 444    -------------------------
 445    -- Convert_To_PAT_Type --
 446    -------------------------
 447
 448    --  The PAT is always obtained from the actual subtype
 449
 450    procedure Convert_To_PAT_Type (Aexp : Node_Id) is
 451       Act_ST : Entity_Id;
 452
 453    begin
 454       Convert_To_Actual_Subtype (Aexp);
 455       Act_ST := Underlying_Type (Etype (Aexp));
 456       Create_Packed_Array_Impl_Type (Act_ST);
 457
 458       --  Just replace the etype with the packed array type. This works because
 459       --  the expression will not be further analyzed, and Gigi considers the
 460       --  two types equivalent in any case.
 461
 462       --  This is not strictly the case ??? If the reference is an actual in
 463       --  call, the expansion of the prefix is delayed, and must be reanalyzed,
 464       --  see Reset_Packed_Prefix. On the other hand, if the prefix is a simple
 465       --  array reference, reanalysis can produce spurious type errors when the
 466       --  PAT type is replaced again with the original type of the array. Same
 467       --  for the case of a dereference. Ditto for function calls: expansion
 468       --  may introduce additional actuals which will trigger errors if call is
 469       --  reanalyzed. The following is correct and minimal, but the handling of
 470       --  more complex packed expressions in actuals is confused. Probably the
 471       --  problem only remains for actuals in calls.
 472
 473       Set_Etype (Aexp, Packed_Array_Impl_Type (Act_ST));
 474
 475       if Is_Entity_Name (Aexp)
 476         or else
 477            (Nkind (Aexp) = N_Indexed_Component
 478              and then Is_Entity_Name (Prefix (Aexp)))
 479         or else Nkind (Aexp) in N_Explicit_Dereference | N_Function_Call
 480       then
 481          Set_Analyzed (Aexp);
 482       end if;
 483    end Convert_To_PAT_Type;
 484
 485    -----------------------------------
 486    -- Create_Packed_Array_Impl_Type --
 487    -----------------------------------
 488
 489    procedure Create_Packed_Array_Impl_Type (Typ : Entity_Id) is
 490       Loc      : constant Source_Ptr := Sloc (Typ);
 491       Ctyp     : constant Entity_Id  := Component_Type (Typ);
 492       Csize    : constant Uint       := Component_Size (Typ);
 493
 494       Ancest   : Entity_Id;
 495       PB_Type  : Entity_Id;
 496       PASize   : Uint := No_Uint;
 497       Decl     : Node_Id;
 498       PAT      : Entity_Id;
 499       Len_Expr : Node_Id;
 500       Len_Bits : Uint;
 501       Bits_U1  : Node_Id;
 502       PAT_High : Node_Id;
 503       Btyp     : Entity_Id;
 504       Lit      : Node_Id;
 505
 506       procedure Install_PAT;
 507       --  This procedure is called with Decl set to the declaration for the
 508       --  packed array type. It creates the type and installs it as required.
 509
 510       procedure Set_PB_Type;
 511       --  Set PB_Type to [Rev_]Packed_Bytes{1,2,4} as required by the alignment
 512       --  and the scalar storage order requirements (see documentation in the
 513       --  spec of this package).
 514
 515       -----------------
 516       -- Install_PAT --
 517       -----------------
 518
 519       procedure Install_PAT is
 520          Pushed_Scope : Boolean := False;
 521
 522       begin
 523          --  We do not want to put the declaration we have created in the tree
 524          --  since it is often hard, and sometimes impossible to find a proper
 525          --  place for it (the impossible case arises for a packed array type
 526          --  with bounds depending on the discriminant, a declaration cannot
 527          --  be put inside the record, and the reference to the discriminant
 528          --  cannot be outside the record).
 529
 530          --  The solution is to analyze the declaration while temporarily
 531          --  attached to the tree at an appropriate point, and then we install
 532          --  the resulting type as an Itype in the packed array type field of
 533          --  the original type, so that no explicit declaration is required.
 534
 535          --  Note: the packed type is created in the scope of its parent type.
 536          --  There are at least some cases where the current scope is deeper,
 537          --  and so when this is the case, we temporarily reset the scope
 538          --  for the definition. This is clearly safe, since the first use
 539          --  of the packed array type will be the implicit reference from
 540          --  the corresponding unpacked type when it is elaborated.
 541
 542          if Is_Itype (Typ) then
 543             Set_Parent (Decl, Associated_Node_For_Itype (Typ));
 544          else
 545             Set_Parent (Decl, Declaration_Node (Typ));
 546          end if;
 547
 548          if Scope (Typ) /= Current_Scope then
 549             Push_Scope (Scope (Typ));
 550             Pushed_Scope := True;
 551          end if;
 552
 553          Set_Is_Itype (PAT, True);
 554          Set_Is_Packed_Array_Impl_Type (PAT, True);
 555          Set_Packed_Array_Impl_Type (Typ, PAT);
 556          Analyze (Decl, Suppress => All_Checks);
 557
 558          if Pushed_Scope then
 559             Pop_Scope;
 560          end if;
 561
 562          --  Set Esize and RM_Size to the actual size of the packed object
 563          --  Do not reset RM_Size if already set, as happens in the case of
 564          --  a modular type.
 565
 566          if Present (PASize) then
 567             if not Known_Esize (PAT) then
 568                Set_Esize (PAT, PASize);
 569             end if;
 570
 571             if not Known_RM_Size (PAT) then
 572                Set_RM_Size (PAT, PASize);
 573             end if;
 574          end if;
 575
 576          Adjust_Esize_Alignment (PAT);
 577
 578          --  Set remaining fields of packed array type
 579
 580          Reinit_Alignment              (PAT);
 581          Set_Parent                    (PAT, Empty);
 582          Set_Associated_Node_For_Itype (PAT, Typ);
 583          Set_Original_Array_Type       (PAT, Typ);
 584
 585          --  Propagate representation aspects
 586
 587          Set_Is_Atomic               (PAT, Is_Atomic                (Typ));
 588          Set_Is_Independent          (PAT, Is_Independent           (Typ));
 589          Set_Is_Volatile             (PAT, Is_Volatile              (Typ));
 590          Set_Is_Volatile_Full_Access (PAT, Is_Volatile_Full_Access  (Typ));
 591          Set_Treat_As_Volatile       (PAT, Treat_As_Volatile        (Typ));
 592
 593          --  We definitely do not want to delay freezing for packed array
 594          --  types. This is of particular importance for the itypes that are
 595          --  generated for record components depending on discriminants where
 596          --  there is no place to put the freeze node.
 597
 598          Set_Has_Delayed_Freeze (PAT, False);
 599          Set_Has_Delayed_Freeze (Etype (PAT), False);
 600
 601          --  If we did allocate a freeze node, then clear out the reference
 602          --  since it is obsolete (should we delete the freeze node???)
 603
 604          Set_Freeze_Node (PAT, Empty);
 605          Set_Freeze_Node (Etype (PAT), Empty);
 606       end Install_PAT;
 607
 608       -----------------
 609       -- Set_PB_Type --
 610       -----------------
 611
 612       procedure Set_PB_Type is
 613       begin
 614          --  If the user has specified an explicit alignment for the
 615          --  type or component, take it into account.
 616
 617          if Csize <= 2 or else Csize = 4 or else Csize mod 2 /= 0
 618            or else (Known_Alignment (Typ) and then Alignment (Typ) = 1)
 619            or else Component_Alignment (Typ) = Calign_Storage_Unit
 620          then
 621             if Reverse_Storage_Order (Typ) then
 622                PB_Type := RTE (RE_Rev_Packed_Bytes1);
 623             else
 624                PB_Type := RTE (RE_Packed_Bytes1);
 625             end if;
 626
 627          elsif Csize mod 4 /= 0
 628            or else (Known_Alignment (Typ) and then Alignment (Typ) = 2)
 629          then
 630             if Reverse_Storage_Order (Typ) then
 631                PB_Type := RTE (RE_Rev_Packed_Bytes2);
 632             else
 633                PB_Type := RTE (RE_Packed_Bytes2);
 634             end if;
 635
 636          else
 637             if Reverse_Storage_Order (Typ) then
 638                PB_Type := RTE (RE_Rev_Packed_Bytes4);
 639             else
 640                PB_Type := RTE (RE_Packed_Bytes4);
 641             end if;
 642          end if;
 643
 644          --  The Rev_Packed_Bytes{1,2,4} types cannot be directly declared with
 645          --  the reverse scalar storage order in System.Unsigned_Types because
 646          --  their component type is aliased and the combination would then be
 647          --  flagged as illegal by the compiler. Moreover changing the compiler
 648          --  would not address the bootstrap path issue with earlier versions.
 649
 650          Set_Reverse_Storage_Order (PB_Type, Reverse_Storage_Order (Typ));
 651       end Set_PB_Type;
 652
 653    --  Start of processing for Create_Packed_Array_Impl_Type
 654
 655    begin
 656       --  If we already have a packed array type, nothing to do
 657
 658       if Present (Packed_Array_Impl_Type (Typ)) then
 659          return;
 660       end if;
 661
 662       --  If our immediate ancestor subtype is constrained, and it already
 663       --  has a packed array type, then just share the same type, since the
 664       --  bounds must be the same. If the ancestor is not an array type but
 665       --  a private type, as can happen with multiple instantiations, create
 666       --  a new packed type, to avoid privacy issues.
 667
 668       if Ekind (Typ) = E_Array_Subtype then
 669          Ancest := Ancestor_Subtype (Typ);
 670
 671          if Present (Ancest)
 672            and then Is_Array_Type (Ancest)
 673            and then Is_Constrained (Ancest)
 674            and then Present (Packed_Array_Impl_Type (Ancest))
 675          then
 676             Set_Packed_Array_Impl_Type (Typ, Packed_Array_Impl_Type (Ancest));
 677             return;
 678          end if;
 679       end if;
 680
 681       --  We preset the result type size from the size of the original array
 682       --  type, since this size clearly belongs to the packed array type. The
 683       --  size of the conceptual unpacked type is always set to unknown.
 684
 685       if Known_RM_Size (Typ) then
 686          PASize := RM_Size (Typ);
 687       end if;
 688
 689       --  Case of an array where at least one index is of an enumeration
 690       --  type with a non-standard representation, but the component size
 691       --  is not appropriate for bit packing. This is the case where we
 692       --  have Is_Packed set (we would never be in this unit otherwise),
 693       --  but Is_Bit_Packed_Array is false.
 694
 695       --  Note that if the component size is appropriate for bit packing,
 696       --  then the circuit for the computation of the subscript properly
 697       --  deals with the non-standard enumeration type case by taking the
 698       --  Pos anyway.
 699
 700       if not Is_Bit_Packed_Array (Typ) then
 701
 702          --  Here we build a declaration:
 703
 704          --    type tttP is array (index1, index2, ...) of component_type
 705
 706          --  where index1, index2, are the index types. These are the same
 707          --  as the index types of the original array, except for the non-
 708          --  standard representation enumeration type case, where we have
 709          --  two subcases.
 710
 711          --  For the unconstrained array case, we use
 712
 713          --    Natural range <>
 714
 715          --  For the constrained case, we use
 716
 717          --    Natural range Enum_Type'Pos (Enum_Type'First) ..
 718          --                  Enum_Type'Pos (Enum_Type'Last);
 719
 720          --  Note that tttP is created even if no index subtype is a non
 721          --  standard enumeration, because we still need to remove padding
 722          --  normally inserted for component alignment.
 723
 724          PAT :=
 725            Make_Defining_Identifier (Loc,
 726              Chars => New_External_Name (Chars (Typ), 'P'));
 727
 728          declare
 729             Indexes   : constant List_Id := New_List;
 730             Indx      : Node_Id;
 731             Indx_Typ  : Entity_Id;
 732             Enum_Case : Boolean;
 733             Typedef   : Node_Id;
 734
 735          begin
 736             Indx := First_Index (Typ);
 737
 738             while Present (Indx) loop
 739                Indx_Typ := Etype (Indx);
 740
 741                Enum_Case := Is_Enumeration_Type (Indx_Typ)
 742                               and then Has_Non_Standard_Rep (Indx_Typ);
 743
 744                --  Unconstrained case
 745
 746                if not Is_Constrained (Typ) then
 747                   if Enum_Case then
 748                      Indx_Typ := Standard_Natural;
 749                   end if;
 750
 751                   Append_To (Indexes, New_Occurrence_Of (Indx_Typ, Loc));
 752
 753                --  Constrained case
 754
 755                else
 756                   if not Enum_Case then
 757                      Append_To (Indexes, New_Occurrence_Of (Indx_Typ, Loc));
 758
 759                   else
 760                      Append_To (Indexes,
 761                        Make_Subtype_Indication (Loc,
 762                          Subtype_Mark =>
 763                            New_Occurrence_Of (Standard_Natural, Loc),
 764                          Constraint =>
 765                            Make_Range_Constraint (Loc,
 766                              Range_Expression =>
 767                                Make_Range (Loc,
 768                                  Low_Bound =>
 769                                    Make_Attribute_Reference (Loc,
 770                                      Prefix         =>
 771                                        New_Occurrence_Of (Indx_Typ, Loc),
 772                                      Attribute_Name => Name_Pos,
 773                                      Expressions    => New_List (
 774                                        Make_Attribute_Reference (Loc,
 775                                          Prefix         =>
 776                                            New_Occurrence_Of (Indx_Typ, Loc),
 777                                          Attribute_Name => Name_First))),
 778
 779                                  High_Bound =>
 780                                    Make_Attribute_Reference (Loc,
 781                                      Prefix         =>
 782                                        New_Occurrence_Of (Indx_Typ, Loc),
 783                                      Attribute_Name => Name_Pos,
 784                                      Expressions    => New_List (
 785                                        Make_Attribute_Reference (Loc,
 786                                          Prefix         =>
 787                                            New_Occurrence_Of (Indx_Typ, Loc),
 788                                          Attribute_Name => Name_Last)))))));
 789
 790                   end if;
 791                end if;
 792
 793                Next_Index (Indx);
 794             end loop;
 795
 796             if not Is_Constrained (Typ) then
 797                Typedef :=
 798                  Make_Unconstrained_Array_Definition (Loc,
 799                    Subtype_Marks => Indexes,
 800                    Component_Definition =>
 801                      Make_Component_Definition (Loc,
 802                        Aliased_Present    => False,
 803                        Subtype_Indication =>
 804                           New_Occurrence_Of (Ctyp, Loc)));
 805
 806             else
 807                Typedef :=
 808                   Make_Constrained_Array_Definition (Loc,
 809                     Discrete_Subtype_Definitions => Indexes,
 810                     Component_Definition =>
 811                       Make_Component_Definition (Loc,
 812                         Aliased_Present    => False,
 813                         Subtype_Indication =>
 814                           New_Occurrence_Of (Ctyp, Loc)));
 815             end if;
 816
 817             Decl :=
 818               Make_Full_Type_Declaration (Loc,
 819                 Defining_Identifier => PAT,
 820                 Type_Definition     => Typedef);
 821          end;
 822
 823          Install_PAT;
 824
 825          --  Propagate the reverse storage order flag to the base type
 826
 827          Set_Reverse_Storage_Order (Etype (PAT), Reverse_Storage_Order (Typ));
 828          return;
 829
 830       --  Case of bit-packing required for unconstrained array. We create
 831       --  a subtype that is equivalent to use Packed_Bytes{1,2,4} as needed.
 832
 833       elsif not Is_Constrained (Typ) then
 834
 835          --  When generating standard DWARF (i.e when GNAT_Encodings is not
 836          --  DWARF_GNAT_Encodings_All), the ___XP suffix will be stripped
 837          --  by the back-end but generate it anyway to ease compiler debugging.
 838          --  This will help to distinguish implementation types from original
 839          --  packed arrays.
 840
 841          PAT :=
 842            Make_Defining_Identifier (Loc,
 843              Chars => Make_Packed_Array_Impl_Type_Name (Typ, Csize));
 844
 845          Set_PB_Type;
 846
 847          Decl :=
 848            Make_Subtype_Declaration (Loc,
 849              Defining_Identifier => PAT,
 850                Subtype_Indication => New_Occurrence_Of (PB_Type, Loc));
 851
 852          Install_PAT;
 853          return;
 854
 855       --  Remaining code is for the case of bit-packing for constrained array
 856
 857       --  The name of the packed array subtype is
 858
 859       --    ttt___XPsss
 860
 861       --  where sss is the component size in bits and ttt is the name of
 862       --  the parent packed type.
 863
 864       else
 865          PAT :=
 866            Make_Defining_Identifier (Loc,
 867              Chars => Make_Packed_Array_Impl_Type_Name (Typ, Csize));
 868
 869          --  Build an expression for the length of the array in bits.
 870          --  This is the product of the length of each of the dimensions
 871
 872          Len_Expr := Compute_Number_Components (Typ, Typ);
 873
 874          --  Temporarily attach the length expression to the tree and analyze
 875          --  and resolve it, so that we can test its value. We assume that the
 876          --  total length fits in type Integer. This expression may involve
 877          --  discriminants, so we treat it as a default/per-object expression.
 878
 879          Set_Parent (Len_Expr, Typ);
 880          Preanalyze_Spec_Expression (Len_Expr, Standard_Long_Long_Integer);
 881
 882          --  Use a modular type if possible. We can do this if we have
 883          --  static bounds, and the length is small enough, and the length
 884          --  is not zero. We exclude the zero length case because the size
 885          --  of things is always at least one, and the zero length object
 886          --  would have an anomalous size.
 887
 888          if Compile_Time_Known_Value (Len_Expr) then
 889             Len_Bits := Expr_Value (Len_Expr) * Csize;
 890
 891             --  Check for size known to be too large
 892
 893             if Len_Bits >
 894               Uint_2 ** (Standard_Integer_Size - 1) * System_Storage_Unit
 895             then
 896                if System_Storage_Unit = 8 then
 897                   Error_Msg_N
 898                     ("packed array size cannot exceed " &
 899                      "Integer''Last bytes", Typ);
 900                else
 901                   Error_Msg_N
 902                     ("packed array size cannot exceed " &
 903                      "Integer''Last storage units", Typ);
 904                end if;
 905
 906                --  Reset length to arbitrary not too high value to continue
 907
 908                Len_Expr := Make_Integer_Literal (Loc, 65535);
 909                Analyze_And_Resolve (Len_Expr, Standard_Long_Long_Integer);
 910             end if;
 911
 912             --  We normally consider small enough to mean no larger than the
 913             --  value of System_Max_Binary_Modulus_Power, checking that in the
 914             --  case of values longer than word size, we have long shifts.
 915
 916             if Len_Bits > 0
 917               and then
 918                 (Len_Bits <= System_Word_Size
 919                    or else (Len_Bits <= System_Max_Binary_Modulus_Power
 920                               and then Support_Long_Shifts_On_Target))
 921             then
 922                --  We can use the modular type, it has the form:
 923
 924                --    subtype tttPn is btyp
 925                --      range 0 .. 2 ** ((Typ'Length (1)
 926                --                * ... * Typ'Length (n)) * Csize) - 1;
 927
 928                --  The bounds are statically known, and btyp is one of the
 929                --  unsigned types, depending on the length.
 930
 931                Btyp := Small_Integer_Type_For (Len_Bits, Uns => True);
 932                Lit := Make_Integer_Literal (Loc, 2 ** Len_Bits - 1);
 933                Set_Print_In_Hex (Lit);
 934
 935                Decl :=
 936                  Make_Subtype_Declaration (Loc,
 937                    Defining_Identifier => PAT,
 938                      Subtype_Indication =>
 939                        Make_Subtype_Indication (Loc,
 940                          Subtype_Mark => New_Occurrence_Of (Btyp, Loc),
 941
 942                          Constraint =>
 943                            Make_Range_Constraint (Loc,
 944                              Range_Expression =>
 945                                Make_Range (Loc,
 946                                  Low_Bound =>
 947                                    Make_Integer_Literal (Loc, 0),
 948                                  High_Bound => Lit))));
 949
 950                if Present (PASize) then
 951                   PASize := Len_Bits;
 952                end if;
 953
 954                Install_PAT;
 955
 956                --  Propagate a given alignment to the modular type. This can
 957                --  cause it to be under-aligned, but that's OK.
 958
 959                if Present (Alignment_Clause (Typ)) then
 960                   Set_Alignment (PAT, Alignment (Typ));
 961                end if;
 962
 963                return;
 964             end if;
 965          end if;
 966
 967          --  Could not use a modular type, for all other cases, we build
 968          --  a packed array subtype:
 969
 970          --    subtype tttPn is
 971          --      System.Packed_Bytes{1,2,4} (0 .. (Bits + 7) / 8 - 1);
 972
 973          --  Bits is the length of the array in bits
 974
 975          Set_PB_Type;
 976
 977          Bits_U1 :=
 978            Make_Op_Add (Loc,
 979              Left_Opnd =>
 980                Make_Op_Multiply (Loc,
 981                  Left_Opnd  =>
 982                    Make_Integer_Literal (Loc, Csize),
 983                  Right_Opnd => Len_Expr),
 984
 985              Right_Opnd =>
 986                Make_Integer_Literal (Loc, 7));
 987
 988          Set_Paren_Count (Bits_U1, 1);
 989
 990          PAT_High :=
 991            Make_Op_Subtract (Loc,
 992              Left_Opnd =>
 993                Make_Op_Divide (Loc,
 994                  Left_Opnd => Bits_U1,
 995                  Right_Opnd => Make_Integer_Literal (Loc, 8)),
 996              Right_Opnd => Make_Integer_Literal (Loc, 1));
 997
 998          Decl :=
 999            Make_Subtype_Declaration (Loc,
1000              Defining_Identifier => PAT,
1001                Subtype_Indication =>
1002                  Make_Subtype_Indication (Loc,
1003                    Subtype_Mark => New_Occurrence_Of (PB_Type, Loc),
1004                    Constraint =>
1005                      Make_Index_Or_Discriminant_Constraint (Loc,
1006                        Constraints => New_List (
1007                          Make_Range (Loc,
1008                            Low_Bound =>
1009                              Make_Integer_Literal (Loc, 0),
1010                            High_Bound =>
1011                              Convert_To (Standard_Integer, PAT_High))))));
1012
1013          Install_PAT;
1014
1015          --  Currently the code in this unit requires that packed arrays
1016          --  represented by non-modular arrays of bytes be on a byte
1017          --  boundary for bit sizes handled by System.Pack_nn units.
1018          --  That's because these units assume the array being accessed
1019          --  starts on a byte boundary.
1020
1021          if Get_Id (UI_To_Int (Csize)) /= RE_Null then
1022             Set_Must_Be_On_Byte_Boundary (Typ);
1023          end if;
1024       end if;
1025    end Create_Packed_Array_Impl_Type;
1026
1027    -----------------------------------
1028    -- Expand_Bit_Packed_Element_Set --
1029    -----------------------------------
1030
1031    procedure Expand_Bit_Packed_Element_Set (N : Node_Id) is
1032       Loc : constant Source_Ptr := Sloc (N);
1033       Lhs : constant Node_Id    := Name (N);
1034
1035       Ass_OK : constant Boolean := Assignment_OK (Lhs);
1036       --  Used to preserve assignment OK status when assignment is rewritten
1037
1038       Expr : Node_Id;
1039
1040       Rhs  : Node_Id := Expression (N);
1041       --  Initially Rhs is the right hand side value, it will be replaced
1042       --  later by an appropriate unchecked conversion for the assignment.
1043
1044       Obj   : Node_Id;
1045       Atyp  : Entity_Id;
1046       PAT   : Entity_Id;
1047       Ctyp  : Entity_Id;
1048       Csiz  : Int;
1049       Cmask : Uint;
1050
1051       Shift : Node_Id;
1052       --  The expression for the shift value that is required
1053
1054       Shift_Used : Boolean := False;
1055       --  Set True if Shift has been used in the generated code at least once,
1056       --  so that it must be duplicated if used again.
1057
1058       New_Lhs : Node_Id;
1059       New_Rhs : Node_Id;
1060
1061       Rhs_Val_Known : Boolean;
1062       Rhs_Val       : Uint;
1063       --  If the value of the right hand side as an integer constant is
1064       --  known at compile time, Rhs_Val_Known is set True, and Rhs_Val
1065       --  contains the value. Otherwise Rhs_Val_Known is set False, and
1066       --  the Rhs_Val is undefined.
1067
1068       function Get_Shift return Node_Id;
1069       --  Function used to get the value of Shift, making sure that it
1070       --  gets duplicated if the function is called more than once.
1071
1072       ---------------
1073       -- Get_Shift --
1074       ---------------
1075
1076       function Get_Shift return Node_Id is
1077       begin
1078          --  If we used the shift value already, then duplicate it. We
1079          --  set a temporary parent in case actions have to be inserted.
1080
1081          if Shift_Used then
1082             Set_Parent (Shift, N);
1083             return Duplicate_Subexpr_No_Checks (Shift);
1084
1085          --  If first time, use Shift unchanged, and set flag for first use
1086
1087          else
1088             Shift_Used := True;
1089             return Shift;
1090          end if;
1091       end Get_Shift;
1092
1093    --  Start of processing for Expand_Bit_Packed_Element_Set
1094
1095    begin
1096       pragma Assert (Is_Bit_Packed_Array (Etype (Prefix (Lhs))));
1097
1098       Obj := Relocate_Node (Prefix (Lhs));
1099       Convert_To_Actual_Subtype (Obj);
1100       Atyp := Etype (Obj);
1101       PAT  := Packed_Array_Impl_Type (Atyp);
1102       Ctyp := Component_Type (Atyp);
1103       Csiz := UI_To_Int (Component_Size (Atyp));
1104
1105       --  We remove side effects, in case the rhs modifies the lhs, because we
1106       --  are about to transform the rhs into an expression that first READS
1107       --  the lhs, so we can do the necessary shifting and masking. Example:
1108       --  "X(2) := F(...);" where F modifies X(3). Otherwise, the side effect
1109       --  will be lost.
1110
1111       Remove_Side_Effects (Rhs);
1112
1113       --  We convert the right hand side to the proper subtype to ensure
1114       --  that an appropriate range check is made (since the normal range
1115       --  check from assignment will be lost in the transformations). This
1116       --  conversion is analyzed immediately so that subsequent processing
1117       --  can work with an analyzed Rhs (and e.g. look at its Etype)
1118
1119       --  If the right-hand side is a string literal, create a temporary for
1120       --  it, constant-folding is not ready to wrap the bit representation
1121       --  of a string literal.
1122
1123       if Nkind (Rhs) = N_String_Literal then
1124          declare
1125             Decl : Node_Id;
1126          begin
1127             Decl :=
1128               Make_Object_Declaration (Loc,
1129                 Defining_Identifier => Make_Temporary (Loc, 'T', Rhs),
1130                 Object_Definition   => New_Occurrence_Of (Ctyp, Loc),
1131                 Expression          => New_Copy_Tree (Rhs));
1132
1133             Insert_Actions (N, New_List (Decl));
1134             Rhs := New_Occurrence_Of (Defining_Identifier (Decl), Loc);
1135          end;
1136       end if;
1137
1138       Rhs := Convert_To (Ctyp, Rhs);
1139       Set_Parent (Rhs, N);
1140
1141       --  If we are building the initialization procedure for a packed array,
1142       --  and Initialize_Scalars is enabled, each component assignment is an
1143       --  out-of-range value by design. Compile this value without checks,
1144       --  because a call to the array init_proc must not raise an exception.
1145
1146       --  Condition is not consistent with description above, Within_Init_Proc
1147       --  is True also when we are building the IP for a record or protected
1148       --  type that has a packed array component???
1149
1150       if Within_Init_Proc
1151         and then Initialize_Scalars
1152       then
1153          Analyze_And_Resolve (Rhs, Ctyp, Suppress => All_Checks);
1154       else
1155          Analyze_And_Resolve (Rhs, Ctyp);
1156       end if;
1157
1158       --  If any of the indices has a nonstandard representation, introduce
1159       --  the proper Rep_To_Pos conversion, which in turn will generate index
1160       --  checks when needed. We do this on a copy of the index expression,
1161       --  rather that rewriting the LHS altogether.
1162
1163       Expr := First (Expressions (Lhs));
1164       while Present (Expr) loop
1165          declare
1166             Expr_Typ : constant Entity_Id  := Etype (Expr);
1167             Loc      : constant Source_Ptr := Sloc  (Expr);
1168
1169             Expr_Copy : Node_Id;
1170
1171          begin
1172             if Is_Enumeration_Type (Expr_Typ)
1173               and then Has_Non_Standard_Rep (Expr_Typ)
1174             then
1175                Expr_Copy :=
1176                  Make_Attribute_Reference (Loc,
1177                    Prefix         => New_Occurrence_Of (Expr_Typ, Loc),
1178                    Attribute_Name => Name_Pos,
1179                    Expressions    => New_List (Relocate_Node (Expr)));
1180                Set_Parent (Expr_Copy, N);
1181                Analyze_And_Resolve (Expr_Copy, Standard_Natural);
1182             end if;
1183          end;
1184
1185          Next (Expr);
1186       end loop;
1187
1188       --  Case of component size 1,2,4 or any component size for the modular
1189       --  case. These are the cases for which we can inline the code.
1190
1191       if Csiz = 1 or else Csiz = 2 or else Csiz = 4
1192         or else (Present (PAT) and then Is_Modular_Integer_Type (PAT))
1193       then
1194          Setup_Inline_Packed_Array_Reference (Lhs, Atyp, Obj, Cmask, Shift);
1195
1196          --  The statement to be generated is:
1197
1198          --    Obj := atyp!((Obj and Mask1) or (shift_left (rhs, Shift)))
1199
1200          --  or in the case of a freestanding Reverse_Storage_Order object,
1201
1202          --    Obj := Swap (atyp!((Swap (Obj) and Mask1)
1203          --                         or (shift_left (rhs, Shift))))
1204
1205          --      where Mask1 is obtained by shifting Cmask left Shift bits
1206          --      and then complementing the result.
1207
1208          --      the "and Mask1" is omitted if rhs is constant and all 1 bits
1209
1210          --      the "or ..." is omitted if rhs is constant and all 0 bits
1211
1212          --      rhs is converted to the appropriate type
1213
1214          --      The result is converted back to the array type, since
1215          --      otherwise we lose knowledge of the packed nature.
1216
1217          --  Determine if right side is all 0 bits or all 1 bits
1218
1219          if Compile_Time_Known_Value (Rhs) then
1220             Rhs_Val       := Expr_Rep_Value (Rhs);
1221             Rhs_Val_Known := True;
1222
1223          --  The following test catches the case of an unchecked conversion of
1224          --  an integer literal. This results from optimizing aggregates of
1225          --  packed types.
1226
1227          elsif Nkind (Rhs) = N_Unchecked_Type_Conversion
1228            and then Compile_Time_Known_Value (Expression (Rhs))
1229          then
1230             Rhs_Val       := Expr_Rep_Value (Expression (Rhs));
1231             Rhs_Val_Known := True;
1232
1233          else
1234             Rhs_Val       := No_Uint;
1235             Rhs_Val_Known := False;
1236          end if;
1237
1238          --  Some special checks for the case where the right hand value is
1239          --  known at compile time. Basically we have to take care of the
1240          --  implicit conversion to the subtype of the component object.
1241
1242          if Rhs_Val_Known then
1243
1244             --  If we have a biased component type then we must manually do the
1245             --  biasing, since we are taking responsibility in this case for
1246             --  constructing the exact bit pattern to be used.
1247
1248             if Has_Biased_Representation (Ctyp) then
1249                Rhs_Val := Rhs_Val - Expr_Rep_Value (Type_Low_Bound (Ctyp));
1250             end if;
1251
1252             --  For a negative value, we manually convert the two's complement
1253             --  value to a corresponding unsigned value, so that the proper
1254             --  field width is maintained. If we did not do this, we would
1255             --  get too many leading sign bits later on.
1256
1257             if Rhs_Val < 0 then
1258                Rhs_Val := 2 ** UI_From_Int (Csiz) + Rhs_Val;
1259             end if;
1260          end if;
1261
1262          --  Now create copies removing side effects. Note that in some complex
1263          --  cases, this may cause the fact that we have already set a packed
1264          --  array type on Obj to get lost. So we save the type of Obj, and
1265          --  make sure it is reset properly.
1266
1267          declare
1268             T : constant Entity_Id := Etype (Obj);
1269          begin
1270             New_Lhs := Duplicate_Subexpr (Obj, Name_Req => True);
1271             New_Rhs := Duplicate_Subexpr_No_Checks (Obj);
1272             Set_Etype (Obj, T);
1273             Set_Etype (New_Lhs, T);
1274             Set_Etype (New_Rhs, T);
1275          end;
1276
1277          --  First we deal with the "and"
1278
1279          if not Rhs_Val_Known or else Rhs_Val /= Cmask then
1280             declare
1281                Mask1 : Node_Id;
1282                Lit   : Node_Id;
1283
1284             begin
1285                if Compile_Time_Known_Value (Shift) then
1286                   Mask1 :=
1287                     Make_Integer_Literal (Loc,
1288                       Modulus (Etype (Obj)) - 1 -
1289                                  (Cmask * (2 ** Expr_Value (Get_Shift))));
1290                   Set_Print_In_Hex (Mask1);
1291
1292                else
1293                   Lit := Make_Integer_Literal (Loc, Cmask);
1294                   Set_Print_In_Hex (Lit);
1295                   Mask1 :=
1296                     Make_Op_Not (Loc,
1297                       Right_Opnd => Make_Shift_Left (Lit, Get_Shift));
1298                end if;
1299
1300                New_Rhs :=
1301                  Make_Op_And (Loc,
1302                    Left_Opnd  => New_Rhs,
1303                    Right_Opnd => Mask1);
1304             end;
1305          end if;
1306
1307          --  Then deal with the "or"
1308
1309          if not Rhs_Val_Known or else Rhs_Val /= 0 then
1310             declare
1311                Or_Rhs : Node_Id;
1312
1313                procedure Fixup_Rhs;
1314                --  Adjust Rhs by bias if biased representation for components
1315                --  or remove extraneous high order sign bits if signed.
1316
1317                procedure Fixup_Rhs is
1318                   Etyp : constant Entity_Id := Etype (Rhs);
1319
1320                begin
1321                   --  For biased case, do the required biasing by simply
1322                   --  converting to the biased subtype (the conversion
1323                   --  will generate the required bias).
1324
1325                   if Has_Biased_Representation (Ctyp) then
1326                      Rhs := Convert_To (Ctyp, Rhs);
1327
1328                   --  For a signed integer type that is not biased, generate
1329                   --  a conversion to unsigned to strip high order sign bits.
1330
1331                   elsif Is_Signed_Integer_Type (Ctyp) then
1332                      Rhs := Unchecked_Convert_To (RTE (Bits_Id (Csiz)), Rhs);
1333                   end if;
1334
1335                   --  Set Etype, since it can be referenced before the node is
1336                   --  completely analyzed.
1337
1338                   Set_Etype (Rhs, Etyp);
1339
1340                   --  We now need to do an unchecked conversion of the
1341                   --  result to the target type, but it is important that
1342                   --  this conversion be a right justified conversion and
1343                   --  not a left justified conversion.
1344
1345                   Rhs := RJ_Unchecked_Convert_To (Etype (Obj), Rhs);
1346                end Fixup_Rhs;
1347
1348             begin
1349                if Rhs_Val_Known
1350                  and then Compile_Time_Known_Value (Get_Shift)
1351                then
1352                   Or_Rhs :=
1353                     Make_Integer_Literal (Loc,
1354                       Rhs_Val * (2 ** Expr_Value (Get_Shift)));
1355                   Set_Print_In_Hex (Or_Rhs);
1356
1357                else
1358                   --  We have to convert the right hand side to Etype (Obj).
1359                   --  A special case arises if what we have now is a Val
1360                   --  attribute reference whose expression type is Etype (Obj).
1361                   --  This happens for assignments of fields from the same
1362                   --  array. In this case we get the required right hand side
1363                   --  by simply removing the inner attribute reference.
1364
1365                   if Nkind (Rhs) = N_Attribute_Reference
1366                     and then Attribute_Name (Rhs) = Name_Val
1367                     and then Etype (First (Expressions (Rhs))) = Etype (Obj)
1368                   then
1369                      Rhs := Relocate_Node (First (Expressions (Rhs)));
1370                      Fixup_Rhs;
1371
1372                   --  If the value of the right hand side is a known integer
1373                   --  value, then just replace it by an untyped constant,
1374                   --  which will be properly retyped when we analyze and
1375                   --  resolve the expression.
1376
1377                   elsif Rhs_Val_Known then
1378
1379                      --  Note that Rhs_Val has already been normalized to
1380                      --  be an unsigned value with the proper number of bits.
1381
1382                      Rhs := Make_Integer_Literal (Loc, Rhs_Val);
1383
1384                   --  Otherwise we need an unchecked conversion
1385
1386                   else
1387                      Fixup_Rhs;
1388                   end if;
1389
1390                   Or_Rhs := Make_Shift_Left (Rhs, Get_Shift);
1391                end if;
1392
1393                if Nkind (New_Rhs) = N_Op_And then
1394                   Set_Paren_Count (New_Rhs, 1);
1395                   Set_Etype (New_Rhs, Etype (Left_Opnd (New_Rhs)));
1396                end if;
1397
1398                New_Rhs :=
1399                  Make_Op_Or (Loc,
1400                    Left_Opnd  => New_Rhs,
1401                    Right_Opnd => Or_Rhs);
1402             end;
1403          end if;
1404
1405          --  Now do the rewrite
1406
1407          Rewrite (N,
1408            Make_Assignment_Statement (Loc,
1409              Name       => New_Lhs,
1410              Expression =>
1411                Unchecked_Convert_To (Etype (New_Lhs), New_Rhs)));
1412          Set_Assignment_OK (Name (N), Ass_OK);
1413
1414       --  All other component sizes for non-modular case
1415
1416       else
1417          --  We generate
1418
1419          --    Set_nn (Arr'address, Subscr, Bits_nn!(Rhs))
1420
1421          --  where Subscr is the computed linear subscript
1422
1423          declare
1424             Bits_nn : constant Entity_Id := RTE (Bits_Id (Csiz));
1425             Set_nn  : Entity_Id;
1426             Subscr  : Node_Id;
1427             Atyp    : Entity_Id;
1428             Rev_SSO : Node_Id;
1429
1430          begin
1431             if No (Bits_nn) then
1432
1433                --  Error, most likely High_Integrity_Mode restriction
1434
1435                return;
1436             end if;
1437
1438             --  Acquire proper Set entity. We use the aligned or unaligned
1439             --  case as appropriate.
1440
1441             if Known_Aligned_Enough (Obj, Csiz) then
1442                Set_nn := RTE (Set_Id (Csiz));
1443             else
1444                Set_nn := RTE (SetU_Id (Csiz));
1445             end if;
1446
1447             --  Now generate the set reference
1448
1449             Obj := Relocate_Node (Prefix (Lhs));
1450             Convert_To_Actual_Subtype (Obj);
1451             Atyp := Etype (Obj);
1452             Compute_Linear_Subscript (Atyp, Lhs, Subscr);
1453
1454             --  Set indication of whether the packed array has reverse SSO
1455
1456             Rev_SSO :=
1457               New_Occurrence_Of
1458                 (Boolean_Literals (Reverse_Storage_Order (Atyp)), Loc);
1459
1460             --  Below we must make the assumption that Obj is
1461             --  at least byte aligned, since otherwise its address
1462             --  cannot be taken. The assumption holds since the
1463             --  only arrays that can be misaligned are small packed
1464             --  arrays which are implemented as a modular type, and
1465             --  that is not the case here.
1466
1467             Rewrite (N,
1468               Make_Procedure_Call_Statement (Loc,
1469                   Name => New_Occurrence_Of (Set_nn, Loc),
1470                   Parameter_Associations => New_List (
1471                     Make_Attribute_Reference (Loc,
1472                       Prefix         => Obj,
1473                       Attribute_Name => Name_Address),
1474                     Subscr,
1475                     Unchecked_Convert_To (Bits_nn, Convert_To (Ctyp, Rhs)),
1476                     Rev_SSO)));
1477
1478          end;
1479       end if;
1480
1481       Analyze (N, Suppress => All_Checks);
1482    end Expand_Bit_Packed_Element_Set;
1483
1484    -------------------------------------
1485    -- Expand_Packed_Address_Reference --
1486    -------------------------------------
1487
1488    procedure Expand_Packed_Address_Reference (N : Node_Id) is
1489       Loc    : constant Source_Ptr := Sloc (N);
1490       Base   : Node_Id;
1491       Offset : Node_Id;
1492
1493    begin
1494       --  We build an expression that has the form
1495
1496       --    outer_object'Address
1497       --      + (linear-subscript * component_size  for each array reference
1498       --      +  field'Bit_Position                 for each record field
1499       --      +  ...
1500       --      +  ...) / Storage_Unit;
1501
1502       Get_Base_And_Bit_Offset (Prefix (N), Base, Offset);
1503
1504       Rewrite (N,
1505         Unchecked_Convert_To (RTE (RE_Address),
1506           Make_Op_Add (Loc,
1507             Left_Opnd =>
1508               Unchecked_Convert_To (RTE (RE_Integer_Address),
1509                 Make_Attribute_Reference (Loc,
1510                   Prefix         => Base,
1511                   Attribute_Name => Name_Address)),
1512
1513             Right_Opnd =>
1514               Unchecked_Convert_To (RTE (RE_Integer_Address),
1515                 Make_Op_Divide (Loc,
1516                   Left_Opnd => Offset,
1517                   Right_Opnd =>
1518                     Make_Integer_Literal (Loc, System_Storage_Unit))))));
1519
1520       Analyze_And_Resolve (N, RTE (RE_Address));
1521    end Expand_Packed_Address_Reference;
1522
1523    ---------------------------------
1524    -- Expand_Packed_Bit_Reference --
1525    ---------------------------------
1526
1527    procedure Expand_Packed_Bit_Reference (N : Node_Id) is
1528       Loc    : constant Source_Ptr := Sloc (N);
1529       Base   : Node_Id;
1530       Offset : Node_Id;
1531
1532    begin
1533       --  We build an expression that has the form
1534
1535       --    (linear-subscript * component_size      for each array reference
1536       --      +  field'Bit_Position                 for each record field
1537       --      +  ...
1538       --      +  ...) mod Storage_Unit;
1539
1540       Get_Base_And_Bit_Offset (Prefix (N), Base, Offset);
1541
1542       Rewrite (N,
1543         Unchecked_Convert_To (Standard_Natural,
1544           Make_Op_Mod (Loc,
1545             Left_Opnd => Offset,
1546             Right_Opnd => Make_Integer_Literal (Loc, System_Storage_Unit))));
1547
1548       Analyze_And_Resolve (N, Standard_Natural);
1549    end Expand_Packed_Bit_Reference;
1550
1551    ------------------------------------
1552    -- Expand_Packed_Boolean_Operator --
1553    ------------------------------------
1554
1555    --  This routine expands "a op b" for the packed cases
1556
1557    procedure Expand_Packed_Boolean_Operator (N : Node_Id) is
1558       Loc : constant Source_Ptr := Sloc (N);
1559       Typ : constant Entity_Id  := Etype (N);
1560       L   : constant Node_Id    := Relocate_Node (Left_Opnd  (N));
1561       R   :          Node_Id    := Relocate_Node (Right_Opnd (N));
1562
1563       Ltyp : Entity_Id;
1564       Rtyp : Entity_Id;
1565       PAT  : Entity_Id;
1566
1567    begin
1568       Convert_To_Actual_Subtype (L);
1569       Convert_To_Actual_Subtype (R);
1570
1571       Ensure_Defined (Etype (L), N);
1572       Ensure_Defined (Etype (R), N);
1573
1574       Apply_Length_Check (R, Etype (L));
1575
1576       Ltyp := Etype (L);
1577       Rtyp := Etype (R);
1578
1579       --  Deal with silly case of XOR where the subcomponent has a range
1580       --  True .. True where an exception must be raised.
1581
1582       if Nkind (N) = N_Op_Xor then
1583          R := Duplicate_Subexpr (R);
1584          Silly_Boolean_Array_Xor_Test (N, R, Rtyp);
1585       end if;
1586
1587       --  Now that silliness is taken care of, get packed array type
1588
1589       Convert_To_PAT_Type (L);
1590       Convert_To_PAT_Type (R);
1591
1592       PAT := Etype (L);
1593
1594       --  For the modular case, we expand a op b into
1595
1596       --    rtyp!(pat!(a) op pat!(b))
1597
1598       --  where rtyp is the Etype of the left operand. Note that we do not
1599       --  convert to the base type, since this would be unconstrained, and
1600       --  hence not have a corresponding packed array type set.
1601
1602       --  Note that both operands must be modular for this code to be used
1603
1604       if Is_Modular_Integer_Type (PAT)
1605            and then
1606          Is_Modular_Integer_Type (Etype (R))
1607       then
1608          declare
1609             P : Node_Id;
1610
1611          begin
1612             if Nkind (N) = N_Op_And then
1613                P := Make_Op_And (Loc, L, R);
1614
1615             elsif Nkind (N) = N_Op_Or then
1616                P := Make_Op_Or  (Loc, L, R);
1617
1618             else -- Nkind (N) = N_Op_Xor
1619                P := Make_Op_Xor (Loc, L, R);
1620             end if;
1621
1622             Rewrite (N, Unchecked_Convert_To (Ltyp, P));
1623          end;
1624
1625       --  For the array case, we insert the actions
1626
1627       --    Result : Ltype;
1628
1629       --    System.Bit_Ops.Bit_And/Or/Xor
1630       --     (Left'Address,
1631       --      Ltype'Length * Ltype'Component_Size;
1632       --      Right'Address,
1633       --      Rtype'Length * Rtype'Component_Size
1634       --      Result'Address);
1635
1636       --  where Left and Right are the Packed_Bytes{1,2,4} operands and
1637       --  the second argument and fourth arguments are the lengths of the
1638       --  operands in bits. Then we replace the expression by a reference
1639       --  to Result.
1640
1641       --  Note that if we are mixing a modular and array operand, everything
1642       --  works fine, since we ensure that the modular representation has the
1643       --  same physical layout as the array representation (that's what the
1644       --  left justified modular stuff in the big-endian case is about).
1645
1646       else
1647          declare
1648             Result_Ent : constant Entity_Id := Make_Temporary (Loc, 'T');
1649             E_Id       : RE_Id;
1650
1651          begin
1652             if Nkind (N) = N_Op_And then
1653                E_Id := RE_Bit_And;
1654
1655             elsif Nkind (N) = N_Op_Or then
1656                E_Id := RE_Bit_Or;
1657
1658             else -- Nkind (N) = N_Op_Xor
1659                E_Id := RE_Bit_Xor;
1660             end if;
1661
1662             Insert_Actions (N, New_List (
1663
1664               Make_Object_Declaration (Loc,
1665                 Defining_Identifier => Result_Ent,
1666                 Object_Definition => New_Occurrence_Of (Ltyp, Loc)),
1667
1668               Make_Procedure_Call_Statement (Loc,
1669                 Name => New_Occurrence_Of (RTE (E_Id), Loc),
1670                   Parameter_Associations => New_List (
1671
1672                     Make_Byte_Aligned_Attribute_Reference (Loc,
1673                       Prefix         => L,
1674                       Attribute_Name => Name_Address),
1675
1676                     Make_Op_Multiply (Loc,
1677                       Left_Opnd =>
1678                         Make_Attribute_Reference (Loc,
1679                           Prefix         =>
1680                             New_Occurrence_Of
1681                               (Etype (First_Index (Ltyp)), Loc),
1682                           Attribute_Name => Name_Range_Length),
1683
1684                       Right_Opnd =>
1685                         Make_Integer_Literal (Loc, Component_Size (Ltyp))),
1686
1687                     Make_Byte_Aligned_Attribute_Reference (Loc,
1688                       Prefix         => R,
1689                       Attribute_Name => Name_Address),
1690
1691                     Make_Op_Multiply (Loc,
1692                       Left_Opnd =>
1693                         Make_Attribute_Reference (Loc,
1694                           Prefix         =>
1695                             New_Occurrence_Of
1696                               (Etype (First_Index (Rtyp)), Loc),
1697                           Attribute_Name => Name_Range_Length),
1698
1699                       Right_Opnd =>
1700                         Make_Integer_Literal (Loc, Component_Size (Rtyp))),
1701
1702                     Make_Byte_Aligned_Attribute_Reference (Loc,
1703                       Prefix => New_Occurrence_Of (Result_Ent, Loc),
1704                       Attribute_Name => Name_Address)))));
1705
1706             Rewrite (N,
1707               New_Occurrence_Of (Result_Ent, Loc));
1708          end;
1709       end if;
1710
1711       Analyze_And_Resolve (N, Typ, Suppress => All_Checks);
1712    end Expand_Packed_Boolean_Operator;
1713
1714    -------------------------------------
1715    -- Expand_Packed_Element_Reference --
1716    -------------------------------------
1717
1718    procedure Expand_Packed_Element_Reference (N : Node_Id) is
1719       Loc   : constant Source_Ptr := Sloc (N);
1720       Obj   : Node_Id;
1721       Atyp  : Entity_Id;
1722       PAT   : Entity_Id;
1723       Ctyp  : Entity_Id;
1724       Csiz  : Int;
1725       Shift : Node_Id;
1726       Cmask : Uint;
1727       Lit   : Node_Id;
1728       Arg   : Node_Id;
1729
1730    begin
1731       --  If the node is an actual in a call, the prefix has not been fully
1732       --  expanded, to account for the additional expansion for in-out actuals
1733       --  (see expand_actuals for details). If the prefix itself is a packed
1734       --  reference as well, we have to recurse to complete the transformation
1735       --  of the prefix.
1736
1737       if Nkind (Prefix (N)) = N_Indexed_Component
1738         and then not Analyzed (Prefix (N))
1739         and then Is_Bit_Packed_Array (Etype (Prefix (Prefix (N))))
1740       then
1741          Expand_Packed_Element_Reference (Prefix (N));
1742       end if;
1743
1744       --  The prefix may be rewritten below as a conversion. If it is a source
1745       --  entity generate reference to it now, to prevent spurious warnings
1746       --  about unused entities.
1747
1748       if Is_Entity_Name (Prefix (N))
1749         and then Comes_From_Source (Prefix (N))
1750       then
1751          Generate_Reference (Entity (Prefix (N)), Prefix (N), 'r');
1752       end if;
1753
1754       --  If not bit packed, we have the enumeration case, which is easily
1755       --  dealt with (just adjust the subscripts of the indexed component)
1756
1757       --  Note: this leaves the result as an indexed component, which is
1758       --  still a variable, so can be used in the assignment case, as is
1759       --  required in the enumeration case.
1760
1761       if not Is_Bit_Packed_Array (Etype (Prefix (N))) then
1762          Setup_Enumeration_Packed_Array_Reference (N);
1763          return;
1764       end if;
1765
1766       --  Remaining processing is for the bit-packed case
1767
1768       Obj := Relocate_Node (Prefix (N));
1769       Convert_To_Actual_Subtype (Obj);
1770       Atyp := Etype (Obj);
1771       PAT  := Packed_Array_Impl_Type (Atyp);
1772       Ctyp := Component_Type (Atyp);
1773       Csiz := UI_To_Int (Component_Size (Atyp));
1774
1775       --  Case of component size 1,2,4 or any component size for the modular
1776       --  case. These are the cases for which we can inline the code.
1777
1778       if Csiz = 1 or else Csiz = 2 or else Csiz = 4
1779         or else (Present (PAT) and then Is_Modular_Integer_Type (PAT))
1780       then
1781          Setup_Inline_Packed_Array_Reference (N, Atyp, Obj, Cmask, Shift);
1782          Lit := Make_Integer_Literal (Loc, Cmask);
1783          Set_Print_In_Hex (Lit);
1784
1785          --  We generate a shift right to position the field, followed by a
1786          --  masking operation to extract the bit field, and we finally do an
1787          --  unchecked conversion to convert the result to the required target.
1788
1789          --  Note that the unchecked conversion automatically deals with the
1790          --  bias if we are dealing with a biased representation. What will
1791          --  happen is that we temporarily generate the biased representation,
1792          --  but almost immediately that will be converted to the original
1793          --  unbiased component type, and the bias will disappear.
1794
1795          Arg :=
1796            Make_Op_And (Loc,
1797              Left_Opnd  => Make_Shift_Right (Obj, Shift),
1798              Right_Opnd => Lit);
1799          Set_Etype (Arg, Ctyp);
1800
1801          --  Component extraction is performed on a native endianness scalar
1802          --  value: if Atyp has reverse storage order, then it has been byte
1803          --  swapped, and if the component being extracted is itself of a
1804          --  composite type with reverse storage order, then we need to swap
1805          --  it back to its expected endianness after extraction.
1806
1807          if Reverse_Storage_Order (Atyp)
1808            and then (Is_Record_Type (Ctyp) or else Is_Array_Type (Ctyp))
1809            and then Reverse_Storage_Order (Ctyp)
1810          then
1811             Arg := Revert_Storage_Order (Arg);
1812          end if;
1813
1814          --  We needed to analyze this before we do the unchecked convert
1815          --  below, but we need it temporarily attached to the tree for
1816          --  this analysis (hence the temporary Set_Parent call).
1817
1818          Set_Parent (Arg, Parent (N));
1819          Analyze_And_Resolve (Arg);
1820
1821          Rewrite (N, RJ_Unchecked_Convert_To (Ctyp, Arg));
1822
1823       --  All other component sizes for non-modular case
1824
1825       else
1826          --  We generate
1827
1828          --    Component_Type!(Get_nn (Arr'address, Subscr))
1829
1830          --  where Subscr is the computed linear subscript
1831
1832          declare
1833             Get_nn  : Entity_Id;
1834             Subscr  : Node_Id;
1835             Rev_SSO : constant Node_Id :=
1836               New_Occurrence_Of
1837                 (Boolean_Literals (Reverse_Storage_Order (Atyp)), Loc);
1838
1839          begin
1840             --  Acquire proper Get entity. We use the aligned or unaligned
1841             --  case as appropriate.
1842
1843             if Known_Aligned_Enough (Obj, Csiz) then
1844                Get_nn := RTE (Get_Id (Csiz));
1845             else
1846                Get_nn := RTE (GetU_Id (Csiz));
1847             end if;
1848
1849             --  Now generate the get reference
1850
1851             Compute_Linear_Subscript (Atyp, N, Subscr);
1852
1853             --  Below we make the assumption that Obj is at least byte
1854             --  aligned, since otherwise its address cannot be taken.
1855             --  The assumption holds since the only arrays that can be
1856             --  misaligned are small packed arrays which are implemented
1857             --  as a modular type, and that is not the case here.
1858
1859             Rewrite (N,
1860               Unchecked_Convert_To (Ctyp,
1861                 Make_Function_Call (Loc,
1862                   Name => New_Occurrence_Of (Get_nn, Loc),
1863                   Parameter_Associations => New_List (
1864                     Make_Attribute_Reference (Loc,
1865                       Prefix         => Obj,
1866                       Attribute_Name => Name_Address),
1867                     Subscr,
1868                     Rev_SSO))));
1869          end;
1870       end if;
1871
1872       Analyze_And_Resolve (N, Ctyp, Suppress => All_Checks);
1873    end Expand_Packed_Element_Reference;
1874
1875    ----------------------
1876    -- Expand_Packed_Eq --
1877    ----------------------
1878
1879    --  Handles expansion of "=" on packed array types
1880
1881    procedure Expand_Packed_Eq (N : Node_Id) is
1882       Loc : constant Source_Ptr := Sloc (N);
1883       L   : constant Node_Id    := Relocate_Node (Left_Opnd  (N));
1884       R   : constant Node_Id    := Relocate_Node (Right_Opnd (N));
1885
1886       LLexpr : Node_Id;
1887       RLexpr : Node_Id;
1888
1889       Ltyp : Entity_Id;
1890       Rtyp : Entity_Id;
1891       PAT  : Entity_Id;
1892
1893    begin
1894       Convert_To_Actual_Subtype (L);
1895       Convert_To_Actual_Subtype (R);
1896       Ltyp := Underlying_Type (Etype (L));
1897       Rtyp := Underlying_Type (Etype (R));
1898
1899       Convert_To_PAT_Type (L);
1900       Convert_To_PAT_Type (R);
1901       PAT := Etype (L);
1902
1903       LLexpr :=
1904         Make_Op_Multiply (Loc,
1905           Left_Opnd  => Compute_Number_Components (N, Ltyp),
1906           Right_Opnd => Make_Integer_Literal (Loc, Component_Size (Ltyp)));
1907
1908       RLexpr :=
1909         Make_Op_Multiply (Loc,
1910           Left_Opnd  => Compute_Number_Components (N, Rtyp),
1911           Right_Opnd => Make_Integer_Literal (Loc, Component_Size (Rtyp)));
1912
1913       --  For the modular case, we transform the comparison to:
1914
1915       --    Ltyp'Length = Rtyp'Length and then PAT!(L) = PAT!(R)
1916
1917       --  where PAT is the packed array type. This works fine, since in the
1918       --  modular case we guarantee that the unused bits are always zeroes.
1919       --  We do have to compare the lengths because we could be comparing
1920       --  two different subtypes of the same base type. We can only do this
1921       --  if the PATs on both sides are the same.
1922
1923       if Is_Modular_Integer_Type (PAT) and then PAT = Etype (R) then
1924          Rewrite (N,
1925            Make_And_Then (Loc,
1926              Left_Opnd =>
1927                Make_Op_Eq (Loc,
1928                  Left_Opnd  => LLexpr,
1929                  Right_Opnd => RLexpr),
1930
1931              Right_Opnd =>
1932                Make_Op_Eq (Loc,
1933                  Left_Opnd => L,
1934                  Right_Opnd => R)));
1935
1936       --  For the non-modular case, we call a runtime routine
1937
1938       --    System.Bit_Ops.Bit_Eq
1939       --      (L'Address, L_Length, R'Address, R_Length)
1940
1941       --  where PAT is the packed array type, and the lengths are the lengths
1942       --  in bits of the original packed arrays. This routine takes care of
1943       --  not comparing the unused bits in the last byte.
1944
1945       else
1946          Rewrite (N,
1947            Make_Function_Call (Loc,
1948              Name => New_Occurrence_Of (RTE (RE_Bit_Eq), Loc),
1949              Parameter_Associations => New_List (
1950                Make_Byte_Aligned_Attribute_Reference (Loc,
1951                  Prefix         => L,
1952                  Attribute_Name => Name_Address),
1953
1954                LLexpr,
1955
1956                Make_Byte_Aligned_Attribute_Reference (Loc,
1957                  Prefix         => R,
1958                  Attribute_Name => Name_Address),
1959
1960                RLexpr)));
1961       end if;
1962
1963       Analyze_And_Resolve (N, Standard_Boolean, Suppress => All_Checks);
1964    end Expand_Packed_Eq;
1965
1966    -----------------------
1967    -- Expand_Packed_Not --
1968    -----------------------
1969
1970    --  Handles expansion of "not" on packed array types
1971
1972    procedure Expand_Packed_Not (N : Node_Id) is
1973       Loc  : constant Source_Ptr := Sloc (N);
1974       Typ  : constant Entity_Id  := Etype (N);
1975       Opnd : constant Node_Id    := Relocate_Node (Right_Opnd (N));
1976
1977       Rtyp : Entity_Id;
1978       PAT  : Entity_Id;
1979       Lit  : Node_Id;
1980       Size : Unat;
1981
1982    begin
1983       Convert_To_Actual_Subtype (Opnd);
1984       Rtyp := Etype (Opnd);
1985
1986       --  Deal with silly False..False and True..True subtype case
1987
1988       Silly_Boolean_Array_Not_Test (N, Rtyp);
1989
1990       --  Now that the silliness is taken care of, get packed array type
1991
1992       Convert_To_PAT_Type (Opnd);
1993       PAT := Etype (Opnd);
1994
1995       --  For the case where the packed array type is a modular type, "not A"
1996       --  expands simply into:
1997
1998       --     Rtyp!(PAT!(A) xor Mask)
1999
2000       --  where PAT is the packed array type, Mask is a mask of all 1 bits of
2001       --  length equal to the size of this packed type, and Rtyp is the actual
2002       --  actual subtype of the operand. Preserve old behavior in case size is
2003       --  not set.
2004
2005       if Known_RM_Size (PAT) then
2006          Size := RM_Size (PAT);
2007       else
2008          Size := Uint_0;
2009       end if;
2010       Lit := Make_Integer_Literal (Loc, 2 ** Size - 1);
2011       Set_Print_In_Hex (Lit);
2012
2013       if not Is_Array_Type (PAT) then
2014          Rewrite (N,
2015            Unchecked_Convert_To (Rtyp,
2016              Make_Op_Xor (Loc,
2017                Left_Opnd  => Opnd,
2018                Right_Opnd => Lit)));
2019
2020       --  For the array case, we insert the actions
2021
2022       --    Result : Typ;
2023
2024       --    System.Bit_Ops.Bit_Not
2025       --     (Opnd'Address,
2026       --      Typ'Length * Typ'Component_Size,
2027       --      Result'Address);
2028
2029       --  where Opnd is the Packed_Bytes{1,2,4} operand and the second argument
2030       --  is the length of the operand in bits. We then replace the expression
2031       --  with a reference to Result.
2032
2033       else
2034          declare
2035             Result_Ent : constant Entity_Id := Make_Temporary (Loc, 'T');
2036
2037          begin
2038             Insert_Actions (N, New_List (
2039               Make_Object_Declaration (Loc,
2040                 Defining_Identifier => Result_Ent,
2041                 Object_Definition   => New_Occurrence_Of (Rtyp, Loc)),
2042
2043               Make_Procedure_Call_Statement (Loc,
2044                 Name => New_Occurrence_Of (RTE (RE_Bit_Not), Loc),
2045                   Parameter_Associations => New_List (
2046                     Make_Byte_Aligned_Attribute_Reference (Loc,
2047                       Prefix         => Opnd,
2048                       Attribute_Name => Name_Address),
2049
2050                     Make_Op_Multiply (Loc,
2051                       Left_Opnd =>
2052                         Make_Attribute_Reference (Loc,
2053                           Prefix         =>
2054                             New_Occurrence_Of
2055                               (Etype (First_Index (Rtyp)), Loc),
2056                           Attribute_Name => Name_Range_Length),
2057
2058                       Right_Opnd =>
2059                         Make_Integer_Literal (Loc, Component_Size (Rtyp))),
2060
2061                     Make_Byte_Aligned_Attribute_Reference (Loc,
2062                       Prefix         => New_Occurrence_Of (Result_Ent, Loc),
2063                       Attribute_Name => Name_Address)))));
2064
2065             Rewrite (N, New_Occurrence_Of (Result_Ent, Loc));
2066          end;
2067       end if;
2068
2069       Analyze_And_Resolve (N, Typ, Suppress => All_Checks);
2070    end Expand_Packed_Not;
2071
2072    -----------------------------
2073    -- Get_Base_And_Bit_Offset --
2074    -----------------------------
2075
2076    procedure Get_Base_And_Bit_Offset
2077      (N      : Node_Id;
2078       Base   : out Node_Id;
2079       Offset : out Node_Id)
2080    is
2081       Loc    : Source_Ptr;
2082       Term   : Node_Id;
2083       Atyp   : Entity_Id;
2084       Subscr : Node_Id;
2085
2086    begin
2087       Base   := N;
2088       Offset := Empty;
2089
2090       --  We build up an expression serially that has the form
2091
2092       --    linear-subscript * component_size       for each array reference
2093       --      +  field'Bit_Position                 for each record field
2094       --      +  ...
2095
2096       loop
2097          Loc := Sloc (Base);
2098
2099          if Nkind (Base) = N_Indexed_Component then
2100             Convert_To_Actual_Subtype (Prefix (Base));
2101             Atyp := Etype (Prefix (Base));
2102             Compute_Linear_Subscript (Atyp, Base, Subscr);
2103
2104             Term :=
2105               Make_Op_Multiply (Loc,
2106                 Left_Opnd => Subscr,
2107                 Right_Opnd =>
2108                  Make_Attribute_Reference (Loc,
2109                    Prefix         => New_Occurrence_Of (Atyp, Loc),
2110                    Attribute_Name => Name_Component_Size));
2111
2112          elsif Nkind (Base) = N_Selected_Component then
2113             Term :=
2114               Make_Attribute_Reference (Loc,
2115                 Prefix         => Selector_Name (Base),
2116                 Attribute_Name => Name_Bit_Position);
2117
2118          else
2119             return;
2120          end if;
2121
2122          if No (Offset) then
2123             Offset := Term;
2124
2125          else
2126             Offset :=
2127               Make_Op_Add (Loc,
2128                 Left_Opnd  => Offset,
2129                 Right_Opnd => Term);
2130          end if;
2131
2132          Base := Prefix (Base);
2133       end loop;
2134    end Get_Base_And_Bit_Offset;
2135
2136    -------------------------------------
2137    -- Involves_Packed_Array_Reference --
2138    -------------------------------------
2139
2140    function Involves_Packed_Array_Reference (N : Node_Id) return Boolean is
2141    begin
2142       if Nkind (N) = N_Indexed_Component
2143         and then Is_Bit_Packed_Array (Etype (Prefix (N)))
2144       then
2145          return True;
2146
2147       elsif Nkind (N) = N_Selected_Component then
2148          return Involves_Packed_Array_Reference (Prefix (N));
2149
2150       else
2151          return False;
2152       end if;
2153    end Involves_Packed_Array_Reference;
2154
2155    --------------------------
2156    -- Known_Aligned_Enough --
2157    --------------------------
2158
2159    function Known_Aligned_Enough (Obj : Node_Id; Csiz : Nat) return Boolean is
2160       Typ : constant Entity_Id := Etype (Obj);
2161
2162       function In_Partially_Packed_Record (Comp : Entity_Id) return Boolean;
2163       --  If the component is in a record that contains previous packed
2164       --  components, consider it unaligned because the back-end might
2165       --  choose to pack the rest of the record. Lead to less efficient code,
2166       --  but safer vis-a-vis of back-end choices.
2167
2168       --------------------------------
2169       -- In_Partially_Packed_Record --
2170       --------------------------------
2171
2172       function In_Partially_Packed_Record (Comp : Entity_Id) return Boolean is
2173          Rec_Type  : constant Entity_Id := Scope (Comp);
2174          Prev_Comp : Entity_Id;
2175
2176       begin
2177          Prev_Comp := First_Entity (Rec_Type);
2178          while Present (Prev_Comp) loop
2179             if Is_Packed (Etype (Prev_Comp)) then
2180                return True;
2181
2182             elsif Prev_Comp = Comp then
2183                return False;
2184             end if;
2185
2186             Next_Entity (Prev_Comp);
2187          end loop;
2188
2189          return False;
2190       end  In_Partially_Packed_Record;
2191
2192    --  Start of processing for Known_Aligned_Enough
2193
2194    begin
2195       --  Odd bit sizes don't need alignment anyway
2196
2197       if Csiz mod 2 = 1 then
2198          return True;
2199
2200       --  If we have a specified alignment, see if it is sufficient, if not
2201       --  then we can't possibly be aligned enough in any case.
2202
2203       elsif Known_Alignment (Etype (Obj)) then
2204          --  Alignment required is 4 if size is a multiple of 4, and
2205          --  2 otherwise (e.g. 12 bits requires 4, 10 bits requires 2)
2206
2207          if Alignment (Etype (Obj)) < 4 - (Csiz mod 4) then
2208             return False;
2209          end if;
2210       end if;
2211
2212       --  OK, alignment should be sufficient, if object is aligned
2213
2214       --  If object is strictly aligned, then it is definitely aligned
2215
2216       if Strict_Alignment (Typ) then
2217          return True;
2218
2219       --  Case of subscripted array reference
2220
2221       elsif Nkind (Obj) = N_Indexed_Component then
2222
2223          --  If we have a pointer to an array, then this is definitely
2224          --  aligned, because pointers always point to aligned versions.
2225
2226          if Is_Access_Type (Etype (Prefix (Obj))) then
2227             return True;
2228
2229          --  Otherwise, go look at the prefix
2230
2231          else
2232             return Known_Aligned_Enough (Prefix (Obj), Csiz);
2233          end if;
2234
2235       --  Case of record field
2236
2237       elsif Nkind (Obj) = N_Selected_Component then
2238
2239          --  What is significant here is whether the record type is packed
2240
2241          if Is_Record_Type (Etype (Prefix (Obj)))
2242            and then Is_Packed (Etype (Prefix (Obj)))
2243          then
2244             return False;
2245
2246          --  Or the component has a component clause which might cause
2247          --  the component to become unaligned (we can't tell if the
2248          --  backend is doing alignment computations).
2249
2250          elsif Present (Component_Clause (Entity (Selector_Name (Obj)))) then
2251             return False;
2252
2253          elsif In_Partially_Packed_Record (Entity (Selector_Name (Obj))) then
2254             return False;
2255
2256          --  In all other cases, go look at prefix
2257
2258          else
2259             return Known_Aligned_Enough (Prefix (Obj), Csiz);
2260          end if;
2261
2262       elsif Nkind (Obj) = N_Type_Conversion then
2263          return Known_Aligned_Enough (Expression (Obj), Csiz);
2264
2265       --  For a formal parameter, it is safer to assume that it is not
2266       --  aligned, because the formal may be unconstrained while the actual
2267       --  is constrained. In this situation, a small constrained packed
2268       --  array, represented in modular form, may be unaligned.
2269
2270       elsif Is_Entity_Name (Obj) then
2271          return not Is_Formal (Entity (Obj));
2272       else
2273
2274       --  If none of the above, must be aligned
2275          return True;
2276       end if;
2277    end Known_Aligned_Enough;
2278
2279    ---------------------
2280    -- Make_Shift_Left --
2281    ---------------------
2282
2283    function Make_Shift_Left (N : Node_Id; S : Node_Id) return Node_Id is
2284       Nod : Node_Id;
2285
2286    begin
2287       if Compile_Time_Known_Value (S) and then Expr_Value (S) = 0 then
2288          return N;
2289       else
2290          Nod :=
2291            Make_Op_Shift_Left (Sloc (N),
2292              Left_Opnd  => N,
2293              Right_Opnd => S);
2294          Set_Shift_Count_OK (Nod, True);
2295          return Nod;
2296       end if;
2297    end Make_Shift_Left;
2298
2299    ----------------------
2300    -- Make_Shift_Right --
2301    ----------------------
2302
2303    function Make_Shift_Right (N : Node_Id; S : Node_Id) return Node_Id is
2304       Nod : Node_Id;
2305
2306    begin
2307       if Compile_Time_Known_Value (S) and then Expr_Value (S) = 0 then
2308          return N;
2309       else
2310          Nod :=
2311            Make_Op_Shift_Right (Sloc (N),
2312              Left_Opnd  => N,
2313              Right_Opnd => S);
2314          Set_Shift_Count_OK (Nod, True);
2315          return Nod;
2316       end if;
2317    end Make_Shift_Right;
2318
2319    -----------------------------
2320    -- RJ_Unchecked_Convert_To --
2321    -----------------------------
2322
2323    function RJ_Unchecked_Convert_To
2324      (Typ  : Entity_Id;
2325       Expr : Node_Id) return Node_Id
2326    is
2327       Source_Typ : constant Entity_Id := Etype (Expr);
2328       Target_Typ : constant Entity_Id := Typ;
2329
2330       Src : Node_Id := Expr;
2331
2332       Source_Siz : Nat;
2333       Target_Siz : Nat;
2334
2335    begin
2336       Source_Siz := UI_To_Int (RM_Size (Source_Typ));
2337       Target_Siz := UI_To_Int (RM_Size (Target_Typ));
2338
2339       --  For a little-endian target type stored byte-swapped on a
2340       --  big-endian machine, do not mask to Target_Siz bits.
2341
2342       if Bytes_Big_Endian
2343            and then (Is_Record_Type (Target_Typ)
2344                        or else
2345                      Is_Array_Type (Target_Typ))
2346            and then Reverse_Storage_Order (Target_Typ)
2347       then
2348          Source_Siz := Target_Siz;
2349       end if;
2350
2351       --  First step, if the source type is not a discrete type, then we first
2352       --  convert to a modular type of the source length, since otherwise, on
2353       --  a big-endian machine, we get left-justification. We do it for little-
2354       --  endian machines as well, because there might be junk bits that are
2355       --  not cleared if the type is not numeric. This can be done only if the
2356       --  source siz is different from 0 (i.e. known), otherwise we must trust
2357       --  the type declarations (case of non-discrete components).
2358
2359       if Source_Siz /= 0
2360         and then Source_Siz /= Target_Siz
2361         and then not Is_Discrete_Type (Source_Typ)
2362       then
2363          Src := Unchecked_Convert_To (RTE (Bits_Id (Source_Siz)), Src);
2364       end if;
2365
2366       --  In the big endian case, if the lengths of the two types differ, then
2367       --  we must worry about possible left justification in the conversion,
2368       --  and avoiding that is what this is all about.
2369
2370       if Bytes_Big_Endian and then Source_Siz /= Target_Siz then
2371
2372          --  Next step. If the target is not a discrete type, then we first
2373          --  convert to a modular type of the target length, since otherwise,
2374          --  on a big-endian machine, we get left-justification.
2375
2376          if not Is_Discrete_Type (Target_Typ) then
2377             Src := Unchecked_Convert_To (RTE (Bits_Id (Target_Siz)), Src);
2378          end if;
2379       end if;
2380
2381       --  And now we can do the final conversion to the target type
2382
2383       return Unchecked_Convert_To (Target_Typ, Src);
2384    end RJ_Unchecked_Convert_To;
2385
2386    ----------------------------------------------
2387    -- Setup_Enumeration_Packed_Array_Reference --
2388    ----------------------------------------------
2389
2390    --  All we have to do here is to find the subscripts that correspond to the
2391    --  index positions that have non-standard enumeration types and insert a
2392    --  Pos attribute to get the proper subscript value.
2393
2394    --  Finally the prefix must be uncheck-converted to the corresponding packed
2395    --  array type.
2396
2397    --  Note that the component type is unchanged, so we do not need to fiddle
2398    --  with the types (Gigi always automatically takes the packed array type if
2399    --  it is set, as it will be in this case).
2400
2401    procedure Setup_Enumeration_Packed_Array_Reference (N : Node_Id) is
2402       Pfx   : constant Node_Id   := Prefix (N);
2403       Typ   : constant Entity_Id := Etype (N);
2404       Exprs : constant List_Id   := Expressions (N);
2405       Expr  : Node_Id;
2406
2407    begin
2408       --  If the array is unconstrained, then we replace the array reference
2409       --  with its actual subtype. This actual subtype will have a packed array
2410       --  type with appropriate bounds.
2411
2412       if not Is_Constrained (Packed_Array_Impl_Type (Etype (Pfx))) then
2413          Convert_To_Actual_Subtype (Pfx);
2414       end if;
2415
2416       Expr := First (Exprs);
2417       while Present (Expr) loop
2418          declare
2419             Loc      : constant Source_Ptr := Sloc (Expr);
2420             Expr_Typ : constant Entity_Id := Etype (Expr);
2421
2422          begin
2423             if Is_Enumeration_Type (Expr_Typ)
2424               and then Has_Non_Standard_Rep (Expr_Typ)
2425             then
2426                Rewrite (Expr,
2427                  Make_Attribute_Reference (Loc,
2428                    Prefix         => New_Occurrence_Of (Expr_Typ, Loc),
2429                    Attribute_Name => Name_Pos,
2430                    Expressions    => New_List (Relocate_Node (Expr))));
2431                Analyze_And_Resolve (Expr, Standard_Natural);
2432             end if;
2433          end;
2434
2435          Next (Expr);
2436       end loop;
2437
2438       Rewrite (N,
2439         Make_Indexed_Component (Sloc (N),
2440           Prefix      =>
2441             Unchecked_Convert_To (Packed_Array_Impl_Type (Etype (Pfx)), Pfx),
2442           Expressions => Exprs));
2443
2444       Analyze_And_Resolve (N, Typ);
2445    end Setup_Enumeration_Packed_Array_Reference;
2446
2447    -----------------------------------------
2448    -- Setup_Inline_Packed_Array_Reference --
2449    -----------------------------------------
2450
2451    procedure Setup_Inline_Packed_Array_Reference
2452      (N      : Node_Id;
2453       Atyp   : Entity_Id;
2454       Obj    : in out Node_Id;
2455       Cmask  : out Uint;
2456       Shift  : out Node_Id)
2457    is
2458       Loc  : constant Source_Ptr := Sloc (N);
2459       PAT  : Entity_Id;
2460       Otyp : Entity_Id;
2461       Csiz : Uint;
2462       Osiz : Uint;
2463
2464    begin
2465       Csiz := Component_Size (Atyp);
2466
2467       Convert_To_PAT_Type (Obj);
2468       PAT := Etype (Obj);
2469
2470       Cmask := 2 ** Csiz - 1;
2471
2472       if Is_Array_Type (PAT) then
2473          Otyp := Component_Type (PAT);
2474          Osiz := Component_Size (PAT);
2475
2476       else
2477          Otyp := PAT;
2478
2479          --  In the case where the PAT is a modular type, we want the actual
2480          --  size in bits of the modular value we use. This is neither the
2481          --  Object_Size nor the Value_Size, either of which may have been
2482          --  reset to strange values, but rather the minimum size. Note that
2483          --  since this is a modular type with full range, the issue of
2484          --  biased representation does not arise.
2485
2486          Osiz := UI_From_Int (Minimum_Size (Otyp));
2487       end if;
2488
2489       Compute_Linear_Subscript (Atyp, N, Shift);
2490
2491       --  If the component size is not 1, then the subscript must be multiplied
2492       --  by the component size to get the shift count.
2493
2494       if Csiz /= 1 then
2495          Shift :=
2496            Make_Op_Multiply (Loc,
2497              Left_Opnd  => Make_Integer_Literal (Loc, Csiz),
2498              Right_Opnd => Shift);
2499       end if;
2500
2501       --  If we have the array case, then this shift count must be broken down
2502       --  into a byte subscript, and a shift within the byte.
2503
2504       if Is_Array_Type (PAT) then
2505
2506          declare
2507             New_Shift : Node_Id;
2508
2509          begin
2510             --  We must analyze shift, since we will duplicate it
2511
2512             Set_Parent (Shift, N);
2513             Analyze_And_Resolve
2514               (Shift, Standard_Integer, Suppress => All_Checks);
2515
2516             --  The shift count within the word is
2517             --    shift mod Osiz
2518
2519             New_Shift :=
2520               Make_Op_Mod (Loc,
2521                 Left_Opnd  => Duplicate_Subexpr (Shift),
2522                 Right_Opnd => Make_Integer_Literal (Loc, Osiz));
2523
2524             --  The subscript to be used on the PAT array is
2525             --    shift / Osiz
2526
2527             Obj :=
2528               Make_Indexed_Component (Loc,
2529                 Prefix => Obj,
2530                 Expressions => New_List (
2531                   Make_Op_Divide (Loc,
2532                     Left_Opnd  => Duplicate_Subexpr (Shift),
2533                     Right_Opnd => Make_Integer_Literal (Loc, Osiz))));
2534
2535             Shift := New_Shift;
2536          end;
2537
2538       --  For the modular integer case, the object to be manipulated is the
2539       --  entire array, so Obj is unchanged. Note that we will reset its type
2540       --  to PAT before returning to the caller.
2541
2542       else
2543          null;
2544       end if;
2545
2546       --  The one remaining step is to modify the shift count for the
2547       --  big-endian case. Consider the following example in a byte:
2548
2549       --     xxxxxxxx  bits of byte
2550       --     vvvvvvvv  bits of value
2551       --     33221100  little-endian numbering
2552       --     00112233  big-endian numbering
2553
2554       --  Here we have the case of 2-bit fields
2555
2556       --  For the little-endian case, we already have the proper shift count
2557       --  set, e.g. for element 2, the shift count is 2*2 = 4.
2558
2559       --  For the big endian case, we have to adjust the shift count, computing
2560       --  it as (N - F) - Shift, where N is the number of bits in an element of
2561       --  the array used to implement the packed array, F is the number of bits
2562       --  in a source array element, and Shift is the count so far computed.
2563
2564       --  We also have to adjust if the storage order is reversed
2565
2566       if Bytes_Big_Endian xor Reverse_Storage_Order (Base_Type (Atyp)) then
2567          Shift :=
2568            Make_Op_Subtract (Loc,
2569              Left_Opnd  => Make_Integer_Literal (Loc, Osiz - Csiz),
2570              Right_Opnd => Shift);
2571       end if;
2572
2573       Set_Parent (Shift, N);
2574       Set_Parent (Obj, N);
2575       Analyze_And_Resolve (Obj,   Otyp,             Suppress => All_Checks);
2576       Analyze_And_Resolve (Shift, Standard_Integer, Suppress => All_Checks);
2577
2578       --  Make sure final type of object is the appropriate packed type
2579
2580       Set_Etype (Obj, Otyp);
2581
2582    end Setup_Inline_Packed_Array_Reference;
2583
2584 end Exp_Pakd;