gcc/ada/layout.adb

   1 ------------------------------------------------------------------------------
   2 --                                                                          --
   3 --                         GNAT COMPILER COMPONENTS                         --
   4 --                                                                          --
   5 --                               L A Y O U T                                --
   6 --                                                                          --
   7 --                                 B o d y                                  --
   8 --                                                                          --
   9 --          Copyright (C) 2001-2011, 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 Debug;    use Debug;
  29 with Einfo;    use Einfo;
  30 with Errout;   use Errout;
  31 with Exp_Ch3;  use Exp_Ch3;
  32 with Exp_Util; use Exp_Util;
  33 with Namet;    use Namet;
  34 with Nlists;   use Nlists;
  35 with Nmake;    use Nmake;
  36 with Opt;      use Opt;
  37 with Repinfo;  use Repinfo;
  38 with Sem;      use Sem;
  39 with Sem_Aux;  use Sem_Aux;
  40 with Sem_Ch13; use Sem_Ch13;
  41 with Sem_Eval; use Sem_Eval;
  42 with Sem_Util; use Sem_Util;
  43 with Sinfo;    use Sinfo;
  44 with Snames;   use Snames;
  45 with Stand;    use Stand;
  46 with Targparm; use Targparm;
  47 with Tbuild;   use Tbuild;
  48 with Ttypes;   use Ttypes;
  49 with Uintp;    use Uintp;
  50
  51 package body Layout is
  52
  53    ------------------------
  54    -- Local Declarations --
  55    ------------------------
  56
  57    SSU : constant Int := Ttypes.System_Storage_Unit;
  58    --  Short hand for System_Storage_Unit
  59
  60    Vname : constant Name_Id := Name_uV;
  61    --  Formal parameter name used for functions generated for size offset
  62    --  values that depend on the discriminant. All such functions have the
  63    --  following form:
  64    --
  65    --     function xxx (V : vtyp) return Unsigned is
  66    --     begin
  67    --        return ... expression involving V.discrim
  68    --     end xxx;
  69
  70    -----------------------
  71    -- Local Subprograms --
  72    -----------------------
  73
  74    function Assoc_Add
  75      (Loc        : Source_Ptr;
  76       Left_Opnd  : Node_Id;
  77       Right_Opnd : Node_Id) return Node_Id;
  78    --  This is like Make_Op_Add except that it optimizes some cases knowing
  79    --  that associative rearrangement is allowed for constant folding if one
  80    --  of the operands is a compile time known value.
  81
  82    function Assoc_Multiply
  83      (Loc        : Source_Ptr;
  84       Left_Opnd  : Node_Id;
  85       Right_Opnd : Node_Id) return Node_Id;
  86    --  This is like Make_Op_Multiply except that it optimizes some cases
  87    --  knowing that associative rearrangement is allowed for constant folding
  88    --  if one of the operands is a compile time known value
  89
  90    function Assoc_Subtract
  91      (Loc        : Source_Ptr;
  92       Left_Opnd  : Node_Id;
  93       Right_Opnd : Node_Id) return Node_Id;
  94    --  This is like Make_Op_Subtract except that it optimizes some cases
  95    --  knowing that associative rearrangement is allowed for constant folding
  96    --  if one of the operands is a compile time known value
  97
  98    function Bits_To_SU (N : Node_Id) return Node_Id;
  99    --  This is used when we cross the boundary from static sizes in bits to
 100    --  dynamic sizes in storage units. If the argument N is anything other
 101    --  than an integer literal, it is returned unchanged, but if it is an
 102    --  integer literal, then it is taken as a size in bits, and is replaced
 103    --  by the corresponding size in storage units.
 104
 105    function Compute_Length (Lo : Node_Id; Hi : Node_Id) return Node_Id;
 106    --  Given expressions for the low bound (Lo) and the high bound (Hi),
 107    --  Build an expression for the value hi-lo+1, converted to type
 108    --  Standard.Unsigned. Takes care of the case where the operands
 109    --  are of an enumeration type (so that the subtraction cannot be
 110    --  done directly) by applying the Pos operator to Hi/Lo first.
 111
 112    procedure Compute_Size_Depends_On_Discriminant (E : Entity_Id);
 113    --  Given an array type or an array subtype E, compute whether its size
 114    --  depends on the value of one or more discriminants and set the flag
 115    --  Size_Depends_On_Discriminant accordingly. This need not be called
 116    --  in front end layout mode since it does the computation on its own.
 117
 118    function Expr_From_SO_Ref
 119      (Loc  : Source_Ptr;
 120       D    : SO_Ref;
 121       Comp : Entity_Id := Empty) return Node_Id;
 122    --  Given a value D from a size or offset field, return an expression
 123    --  representing the value stored. If the value is known at compile time,
 124    --  then an N_Integer_Literal is returned with the appropriate value. If
 125    --  the value references a constant entity, then an N_Identifier node
 126    --  referencing this entity is returned. If the value denotes a size
 127    --  function, then returns a call node denoting the given function, with
 128    --  a single actual parameter that either refers to the parameter V of
 129    --  an enclosing size function (if Comp is Empty or its type doesn't match
 130    --  the function's formal), or else is a selected component V.c when Comp
 131    --  denotes a component c whose type matches that of the function formal.
 132    --  The Loc value is used for the Sloc value of constructed notes.
 133
 134    function SO_Ref_From_Expr
 135      (Expr      : Node_Id;
 136       Ins_Type  : Entity_Id;
 137       Vtype     : Entity_Id := Empty;
 138       Make_Func : Boolean   := False) return Dynamic_SO_Ref;
 139    --  This routine is used in the case where a size/offset value is dynamic
 140    --  and is represented by the expression Expr. SO_Ref_From_Expr checks if
 141    --  the Expr contains a reference to the identifier V, and if so builds
 142    --  a function depending on discriminants of the formal parameter V which
 143    --  is of type Vtype. Otherwise, if the parameter Make_Func is True, then
 144    --  Expr will be encapsulated in a parameterless function; if Make_Func is
 145    --  False, then a constant entity with the value Expr is built. The result
 146    --  is a Dynamic_SO_Ref to the created entity. Note that Vtype can be
 147    --  omitted if Expr does not contain any reference to V, the created entity.
 148    --  The declaration created is inserted in the freeze actions of Ins_Type,
 149    --  which also supplies the Sloc for created nodes. This function also takes
 150    --  care of making sure that the expression is properly analyzed and
 151    --  resolved (which may not be the case yet if we build the expression
 152    --  in this unit).
 153
 154    function Get_Max_SU_Size (E : Entity_Id) return Node_Id;
 155    --  E is an array type or subtype that has at least one index bound that
 156    --  is the value of a record discriminant. For such an array, the function
 157    --  computes an expression that yields the maximum possible size of the
 158    --  array in storage units. The result is not defined for any other type,
 159    --  or for arrays that do not depend on discriminants, and it is a fatal
 160    --  error to call this unless Size_Depends_On_Discriminant (E) is True.
 161
 162    procedure Layout_Array_Type (E : Entity_Id);
 163    --  Front-end layout of non-bit-packed array type or subtype
 164
 165    procedure Layout_Record_Type (E : Entity_Id);
 166    --  Front-end layout of record type
 167
 168    procedure Rewrite_Integer (N : Node_Id; V : Uint);
 169    --  Rewrite node N with an integer literal whose value is V. The Sloc for
 170    --  the new node is taken from N, and the type of the literal is set to a
 171    --  copy of the type of N on entry.
 172
 173    procedure Set_And_Check_Static_Size
 174      (E      : Entity_Id;
 175       Esiz   : SO_Ref;
 176       RM_Siz : SO_Ref);
 177    --  This procedure is called to check explicit given sizes (possibly stored
 178    --  in the Esize and RM_Size fields of E) against computed Object_Size
 179    --  (Esiz) and Value_Size (RM_Siz) values. Appropriate errors and warnings
 180    --  are posted if specified sizes are inconsistent with specified sizes. On
 181    --  return, Esize and RM_Size fields of E are set (either from previously
 182    --  given values, or from the newly computed values, as appropriate).
 183
 184    procedure Set_Composite_Alignment (E : Entity_Id);
 185    --  This procedure is called for record types and subtypes, and also for
 186    --  atomic array types and subtypes. If no alignment is set, and the size
 187    --  is 2 or 4 (or 8 if the word size is 8), then the alignment is set to
 188    --  match the size.
 189
 190    ----------------------------
 191    -- Adjust_Esize_Alignment --
 192    ----------------------------
 193
 194    procedure Adjust_Esize_Alignment (E : Entity_Id) is
 195       Abits     : Int;
 196       Esize_Set : Boolean;
 197
 198    begin
 199       --  Nothing to do if size unknown
 200
 201       if Unknown_Esize (E) then
 202          return;
 203       end if;
 204
 205       --  Determine if size is constrained by an attribute definition clause
 206       --  which must be obeyed. If so, we cannot increase the size in this
 207       --  routine.
 208
 209       --  For a type, the issue is whether an object size clause has been set.
 210       --  A normal size clause constrains only the value size (RM_Size)
 211
 212       if Is_Type (E) then
 213          Esize_Set := Has_Object_Size_Clause (E);
 214
 215       --  For an object, the issue is whether a size clause is present
 216
 217       else
 218          Esize_Set := Has_Size_Clause (E);
 219       end if;
 220
 221       --  If size is known it must be a multiple of the storage unit size
 222
 223       if Esize (E) mod SSU /= 0 then
 224
 225          --  If not, and size specified, then give error
 226
 227          if Esize_Set then
 228             Error_Msg_NE
 229               ("size for& not a multiple of storage unit size",
 230                Size_Clause (E), E);
 231             return;
 232
 233          --  Otherwise bump up size to a storage unit boundary
 234
 235          else
 236             Set_Esize (E, (Esize (E) + SSU - 1) / SSU * SSU);
 237          end if;
 238       end if;
 239
 240       --  Now we have the size set, it must be a multiple of the alignment
 241       --  nothing more we can do here if the alignment is unknown here.
 242
 243       if Unknown_Alignment (E) then
 244          return;
 245       end if;
 246
 247       --  At this point both the Esize and Alignment are known, so we need
 248       --  to make sure they are consistent.
 249
 250       Abits := UI_To_Int (Alignment (E)) * SSU;
 251
 252       if Esize (E) mod Abits = 0 then
 253          return;
 254       end if;
 255
 256       --  Here we have a situation where the Esize is not a multiple of the
 257       --  alignment. We must either increase Esize or reduce the alignment to
 258       --  correct this situation.
 259
 260       --  The case in which we can decrease the alignment is where the
 261       --  alignment was not set by an alignment clause, and the type in
 262       --  question is a discrete type, where it is definitely safe to reduce
 263       --  the alignment. For example:
 264
 265       --    t : integer range 1 .. 2;
 266       --    for t'size use 8;
 267
 268       --  In this situation, the initial alignment of t is 4, copied from
 269       --  the Integer base type, but it is safe to reduce it to 1 at this
 270       --  stage, since we will only be loading a single storage unit.
 271
 272       if Is_Discrete_Type (Etype (E))
 273         and then not Has_Alignment_Clause (E)
 274       then
 275          loop
 276             Abits := Abits / 2;
 277             exit when Esize (E) mod Abits = 0;
 278          end loop;
 279
 280          Init_Alignment (E, Abits / SSU);
 281          return;
 282       end if;
 283
 284       --  Now the only possible approach left is to increase the Esize but we
 285       --  can't do that if the size was set by a specific clause.
 286
 287       if Esize_Set then
 288          Error_Msg_NE
 289            ("size for& is not a multiple of alignment",
 290             Size_Clause (E), E);
 291
 292       --  Otherwise we can indeed increase the size to a multiple of alignment
 293
 294       else
 295          Set_Esize (E, ((Esize (E) + (Abits - 1)) / Abits) * Abits);
 296       end if;
 297    end Adjust_Esize_Alignment;
 298
 299    ---------------
 300    -- Assoc_Add --
 301    ---------------
 302
 303    function Assoc_Add
 304      (Loc        : Source_Ptr;
 305       Left_Opnd  : Node_Id;
 306       Right_Opnd : Node_Id) return Node_Id
 307    is
 308       L : Node_Id;
 309       R : Uint;
 310
 311    begin
 312       --  Case of right operand is a constant
 313
 314       if Compile_Time_Known_Value (Right_Opnd) then
 315          L := Left_Opnd;
 316          R := Expr_Value (Right_Opnd);
 317
 318       --  Case of left operand is a constant
 319
 320       elsif Compile_Time_Known_Value (Left_Opnd) then
 321          L := Right_Opnd;
 322          R := Expr_Value (Left_Opnd);
 323
 324       --  Neither operand is a constant, do the addition with no optimization
 325
 326       else
 327          return Make_Op_Add (Loc, Left_Opnd, Right_Opnd);
 328       end if;
 329
 330       --  Case of left operand is an addition
 331
 332       if Nkind (L) = N_Op_Add then
 333
 334          --  (C1 + E) + C2 = (C1 + C2) + E
 335
 336          if Compile_Time_Known_Value (Sinfo.Left_Opnd (L)) then
 337             Rewrite_Integer
 338               (Sinfo.Left_Opnd (L),
 339                Expr_Value (Sinfo.Left_Opnd (L)) + R);
 340             return L;
 341
 342          --  (E + C1) + C2 = E + (C1 + C2)
 343
 344          elsif Compile_Time_Known_Value (Sinfo.Right_Opnd (L)) then
 345             Rewrite_Integer
 346               (Sinfo.Right_Opnd (L),
 347                Expr_Value (Sinfo.Right_Opnd (L)) + R);
 348             return L;
 349          end if;
 350
 351       --  Case of left operand is a subtraction
 352
 353       elsif Nkind (L) = N_Op_Subtract then
 354
 355          --  (C1 - E) + C2 = (C1 + C2) + E
 356
 357          if Compile_Time_Known_Value (Sinfo.Left_Opnd (L)) then
 358             Rewrite_Integer
 359               (Sinfo.Left_Opnd (L),
 360                Expr_Value (Sinfo.Left_Opnd (L)) + R);
 361             return L;
 362
 363          --  (E - C1) + C2 = E - (C1 - C2)
 364
 365          elsif Compile_Time_Known_Value (Sinfo.Right_Opnd (L)) then
 366             Rewrite_Integer
 367               (Sinfo.Right_Opnd (L),
 368                Expr_Value (Sinfo.Right_Opnd (L)) - R);
 369             return L;
 370          end if;
 371       end if;
 372
 373       --  Not optimizable, do the addition
 374
 375       return Make_Op_Add (Loc, Left_Opnd, Right_Opnd);
 376    end Assoc_Add;
 377
 378    --------------------
 379    -- Assoc_Multiply --
 380    --------------------
 381
 382    function Assoc_Multiply
 383      (Loc        : Source_Ptr;
 384       Left_Opnd  : Node_Id;
 385       Right_Opnd : Node_Id) return Node_Id
 386    is
 387       L : Node_Id;
 388       R : Uint;
 389
 390    begin
 391       --  Case of right operand is a constant
 392
 393       if Compile_Time_Known_Value (Right_Opnd) then
 394          L := Left_Opnd;
 395          R := Expr_Value (Right_Opnd);
 396
 397       --  Case of left operand is a constant
 398
 399       elsif Compile_Time_Known_Value (Left_Opnd) then
 400          L := Right_Opnd;
 401          R := Expr_Value (Left_Opnd);
 402
 403       --  Neither operand is a constant, do the multiply with no optimization
 404
 405       else
 406          return Make_Op_Multiply (Loc, Left_Opnd, Right_Opnd);
 407       end if;
 408
 409       --  Case of left operand is an multiplication
 410
 411       if Nkind (L) = N_Op_Multiply then
 412
 413          --  (C1 * E) * C2 = (C1 * C2) + E
 414
 415          if Compile_Time_Known_Value (Sinfo.Left_Opnd (L)) then
 416             Rewrite_Integer
 417               (Sinfo.Left_Opnd (L),
 418                Expr_Value (Sinfo.Left_Opnd (L)) * R);
 419             return L;
 420
 421          --  (E * C1) * C2 = E * (C1 * C2)
 422
 423          elsif Compile_Time_Known_Value (Sinfo.Right_Opnd (L)) then
 424             Rewrite_Integer
 425               (Sinfo.Right_Opnd (L),
 426                Expr_Value (Sinfo.Right_Opnd (L)) * R);
 427             return L;
 428          end if;
 429       end if;
 430
 431       --  Not optimizable, do the multiplication
 432
 433       return Make_Op_Multiply (Loc, Left_Opnd, Right_Opnd);
 434    end Assoc_Multiply;
 435
 436    --------------------
 437    -- Assoc_Subtract --
 438    --------------------
 439
 440    function Assoc_Subtract
 441      (Loc        : Source_Ptr;
 442       Left_Opnd  : Node_Id;
 443       Right_Opnd : Node_Id) return Node_Id
 444    is
 445       L : Node_Id;
 446       R : Uint;
 447
 448    begin
 449       --  Case of right operand is a constant
 450
 451       if Compile_Time_Known_Value (Right_Opnd) then
 452          L := Left_Opnd;
 453          R := Expr_Value (Right_Opnd);
 454
 455       --  Right operand is a constant, do the subtract with no optimization
 456
 457       else
 458          return Make_Op_Subtract (Loc, Left_Opnd, Right_Opnd);
 459       end if;
 460
 461       --  Case of left operand is an addition
 462
 463       if Nkind (L) = N_Op_Add then
 464
 465          --  (C1 + E) - C2 = (C1 - C2) + E
 466
 467          if Compile_Time_Known_Value (Sinfo.Left_Opnd (L)) then
 468             Rewrite_Integer
 469               (Sinfo.Left_Opnd (L),
 470                Expr_Value (Sinfo.Left_Opnd (L)) - R);
 471             return L;
 472
 473          --  (E + C1) - C2 = E + (C1 - C2)
 474
 475          elsif Compile_Time_Known_Value (Sinfo.Right_Opnd (L)) then
 476             Rewrite_Integer
 477               (Sinfo.Right_Opnd (L),
 478                Expr_Value (Sinfo.Right_Opnd (L)) - R);
 479             return L;
 480          end if;
 481
 482       --  Case of left operand is a subtraction
 483
 484       elsif Nkind (L) = N_Op_Subtract then
 485
 486          --  (C1 - E) - C2 = (C1 - C2) + E
 487
 488          if Compile_Time_Known_Value (Sinfo.Left_Opnd (L)) then
 489             Rewrite_Integer
 490               (Sinfo.Left_Opnd (L),
 491                Expr_Value (Sinfo.Left_Opnd (L)) + R);
 492             return L;
 493
 494          --  (E - C1) - C2 = E - (C1 + C2)
 495
 496          elsif Compile_Time_Known_Value (Sinfo.Right_Opnd (L)) then
 497             Rewrite_Integer
 498               (Sinfo.Right_Opnd (L),
 499                Expr_Value (Sinfo.Right_Opnd (L)) + R);
 500             return L;
 501          end if;
 502       end if;
 503
 504       --  Not optimizable, do the subtraction
 505
 506       return Make_Op_Subtract (Loc, Left_Opnd, Right_Opnd);
 507    end Assoc_Subtract;
 508
 509    ----------------
 510    -- Bits_To_SU --
 511    ----------------
 512
 513    function Bits_To_SU (N : Node_Id) return Node_Id is
 514    begin
 515       if Nkind (N) = N_Integer_Literal then
 516          Set_Intval (N, (Intval (N) + (SSU - 1)) / SSU);
 517       end if;
 518
 519       return N;
 520    end Bits_To_SU;
 521
 522    --------------------
 523    -- Compute_Length --
 524    --------------------
 525
 526    function Compute_Length (Lo : Node_Id; Hi : Node_Id) return Node_Id is
 527       Loc    : constant Source_Ptr := Sloc (Lo);
 528       Typ    : constant Entity_Id  := Etype (Lo);
 529       Lo_Op  : Node_Id;
 530       Hi_Op  : Node_Id;
 531       Lo_Dim : Uint;
 532       Hi_Dim : Uint;
 533
 534    begin
 535       --  If the bounds are First and Last attributes for the same dimension
 536       --  and both have prefixes that denotes the same entity, then we create
 537       --  and return a Length attribute. This may allow the back end to
 538       --  generate better code in cases where it already has the length.
 539
 540       if Nkind (Lo) = N_Attribute_Reference
 541         and then Attribute_Name (Lo) = Name_First
 542         and then Nkind (Hi) = N_Attribute_Reference
 543         and then Attribute_Name (Hi) = Name_Last
 544         and then Is_Entity_Name (Prefix (Lo))
 545         and then Is_Entity_Name (Prefix (Hi))
 546         and then Entity (Prefix (Lo)) = Entity (Prefix (Hi))
 547       then
 548          Lo_Dim := Uint_1;
 549          Hi_Dim := Uint_1;
 550
 551          if Present (First (Expressions (Lo))) then
 552             Lo_Dim := Expr_Value (First (Expressions (Lo)));
 553          end if;
 554
 555          if Present (First (Expressions (Hi))) then
 556             Hi_Dim := Expr_Value (First (Expressions (Hi)));
 557          end if;
 558
 559          if Lo_Dim = Hi_Dim then
 560             return
 561               Make_Attribute_Reference (Loc,
 562                 Prefix         => New_Occurrence_Of
 563                                     (Entity (Prefix (Lo)), Loc),
 564                 Attribute_Name => Name_Length,
 565                 Expressions    => New_List
 566                                     (Make_Integer_Literal (Loc, Lo_Dim)));
 567          end if;
 568       end if;
 569
 570       Lo_Op := New_Copy_Tree (Lo);
 571       Hi_Op := New_Copy_Tree (Hi);
 572
 573       --  If type is enumeration type, then use Pos attribute to convert
 574       --  to integer type for which subtraction is a permitted operation.
 575
 576       if Is_Enumeration_Type (Typ) then
 577          Lo_Op :=
 578            Make_Attribute_Reference (Loc,
 579              Prefix         => New_Occurrence_Of (Typ, Loc),
 580              Attribute_Name => Name_Pos,
 581              Expressions    => New_List (Lo_Op));
 582
 583          Hi_Op :=
 584            Make_Attribute_Reference (Loc,
 585              Prefix         => New_Occurrence_Of (Typ, Loc),
 586              Attribute_Name => Name_Pos,
 587              Expressions    => New_List (Hi_Op));
 588       end if;
 589
 590       return
 591         Assoc_Add (Loc,
 592           Left_Opnd =>
 593             Assoc_Subtract (Loc,
 594               Left_Opnd  => Hi_Op,
 595               Right_Opnd => Lo_Op),
 596           Right_Opnd => Make_Integer_Literal (Loc, 1));
 597    end Compute_Length;
 598
 599    ----------------------
 600    -- Expr_From_SO_Ref --
 601    ----------------------
 602
 603    function Expr_From_SO_Ref
 604      (Loc  : Source_Ptr;
 605       D    : SO_Ref;
 606       Comp : Entity_Id := Empty) return Node_Id
 607    is
 608       Ent : Entity_Id;
 609
 610    begin
 611       if Is_Dynamic_SO_Ref (D) then
 612          Ent := Get_Dynamic_SO_Entity (D);
 613
 614          if Is_Discrim_SO_Function (Ent) then
 615
 616             --  If a component is passed in whose type matches the type of
 617             --  the function formal, then select that component from the "V"
 618             --  parameter rather than passing "V" directly.
 619
 620             if Present (Comp)
 621                and then Base_Type (Etype (Comp))
 622                           = Base_Type (Etype (First_Formal (Ent)))
 623             then
 624                return
 625                  Make_Function_Call (Loc,
 626                    Name                   => New_Occurrence_Of (Ent, Loc),
 627                    Parameter_Associations => New_List (
 628                      Make_Selected_Component (Loc,
 629                        Prefix        => Make_Identifier (Loc, Vname),
 630                        Selector_Name => New_Occurrence_Of (Comp, Loc))));
 631
 632             else
 633                return
 634                  Make_Function_Call (Loc,
 635                    Name                   => New_Occurrence_Of (Ent, Loc),
 636                    Parameter_Associations => New_List (
 637                      Make_Identifier (Loc, Vname)));
 638             end if;
 639
 640          else
 641             return New_Occurrence_Of (Ent, Loc);
 642          end if;
 643
 644       else
 645          return Make_Integer_Literal (Loc, D);
 646       end if;
 647    end Expr_From_SO_Ref;
 648
 649    ---------------------
 650    -- Get_Max_SU_Size --
 651    ---------------------
 652
 653    function Get_Max_SU_Size (E : Entity_Id) return Node_Id is
 654       Loc  : constant Source_Ptr := Sloc (E);
 655       Indx : Node_Id;
 656       Ityp : Entity_Id;
 657       Lo   : Node_Id;
 658       Hi   : Node_Id;
 659       S    : Uint;
 660       Len  : Node_Id;
 661
 662       type Val_Status_Type is (Const, Dynamic);
 663
 664       type Val_Type (Status : Val_Status_Type := Const) is
 665          record
 666             case Status is
 667                when Const   => Val : Uint;
 668                when Dynamic => Nod : Node_Id;
 669             end case;
 670          end record;
 671       --  Shows the status of the value so far. Const means that the value is
 672       --  constant, and Val is the current constant value. Dynamic means that
 673       --  the value is dynamic, and in this case Nod is the Node_Id of the
 674       --  expression to compute the value.
 675
 676       Size : Val_Type;
 677       --  Calculated value so far if Size.Status = Const,
 678       --  or expression value so far if Size.Status = Dynamic.
 679
 680       SU_Convert_Required : Boolean := False;
 681       --  This is set to True if the final result must be converted from bits
 682       --  to storage units (rounding up to a storage unit boundary).
 683
 684       -----------------------
 685       -- Local Subprograms --
 686       -----------------------
 687
 688       procedure Max_Discrim (N : in out Node_Id);
 689       --  If the node N represents a discriminant, replace it by the maximum
 690       --  value of the discriminant.
 691
 692       procedure Min_Discrim (N : in out Node_Id);
 693       --  If the node N represents a discriminant, replace it by the minimum
 694       --  value of the discriminant.
 695
 696       -----------------
 697       -- Max_Discrim --
 698       -----------------
 699
 700       procedure Max_Discrim (N : in out Node_Id) is
 701       begin
 702          if Nkind (N) = N_Identifier
 703            and then Ekind (Entity (N)) = E_Discriminant
 704          then
 705             N := Type_High_Bound (Etype (N));
 706          end if;
 707       end Max_Discrim;
 708
 709       -----------------
 710       -- Min_Discrim --
 711       -----------------
 712
 713       procedure Min_Discrim (N : in out Node_Id) is
 714       begin
 715          if Nkind (N) = N_Identifier
 716            and then Ekind (Entity (N)) = E_Discriminant
 717          then
 718             N := Type_Low_Bound (Etype (N));
 719          end if;
 720       end Min_Discrim;
 721
 722    --  Start of processing for Get_Max_SU_Size
 723
 724    begin
 725       pragma Assert (Size_Depends_On_Discriminant (E));
 726
 727       --  Initialize status from component size
 728
 729       if Known_Static_Component_Size (E) then
 730          Size := (Const, Component_Size (E));
 731
 732       else
 733          Size := (Dynamic, Expr_From_SO_Ref (Loc, Component_Size (E)));
 734       end if;
 735
 736       --  Loop through indexes
 737
 738       Indx := First_Index (E);
 739       while Present (Indx) loop
 740          Ityp := Etype (Indx);
 741          Lo := Type_Low_Bound (Ityp);
 742          Hi := Type_High_Bound (Ityp);
 743
 744          Min_Discrim (Lo);
 745          Max_Discrim (Hi);
 746
 747          --  Value of the current subscript range is statically known
 748
 749          if Compile_Time_Known_Value (Lo)
 750            and then Compile_Time_Known_Value (Hi)
 751          then
 752             S := Expr_Value (Hi) - Expr_Value (Lo) + 1;
 753
 754             --  If known flat bound, entire size of array is zero!
 755
 756             if S <= 0 then
 757                return Make_Integer_Literal (Loc, 0);
 758             end if;
 759
 760             --  Current value is constant, evolve value
 761
 762             if Size.Status = Const then
 763                Size.Val := Size.Val * S;
 764
 765             --  Current value is dynamic
 766
 767             else
 768                --  An interesting little optimization, if we have a pending
 769                --  conversion from bits to storage units, and the current
 770                --  length is a multiple of the storage unit size, then we
 771                --  can take the factor out here statically, avoiding some
 772                --  extra dynamic computations at the end.
 773
 774                if SU_Convert_Required and then S mod SSU = 0 then
 775                   S := S / SSU;
 776                   SU_Convert_Required := False;
 777                end if;
 778
 779                Size.Nod :=
 780                  Assoc_Multiply (Loc,
 781                    Left_Opnd  => Size.Nod,
 782                    Right_Opnd =>
 783                      Make_Integer_Literal (Loc, Intval => S));
 784             end if;
 785
 786          --  Value of the current subscript range is dynamic
 787
 788          else
 789             --  If the current size value is constant, then here is where we
 790             --  make a transition to dynamic values, which are always stored
 791             --  in storage units, However, we do not want to convert to SU's
 792             --  too soon, consider the case of a packed array of single bits,
 793             --  we want to do the SU conversion after computing the size in
 794             --  this case.
 795
 796             if Size.Status = Const then
 797
 798                --  If the current value is a multiple of the storage unit,
 799                --  then most certainly we can do the conversion now, simply
 800                --  by dividing the current value by the storage unit value.
 801                --  If this works, we set SU_Convert_Required to False.
 802
 803                if Size.Val mod SSU = 0 then
 804
 805                   Size :=
 806                     (Dynamic, Make_Integer_Literal (Loc, Size.Val / SSU));
 807                   SU_Convert_Required := False;
 808
 809                --  Otherwise, we go ahead and convert the value in bits, and
 810                --  set SU_Convert_Required to True to ensure that the final
 811                --  value is indeed properly converted.
 812
 813                else
 814                   Size := (Dynamic, Make_Integer_Literal (Loc, Size.Val));
 815                   SU_Convert_Required := True;
 816                end if;
 817             end if;
 818
 819             --  Length is hi-lo+1
 820
 821             Len := Compute_Length (Lo, Hi);
 822
 823             --  Check possible range of Len
 824
 825             declare
 826                OK  : Boolean;
 827                LLo : Uint;
 828                LHi : Uint;
 829                pragma Warnings (Off, LHi);
 830
 831             begin
 832                Set_Parent (Len, E);
 833                Determine_Range (Len, OK, LLo, LHi);
 834
 835                Len := Convert_To (Standard_Unsigned, Len);
 836
 837                --  If we cannot verify that range cannot be super-flat, we need
 838                --  a max with zero, since length must be non-negative.
 839
 840                if not OK or else LLo < 0 then
 841                   Len :=
 842                     Make_Attribute_Reference (Loc,
 843                       Prefix         =>
 844                         New_Occurrence_Of (Standard_Unsigned, Loc),
 845                       Attribute_Name => Name_Max,
 846                       Expressions    => New_List (
 847                         Make_Integer_Literal (Loc, 0),
 848                         Len));
 849                end if;
 850             end;
 851          end if;
 852
 853          Next_Index (Indx);
 854       end loop;
 855
 856       --  Here after processing all bounds to set sizes. If the value is a
 857       --  constant, then it is bits, so we convert to storage units.
 858
 859       if Size.Status = Const then
 860          return Bits_To_SU (Make_Integer_Literal (Loc, Size.Val));
 861
 862       --  Case where the value is dynamic
 863
 864       else
 865          --  Do convert from bits to SU's if needed
 866
 867          if SU_Convert_Required then
 868
 869             --  The expression required is (Size.Nod + SU - 1) / SU
 870
 871             Size.Nod :=
 872               Make_Op_Divide (Loc,
 873                 Left_Opnd =>
 874                   Make_Op_Add (Loc,
 875                     Left_Opnd  => Size.Nod,
 876                     Right_Opnd => Make_Integer_Literal (Loc, SSU - 1)),
 877                 Right_Opnd => Make_Integer_Literal (Loc, SSU));
 878          end if;
 879
 880          return Size.Nod;
 881       end if;
 882    end Get_Max_SU_Size;
 883
 884    -----------------------
 885    -- Layout_Array_Type --
 886    -----------------------
 887
 888    procedure Layout_Array_Type (E : Entity_Id) is
 889       Loc  : constant Source_Ptr := Sloc (E);
 890       Ctyp : constant Entity_Id  := Component_Type (E);
 891       Indx : Node_Id;
 892       Ityp : Entity_Id;
 893       Lo   : Node_Id;
 894       Hi   : Node_Id;
 895       S    : Uint;
 896       Len  : Node_Id;
 897
 898       Insert_Typ : Entity_Id;
 899       --  This is the type with which any generated constants or functions
 900       --  will be associated (i.e. inserted into the freeze actions). This
 901       --  is normally the type being laid out. The exception occurs when
 902       --  we are laying out Itype's which are local to a record type, and
 903       --  whose scope is this record type. Such types do not have freeze
 904       --  nodes (because we have no place to put them).
 905
 906       ------------------------------------
 907       -- How An Array Type is Laid Out --
 908       ------------------------------------
 909
 910       --  Here is what goes on. We need to multiply the component size of the
 911       --  array (which has already been set) by the length of each of the
 912       --  indexes. If all these values are known at compile time, then the
 913       --  resulting size of the array is the appropriate constant value.
 914
 915       --  If the component size or at least one bound is dynamic (but no
 916       --  discriminants are present), then the size will be computed as an
 917       --  expression that calculates the proper size.
 918
 919       --  If there is at least one discriminant bound, then the size is also
 920       --  computed as an expression, but this expression contains discriminant
 921       --  values which are obtained by selecting from a function parameter, and
 922       --  the size is given by a function that is passed the variant record in
 923       --  question, and whose body is the expression.
 924
 925       type Val_Status_Type is (Const, Dynamic, Discrim);
 926
 927       type Val_Type (Status : Val_Status_Type := Const) is
 928          record
 929             case Status is
 930                when Const =>
 931                   Val : Uint;
 932                   --  Calculated value so far if Val_Status = Const
 933
 934                when Dynamic | Discrim =>
 935                   Nod : Node_Id;
 936                   --  Expression value so far if Val_Status /= Const
 937
 938             end case;
 939          end record;
 940       --  Records the value or expression computed so far. Const means that
 941       --  the value is constant, and Val is the current constant value.
 942       --  Dynamic means that the value is dynamic, and in this case Nod is
 943       --  the Node_Id of the expression to compute the value, and Discrim
 944       --  means that at least one bound is a discriminant, in which case Nod
 945       --  is the expression so far (which will be the body of the function).
 946
 947       Size : Val_Type;
 948       --  Value of size computed so far. See comments above
 949
 950       Vtyp : Entity_Id := Empty;
 951       --  Variant record type for the formal parameter of the discriminant
 952       --  function V if Status = Discrim.
 953
 954       SU_Convert_Required : Boolean := False;
 955       --  This is set to True if the final result must be converted from
 956       --  bits to storage units (rounding up to a storage unit boundary).
 957
 958       Storage_Divisor : Uint := UI_From_Int (SSU);
 959       --  This is the amount that a nonstatic computed size will be divided
 960       --  by to convert it from bits to storage units. This is normally
 961       --  equal to SSU, but can be reduced in the case of packed components
 962       --  that fit evenly into a storage unit.
 963
 964       Make_Size_Function : Boolean := False;
 965       --  Indicates whether to request that SO_Ref_From_Expr should
 966       --  encapsulate the array size expression in a function.
 967
 968       procedure Discrimify (N : in out Node_Id);
 969       --  If N represents a discriminant, then the Size.Status is set to
 970       --  Discrim, and Vtyp is set. The parameter N is replaced with the
 971       --  proper expression to extract the discriminant value from V.
 972
 973       ----------------
 974       -- Discrimify --
 975       ----------------
 976
 977       procedure Discrimify (N : in out Node_Id) is
 978          Decl : Node_Id;
 979          Typ  : Entity_Id;
 980
 981       begin
 982          if Nkind (N) = N_Identifier
 983            and then Ekind (Entity (N)) = E_Discriminant
 984          then
 985             Set_Size_Depends_On_Discriminant (E);
 986
 987             if Size.Status /= Discrim then
 988                Decl := Parent (Parent (Entity (N)));
 989                Size := (Discrim, Size.Nod);
 990                Vtyp := Defining_Identifier (Decl);
 991             end if;
 992
 993             Typ := Etype (N);
 994
 995             N :=
 996               Make_Selected_Component (Loc,
 997                 Prefix        => Make_Identifier (Loc, Vname),
 998                 Selector_Name => New_Occurrence_Of (Entity (N), Loc));
 999
1000             --  Set the Etype attributes of the selected name and its prefix.
1001             --  Analyze_And_Resolve can't be called here because the Vname
1002             --  entity denoted by the prefix will not yet exist (it's created
1003             --  by SO_Ref_From_Expr, called at the end of Layout_Array_Type).
1004
1005             Set_Etype (Prefix (N), Vtyp);
1006             Set_Etype (N, Typ);
1007          end if;
1008       end Discrimify;
1009
1010    --  Start of processing for Layout_Array_Type
1011
1012    begin
1013       --  Default alignment is component alignment
1014
1015       if Unknown_Alignment (E) then
1016          Set_Alignment (E, Alignment (Ctyp));
1017       end if;
1018
1019       --  Calculate proper type for insertions
1020
1021       if Is_Record_Type (Underlying_Type (Scope (E))) then
1022          Insert_Typ := Underlying_Type (Scope (E));
1023       else
1024          Insert_Typ := E;
1025       end if;
1026
1027       --  If the component type is a generic formal type then there's no point
1028       --  in determining a size for the array type.
1029
1030       if Is_Generic_Type (Ctyp) then
1031          return;
1032       end if;
1033
1034       --  Deal with component size if base type
1035
1036       if Ekind (E) = E_Array_Type then
1037
1038          --  Cannot do anything if Esize of component type unknown
1039
1040          if Unknown_Esize (Ctyp) then
1041             return;
1042          end if;
1043
1044          --  Set component size if not set already
1045
1046          if Unknown_Component_Size (E) then
1047             Set_Component_Size (E, Esize (Ctyp));
1048          end if;
1049       end if;
1050
1051       --  (RM 13.3 (48)) says that the size of an unconstrained array
1052       --  is implementation defined. We choose to leave it as Unknown
1053       --  here, and the actual behavior is determined by the back end.
1054
1055       if not Is_Constrained (E) then
1056          return;
1057       end if;
1058
1059       --  Initialize status from component size
1060
1061       if Known_Static_Component_Size (E) then
1062          Size := (Const, Component_Size (E));
1063
1064       else
1065          Size := (Dynamic, Expr_From_SO_Ref (Loc, Component_Size (E)));
1066       end if;
1067
1068       --  Loop to process array indexes
1069
1070       Indx := First_Index (E);
1071       while Present (Indx) loop
1072          Ityp := Etype (Indx);
1073
1074          --  If an index of the array is a generic formal type then there is
1075          --  no point in determining a size for the array type.
1076
1077          if Is_Generic_Type (Ityp) then
1078             return;
1079          end if;
1080
1081          Lo := Type_Low_Bound (Ityp);
1082          Hi := Type_High_Bound (Ityp);
1083
1084          --  Value of the current subscript range is statically known
1085
1086          if Compile_Time_Known_Value (Lo)
1087            and then Compile_Time_Known_Value (Hi)
1088          then
1089             S := Expr_Value (Hi) - Expr_Value (Lo) + 1;
1090
1091             --  If known flat bound, entire size of array is zero!
1092
1093             if S <= 0 then
1094                Set_Esize (E, Uint_0);
1095                Set_RM_Size (E, Uint_0);
1096                return;
1097             end if;
1098
1099             --  If constant, evolve value
1100
1101             if Size.Status = Const then
1102                Size.Val := Size.Val * S;
1103
1104             --  Current value is dynamic
1105
1106             else
1107                --  An interesting little optimization, if we have a pending
1108                --  conversion from bits to storage units, and the current
1109                --  length is a multiple of the storage unit size, then we
1110                --  can take the factor out here statically, avoiding some
1111                --  extra dynamic computations at the end.
1112
1113                if SU_Convert_Required and then S mod SSU = 0 then
1114                   S := S / SSU;
1115                   SU_Convert_Required := False;
1116                end if;
1117
1118                --  Now go ahead and evolve the expression
1119
1120                Size.Nod :=
1121                  Assoc_Multiply (Loc,
1122                    Left_Opnd  => Size.Nod,
1123                    Right_Opnd =>
1124                      Make_Integer_Literal (Loc, Intval => S));
1125             end if;
1126
1127          --  Value of the current subscript range is dynamic
1128
1129          else
1130             --  If the current size value is constant, then here is where we
1131             --  make a transition to dynamic values, which are always stored
1132             --  in storage units, However, we do not want to convert to SU's
1133             --  too soon, consider the case of a packed array of single bits,
1134             --  we want to do the SU conversion after computing the size in
1135             --  this case.
1136
1137             if Size.Status = Const then
1138
1139                --  If the current value is a multiple of the storage unit,
1140                --  then most certainly we can do the conversion now, simply
1141                --  by dividing the current value by the storage unit value.
1142                --  If this works, we set SU_Convert_Required to False.
1143
1144                if Size.Val mod SSU = 0 then
1145                   Size :=
1146                     (Dynamic, Make_Integer_Literal (Loc, Size.Val / SSU));
1147                   SU_Convert_Required := False;
1148
1149                --  If the current value is a factor of the storage unit, then
1150                --  we can use a value of one for the size and reduce the
1151                --  strength of the later division.
1152
1153                elsif SSU mod Size.Val = 0 then
1154                   Storage_Divisor := SSU / Size.Val;
1155                   Size := (Dynamic, Make_Integer_Literal (Loc, Uint_1));
1156                   SU_Convert_Required := True;
1157
1158                --  Otherwise, we go ahead and convert the value in bits, and
1159                --  set SU_Convert_Required to True to ensure that the final
1160                --  value is indeed properly converted.
1161
1162                else
1163                   Size := (Dynamic, Make_Integer_Literal (Loc, Size.Val));
1164                   SU_Convert_Required := True;
1165                end if;
1166             end if;
1167
1168             Discrimify (Lo);
1169             Discrimify (Hi);
1170
1171             --  Length is hi-lo+1
1172
1173             Len := Compute_Length (Lo, Hi);
1174
1175             --  If Len isn't a Length attribute, then its range needs to be
1176             --  checked a possible Max with zero needs to be computed.
1177
1178             if Nkind (Len) /= N_Attribute_Reference
1179               or else Attribute_Name (Len) /= Name_Length
1180             then
1181                declare
1182                   OK  : Boolean;
1183                   LLo : Uint;
1184                   LHi : Uint;
1185
1186                begin
1187                   --  Check possible range of Len
1188
1189                   Set_Parent (Len, E);
1190                   Determine_Range (Len, OK, LLo, LHi);
1191
1192                   Len := Convert_To (Standard_Unsigned, Len);
1193
1194                   --  If range definitely flat or superflat,
1195                   --  result size is zero
1196
1197                   if OK and then LHi <= 0 then
1198                      Set_Esize (E, Uint_0);
1199                      Set_RM_Size (E, Uint_0);
1200                      return;
1201                   end if;
1202
1203                   --  If we cannot verify that range cannot be super-flat, we
1204                   --  need a max with zero, since length cannot be negative.
1205
1206                   if not OK or else LLo < 0 then
1207                      Len :=
1208                        Make_Attribute_Reference (Loc,
1209                          Prefix         =>
1210                            New_Occurrence_Of (Standard_Unsigned, Loc),
1211                          Attribute_Name => Name_Max,
1212                          Expressions    => New_List (
1213                            Make_Integer_Literal (Loc, 0),
1214                            Len));
1215                   end if;
1216                end;
1217             end if;
1218
1219             --  At this stage, Len has the expression for the length
1220
1221             Size.Nod :=
1222               Assoc_Multiply (Loc,
1223                 Left_Opnd  => Size.Nod,
1224                 Right_Opnd => Len);
1225          end if;
1226
1227          Next_Index (Indx);
1228       end loop;
1229
1230       --  Here after processing all bounds to set sizes. If the value is a
1231       --  constant, then it is bits, and the only thing we need to do is to
1232       --  check against explicit given size and do alignment adjust.
1233
1234       if Size.Status = Const then
1235          Set_And_Check_Static_Size (E, Size.Val, Size.Val);
1236          Adjust_Esize_Alignment (E);
1237
1238       --  Case where the value is dynamic
1239
1240       else
1241          --  Do convert from bits to SU's if needed
1242
1243          if SU_Convert_Required then
1244
1245             --  The expression required is:
1246             --    (Size.Nod + Storage_Divisor - 1) / Storage_Divisor
1247
1248             Size.Nod :=
1249               Make_Op_Divide (Loc,
1250                 Left_Opnd =>
1251                   Make_Op_Add (Loc,
1252                     Left_Opnd  => Size.Nod,
1253                     Right_Opnd => Make_Integer_Literal
1254                                     (Loc, Storage_Divisor - 1)),
1255                 Right_Opnd => Make_Integer_Literal (Loc, Storage_Divisor));
1256          end if;
1257
1258          --  If the array entity is not declared at the library level and its
1259          --  not nested within a subprogram that is marked for inlining, then
1260          --  we request that the size expression be encapsulated in a function.
1261          --  Since this expression is not needed in most cases, we prefer not
1262          --  to incur the overhead of the computation on calls to the enclosing
1263          --  subprogram except for subprograms that require the size.
1264
1265          if not Is_Library_Level_Entity (E) then
1266             Make_Size_Function := True;
1267
1268             declare
1269                Parent_Subp : Entity_Id := Enclosing_Subprogram (E);
1270
1271             begin
1272                while Present (Parent_Subp) loop
1273                   if Is_Inlined (Parent_Subp) then
1274                      Make_Size_Function := False;
1275                      exit;
1276                   end if;
1277
1278                   Parent_Subp := Enclosing_Subprogram (Parent_Subp);
1279                end loop;
1280             end;
1281          end if;
1282
1283          --  Now set the dynamic size (the Value_Size is always the same as the
1284          --  Object_Size for arrays whose length is dynamic).
1285
1286          --  ??? If Size.Status = Dynamic, Vtyp will not have been set.
1287          --  The added initialization sets it to Empty now, but is this
1288          --  correct?
1289
1290          Set_Esize
1291            (E,
1292             SO_Ref_From_Expr
1293               (Size.Nod, Insert_Typ, Vtyp, Make_Func => Make_Size_Function));
1294          Set_RM_Size (E, Esize (E));
1295       end if;
1296    end Layout_Array_Type;
1297
1298    ------------------------------------------
1299    -- Compute_Size_Depends_On_Discriminant --
1300    ------------------------------------------
1301
1302    procedure Compute_Size_Depends_On_Discriminant (E : Entity_Id) is
1303       Indx : Node_Id;
1304       Ityp : Entity_Id;
1305       Lo   : Node_Id;
1306       Hi   : Node_Id;
1307       Res  : Boolean := False;
1308
1309    begin
1310       --  Loop to process array indexes
1311
1312       Indx := First_Index (E);
1313       while Present (Indx) loop
1314          Ityp := Etype (Indx);
1315
1316          --  If an index of the array is a generic formal type then there is
1317          --  no point in determining a size for the array type.
1318
1319          if Is_Generic_Type (Ityp) then
1320             return;
1321          end if;
1322
1323          Lo := Type_Low_Bound (Ityp);
1324          Hi := Type_High_Bound (Ityp);
1325
1326          if (Nkind (Lo) = N_Identifier
1327               and then Ekind (Entity (Lo)) = E_Discriminant)
1328            or else
1329             (Nkind (Hi) = N_Identifier
1330               and then Ekind (Entity (Hi)) = E_Discriminant)
1331          then
1332             Res := True;
1333          end if;
1334
1335          Next_Index (Indx);
1336       end loop;
1337
1338       if Res then
1339          Set_Size_Depends_On_Discriminant (E);
1340       end if;
1341    end Compute_Size_Depends_On_Discriminant;
1342
1343    -------------------
1344    -- Layout_Object --
1345    -------------------
1346
1347    procedure Layout_Object (E : Entity_Id) is
1348       T : constant Entity_Id := Etype (E);
1349
1350    begin
1351       --  Nothing to do if backend does layout
1352
1353       if not Frontend_Layout_On_Target then
1354          return;
1355       end if;
1356
1357       --  Set size if not set for object and known for type. Use the RM_Size if
1358       --  that is known for the type and Esize is not.
1359
1360       if Unknown_Esize (E) then
1361          if Known_Esize (T) then
1362             Set_Esize (E, Esize (T));
1363
1364          elsif Known_RM_Size (T) then
1365             Set_Esize (E, RM_Size (T));
1366          end if;
1367       end if;
1368
1369       --  Set alignment from type if unknown and type alignment known
1370
1371       if Unknown_Alignment (E) and then Known_Alignment (T) then
1372          Set_Alignment (E, Alignment (T));
1373       end if;
1374
1375       --  Make sure size and alignment are consistent
1376
1377       Adjust_Esize_Alignment (E);
1378
1379       --  Final adjustment, if we don't know the alignment, and the Esize was
1380       --  not set by an explicit Object_Size attribute clause, then we reset
1381       --  the Esize to unknown, since we really don't know it.
1382
1383       if Unknown_Alignment (E)
1384         and then not Has_Size_Clause (E)
1385       then
1386          Set_Esize (E, Uint_0);
1387       end if;
1388    end Layout_Object;
1389
1390    ------------------------
1391    -- Layout_Record_Type --
1392    ------------------------
1393
1394    procedure Layout_Record_Type (E : Entity_Id) is
1395       Loc  : constant Source_Ptr := Sloc (E);
1396       Decl : Node_Id;
1397
1398       Comp : Entity_Id;
1399       --  Current component being laid out
1400
1401       Prev_Comp : Entity_Id;
1402       --  Previous laid out component
1403
1404       procedure Get_Next_Component_Location
1405         (Prev_Comp  : Entity_Id;
1406          Align      : Uint;
1407          New_Npos   : out SO_Ref;
1408          New_Fbit   : out SO_Ref;
1409          New_NPMax  : out SO_Ref;
1410          Force_SU   : Boolean);
1411       --  Given the previous component in Prev_Comp, which is already laid
1412       --  out, and the alignment of the following component, lays out the
1413       --  following component, and returns its starting position in New_Npos
1414       --  (Normalized_Position value), New_Fbit (Normalized_First_Bit value),
1415       --  and New_NPMax (Normalized_Position_Max value). If Prev_Comp is empty
1416       --  (no previous component is present), then New_Npos, New_Fbit and
1417       --  New_NPMax are all set to zero on return. This procedure is also
1418       --  used to compute the size of a record or variant by giving it the
1419       --  last component, and the record alignment. Force_SU is used to force
1420       --  the new component location to be aligned on a storage unit boundary,
1421       --  even in a packed record, False means that the new position does not
1422       --  need to be bumped to a storage unit boundary, True means a storage
1423       --  unit boundary is always required.
1424
1425       procedure Layout_Component (Comp : Entity_Id; Prev_Comp : Entity_Id);
1426       --  Lays out component Comp, given Prev_Comp, the previously laid-out
1427       --  component (Prev_Comp = Empty if no components laid out yet). The
1428       --  alignment of the record itself is also updated if needed. Both
1429       --  Comp and Prev_Comp can be either components or discriminants.
1430
1431       procedure Layout_Components
1432         (From   : Entity_Id;
1433          To     : Entity_Id;
1434          Esiz   : out SO_Ref;
1435          RM_Siz : out SO_Ref);
1436       --  This procedure lays out the components of the given component list
1437       --  which contains the components starting with From and ending with To.
1438       --  The Next_Entity chain is used to traverse the components. On entry,
1439       --  Prev_Comp is set to the component preceding the list, so that the
1440       --  list is laid out after this component. Prev_Comp is set to Empty if
1441       --  the component list is to be laid out starting at the start of the
1442       --  record. On return, the components are all laid out, and Prev_Comp is
1443       --  set to the last laid out component. On return, Esiz is set to the
1444       --  resulting Object_Size value, which is the length of the record up
1445       --  to and including the last laid out entity. For Esiz, the value is
1446       --  adjusted to match the alignment of the record. RM_Siz is similarly
1447       --  set to the resulting Value_Size value, which is the same length, but
1448       --  not adjusted to meet the alignment. Note that in the case of variant
1449       --  records, Esiz represents the maximum size.
1450
1451       procedure Layout_Non_Variant_Record;
1452       --  Procedure called to lay out a non-variant record type or subtype
1453
1454       procedure Layout_Variant_Record;
1455       --  Procedure called to lay out a variant record type. Decl is set to the
1456       --  full type declaration for the variant record.
1457
1458       ---------------------------------
1459       -- Get_Next_Component_Location --
1460       ---------------------------------
1461
1462       procedure Get_Next_Component_Location
1463         (Prev_Comp  : Entity_Id;
1464          Align      : Uint;
1465          New_Npos   : out SO_Ref;
1466          New_Fbit   : out SO_Ref;
1467          New_NPMax  : out SO_Ref;
1468          Force_SU   : Boolean)
1469       is
1470       begin
1471          --  No previous component, return zero position
1472
1473          if No (Prev_Comp) then
1474             New_Npos  := Uint_0;
1475             New_Fbit  := Uint_0;
1476             New_NPMax := Uint_0;
1477             return;
1478          end if;
1479
1480          --  Here we have a previous component
1481
1482          declare
1483             Loc       : constant Source_Ptr := Sloc (Prev_Comp);
1484
1485             Old_Npos  : constant SO_Ref := Normalized_Position     (Prev_Comp);
1486             Old_Fbit  : constant SO_Ref := Normalized_First_Bit    (Prev_Comp);
1487             Old_NPMax : constant SO_Ref := Normalized_Position_Max (Prev_Comp);
1488             Old_Esiz  : constant SO_Ref := Esize                   (Prev_Comp);
1489
1490             Old_Maxsz : Node_Id;
1491             --  Expression representing maximum size of previous component
1492
1493          begin
1494             --  Case where previous field had a dynamic size
1495
1496             if Is_Dynamic_SO_Ref (Esize (Prev_Comp)) then
1497
1498                --  If the previous field had a dynamic length, then it is
1499                --  required to occupy an integral number of storage units,
1500                --  and start on a storage unit boundary. This means that
1501                --  the Normalized_First_Bit value is zero in the previous
1502                --  component, and the new value is also set to zero.
1503
1504                New_Fbit := Uint_0;
1505
1506                --  In this case, the new position is given by an expression
1507                --  that is the sum of old normalized position and old size.
1508
1509                New_Npos :=
1510                  SO_Ref_From_Expr
1511                    (Assoc_Add (Loc,
1512                       Left_Opnd  =>
1513                         Expr_From_SO_Ref (Loc, Old_Npos),
1514                       Right_Opnd =>
1515                         Expr_From_SO_Ref (Loc, Old_Esiz, Prev_Comp)),
1516                     Ins_Type => E,
1517                     Vtype    => E);
1518
1519                --  Get maximum size of previous component
1520
1521                if Size_Depends_On_Discriminant (Etype (Prev_Comp)) then
1522                   Old_Maxsz := Get_Max_SU_Size (Etype (Prev_Comp));
1523                else
1524                   Old_Maxsz := Expr_From_SO_Ref (Loc, Old_Esiz, Prev_Comp);
1525                end if;
1526
1527                --  Now we can compute the new max position. If the max size
1528                --  is static and the old position is static, then we can
1529                --  compute the new position statically.
1530
1531                if Nkind (Old_Maxsz) = N_Integer_Literal
1532                  and then Known_Static_Normalized_Position_Max (Prev_Comp)
1533                then
1534                   New_NPMax := Old_NPMax + Intval (Old_Maxsz);
1535
1536                --  Otherwise new max position is dynamic
1537
1538                else
1539                   New_NPMax :=
1540                     SO_Ref_From_Expr
1541                       (Assoc_Add (Loc,
1542                          Left_Opnd  => Expr_From_SO_Ref (Loc, Old_NPMax),
1543                          Right_Opnd => Old_Maxsz),
1544                        Ins_Type => E,
1545                        Vtype    => E);
1546                end if;
1547
1548             --  Previous field has known static Esize
1549
1550             else
1551                New_Fbit := Old_Fbit + Old_Esiz;
1552
1553                --  Bump New_Fbit to storage unit boundary if required
1554
1555                if New_Fbit /= 0 and then Force_SU then
1556                   New_Fbit := (New_Fbit + SSU - 1) / SSU * SSU;
1557                end if;
1558
1559                --  If old normalized position is static, we can go ahead and
1560                --  compute the new normalized position directly.
1561
1562                if Known_Static_Normalized_Position (Prev_Comp) then
1563                   New_Npos := Old_Npos;
1564
1565                   if New_Fbit >= SSU then
1566                      New_Npos := New_Npos + New_Fbit / SSU;
1567                      New_Fbit := New_Fbit mod SSU;
1568                   end if;
1569
1570                   --  Bump alignment if stricter than prev
1571
1572                   if Align > Alignment (Etype (Prev_Comp)) then
1573                      New_Npos := (New_Npos + Align - 1) / Align * Align;
1574                   end if;
1575
1576                   --  The max position is always equal to the position if
1577                   --  the latter is static, since arrays depending on the
1578                   --  values of discriminants never have static sizes.
1579
1580                   New_NPMax := New_Npos;
1581                   return;
1582
1583                --  Case of old normalized position is dynamic
1584
1585                else
1586                   --  If new bit position is within the current storage unit,
1587                   --  we can just copy the old position as the result position
1588                   --  (we have already set the new first bit value).
1589
1590                   if New_Fbit < SSU then
1591                      New_Npos  := Old_Npos;
1592                      New_NPMax := Old_NPMax;
1593
1594                   --  If new bit position is past the current storage unit, we
1595                   --  need to generate a new dynamic value for the position
1596                   --  ??? need to deal with alignment
1597
1598                   else
1599                      New_Npos :=
1600                        SO_Ref_From_Expr
1601                          (Assoc_Add (Loc,
1602                             Left_Opnd  => Expr_From_SO_Ref (Loc, Old_Npos),
1603                             Right_Opnd =>
1604                               Make_Integer_Literal (Loc,
1605                                 Intval => New_Fbit / SSU)),
1606                           Ins_Type => E,
1607                           Vtype    => E);
1608
1609                      New_NPMax :=
1610                        SO_Ref_From_Expr
1611                          (Assoc_Add (Loc,
1612                             Left_Opnd  => Expr_From_SO_Ref (Loc, Old_NPMax),
1613                             Right_Opnd =>
1614                               Make_Integer_Literal (Loc,
1615                                 Intval => New_Fbit / SSU)),
1616                             Ins_Type => E,
1617                             Vtype    => E);
1618                      New_Fbit := New_Fbit mod SSU;
1619                   end if;
1620                end if;
1621             end if;
1622          end;
1623       end Get_Next_Component_Location;
1624
1625       ----------------------
1626       -- Layout_Component --
1627       ----------------------
1628
1629       procedure Layout_Component (Comp : Entity_Id; Prev_Comp : Entity_Id) is
1630          Ctyp  : constant Entity_Id := Etype (Comp);
1631          ORC   : constant Entity_Id := Original_Record_Component (Comp);
1632          Npos  : SO_Ref;
1633          Fbit  : SO_Ref;
1634          NPMax : SO_Ref;
1635          Forc  : Boolean;
1636
1637       begin
1638          --  Increase alignment of record if necessary. Note that we do not
1639          --  do this for packed records, which have an alignment of one by
1640          --  default, or for records for which an explicit alignment was
1641          --  specified with an alignment clause.
1642
1643          if not Is_Packed (E)
1644            and then not Has_Alignment_Clause (E)
1645            and then Alignment (Ctyp) > Alignment (E)
1646          then
1647             Set_Alignment (E, Alignment (Ctyp));
1648          end if;
1649
1650          --  If original component set, then use same layout
1651
1652          if Present (ORC) and then ORC /= Comp then
1653             Set_Normalized_Position     (Comp, Normalized_Position     (ORC));
1654             Set_Normalized_First_Bit    (Comp, Normalized_First_Bit    (ORC));
1655             Set_Normalized_Position_Max (Comp, Normalized_Position_Max (ORC));
1656             Set_Component_Bit_Offset    (Comp, Component_Bit_Offset    (ORC));
1657             Set_Esize                   (Comp, Esize                   (ORC));
1658             return;
1659          end if;
1660
1661          --  Parent field is always at start of record, this will overlap
1662          --  the actual fields that are part of the parent, and that's fine
1663
1664          if Chars (Comp) = Name_uParent then
1665             Set_Normalized_Position     (Comp, Uint_0);
1666             Set_Normalized_First_Bit    (Comp, Uint_0);
1667             Set_Normalized_Position_Max (Comp, Uint_0);
1668             Set_Component_Bit_Offset    (Comp, Uint_0);
1669             Set_Esize                   (Comp, Esize (Ctyp));
1670             return;
1671          end if;
1672
1673          --  Check case of type of component has a scope of the record we are
1674          --  laying out. When this happens, the type in question is an Itype
1675          --  that has not yet been laid out (that's because such types do not
1676          --  get frozen in the normal manner, because there is no place for
1677          --  the freeze nodes).
1678
1679          if Scope (Ctyp) = E then
1680             Layout_Type (Ctyp);
1681          end if;
1682
1683          --  If component already laid out, then we are done
1684
1685          if Known_Normalized_Position (Comp) then
1686             return;
1687          end if;
1688
1689          --  Set size of component from type. We use the Esize except in a
1690          --  packed record, where we use the RM_Size (since that is what the
1691          --  RM_Size value, as distinct from the Object_Size is useful for!)
1692
1693          if Is_Packed (E) then
1694             Set_Esize (Comp, RM_Size (Ctyp));
1695          else
1696             Set_Esize (Comp, Esize (Ctyp));
1697          end if;
1698
1699          --  Compute the component position from the previous one. See if
1700          --  current component requires being on a storage unit boundary.
1701
1702          --  If record is not packed, we always go to a storage unit boundary
1703
1704          if not Is_Packed (E) then
1705             Forc := True;
1706
1707          --  Packed cases
1708
1709          else
1710             --  Elementary types do not need SU boundary in packed record
1711
1712             if Is_Elementary_Type (Ctyp) then
1713                Forc := False;
1714
1715             --  Packed array types with a modular packed array type do not
1716             --  force a storage unit boundary (since the code generation
1717             --  treats these as equivalent to the underlying modular type),
1718
1719             elsif Is_Array_Type (Ctyp)
1720               and then Is_Bit_Packed_Array (Ctyp)
1721               and then Is_Modular_Integer_Type (Packed_Array_Type (Ctyp))
1722             then
1723                Forc := False;
1724
1725             --  Record types with known length less than or equal to the length
1726             --  of long long integer can also be unaligned, since they can be
1727             --  treated as scalars.
1728
1729             elsif Is_Record_Type (Ctyp)
1730               and then not Is_Dynamic_SO_Ref (Esize (Ctyp))
1731               and then Esize (Ctyp) <= Esize (Standard_Long_Long_Integer)
1732             then
1733                Forc := False;
1734
1735             --  All other cases force a storage unit boundary, even when packed
1736
1737             else
1738                Forc := True;
1739             end if;
1740          end if;
1741
1742          --  Now get the next component location
1743
1744          Get_Next_Component_Location
1745            (Prev_Comp, Alignment (Ctyp), Npos, Fbit, NPMax, Forc);
1746          Set_Normalized_Position     (Comp, Npos);
1747          Set_Normalized_First_Bit    (Comp, Fbit);
1748          Set_Normalized_Position_Max (Comp, NPMax);
1749
1750          --  Set Component_Bit_Offset in the static case
1751
1752          if Known_Static_Normalized_Position (Comp)
1753            and then Known_Normalized_First_Bit (Comp)
1754          then
1755             Set_Component_Bit_Offset (Comp, SSU * Npos + Fbit);
1756          end if;
1757       end Layout_Component;
1758
1759       -----------------------
1760       -- Layout_Components --
1761       -----------------------
1762
1763       procedure Layout_Components
1764         (From   : Entity_Id;
1765          To     : Entity_Id;
1766          Esiz   : out SO_Ref;
1767          RM_Siz : out SO_Ref)
1768       is
1769          End_Npos  : SO_Ref;
1770          End_Fbit  : SO_Ref;
1771          End_NPMax : SO_Ref;
1772
1773       begin
1774          --  Only lay out components if there are some to lay out!
1775
1776          if Present (From) then
1777
1778             --  Lay out components with no component clauses
1779
1780             Comp := From;
1781             loop
1782                if Ekind (Comp) = E_Component
1783                  or else Ekind (Comp) = E_Discriminant
1784                then
1785                   --  The compatibility of component clauses with composite
1786                   --  types isn't checked in Sem_Ch13, so we check it here.
1787
1788                   if Present (Component_Clause (Comp)) then
1789                      if Is_Composite_Type (Etype (Comp))
1790                        and then Esize (Comp) < RM_Size (Etype (Comp))
1791                      then
1792                         Error_Msg_Uint_1 := RM_Size (Etype (Comp));
1793                         Error_Msg_NE
1794                           ("size for & too small, minimum allowed is ^",
1795                            Component_Clause (Comp),
1796                            Comp);
1797                      end if;
1798
1799                   else
1800                      Layout_Component (Comp, Prev_Comp);
1801                      Prev_Comp := Comp;
1802                   end if;
1803                end if;
1804
1805                exit when Comp = To;
1806                Next_Entity (Comp);
1807             end loop;
1808          end if;
1809
1810          --  Set size fields, both are zero if no components
1811
1812          if No (Prev_Comp) then
1813             Esiz := Uint_0;
1814             RM_Siz := Uint_0;
1815
1816             --  If record subtype with non-static discriminants, then we don't
1817             --  know which variant will be the one which gets chosen. We don't
1818             --  just want to set the maximum size from the base, because the
1819             --  size should depend on the particular variant.
1820
1821             --  What we do is to use the RM_Size of the base type, which has
1822             --  the necessary conditional computation of the size, using the
1823             --  size information for the particular variant chosen. Records
1824             --  with default discriminants for example have an Esize that is
1825             --  set to the maximum of all variants, but that's not what we
1826             --  want for a constrained subtype.
1827
1828          elsif Ekind (E) = E_Record_Subtype
1829            and then not Has_Static_Discriminants (E)
1830          then
1831             declare
1832                BT : constant Node_Id := Base_Type (E);
1833             begin
1834                Esiz   := RM_Size (BT);
1835                RM_Siz := RM_Size (BT);
1836                Set_Alignment (E, Alignment (BT));
1837             end;
1838
1839          else
1840             --  First the object size, for which we align past the last field
1841             --  to the alignment of the record (the object size is required to
1842             --  be a multiple of the alignment).
1843
1844             Get_Next_Component_Location
1845               (Prev_Comp,
1846                Alignment (E),
1847                End_Npos,
1848                End_Fbit,
1849                End_NPMax,
1850                Force_SU => True);
1851
1852             --  If the resulting normalized position is a dynamic reference,
1853             --  then the size is dynamic, and is stored in storage units. In
1854             --  this case, we set the RM_Size to the same value, it is simply
1855             --  not worth distinguishing Esize and RM_Size values in the
1856             --  dynamic case, since the RM has nothing to say about them.
1857
1858             --  Note that a size cannot have been given in this case, since
1859             --  size specifications cannot be given for variable length types.
1860
1861             declare
1862                Align : constant Uint := Alignment (E);
1863
1864             begin
1865                if Is_Dynamic_SO_Ref (End_Npos) then
1866                   RM_Siz := End_Npos;
1867
1868                   --  Set the Object_Size allowing for the alignment. In the
1869                   --  dynamic case, we must do the actual runtime computation.
1870                   --  We can skip this in the non-packed record case if the
1871                   --  last component has a smaller alignment than the overall
1872                   --  record alignment.
1873
1874                   if Is_Dynamic_SO_Ref (End_NPMax) then
1875                      Esiz := End_NPMax;
1876
1877                      if Is_Packed (E)
1878                        or else Alignment (Etype (Prev_Comp)) < Align
1879                      then
1880                         --  The expression we build is:
1881                         --    (expr + align - 1) / align * align
1882
1883                         Esiz :=
1884                           SO_Ref_From_Expr
1885                             (Expr =>
1886                                Make_Op_Multiply (Loc,
1887                                  Left_Opnd =>
1888                                    Make_Op_Divide (Loc,
1889                                      Left_Opnd =>
1890                                        Make_Op_Add (Loc,
1891                                          Left_Opnd =>
1892                                            Expr_From_SO_Ref (Loc, Esiz),
1893                                          Right_Opnd =>
1894                                            Make_Integer_Literal (Loc,
1895                                              Intval => Align - 1)),
1896                                      Right_Opnd =>
1897                                        Make_Integer_Literal (Loc, Align)),
1898                                  Right_Opnd =>
1899                                    Make_Integer_Literal (Loc, Align)),
1900                             Ins_Type => E,
1901                             Vtype    => E);
1902                      end if;
1903
1904                   --  Here Esiz is static, so we can adjust the alignment
1905                   --  directly go give the required aligned value.
1906
1907                   else
1908                      Esiz := (End_NPMax + Align - 1) / Align * Align * SSU;
1909                   end if;
1910
1911                --  Case where computed size is static
1912
1913                else
1914                   --  The ending size was computed in Npos in storage units,
1915                   --  but the actual size is stored in bits, so adjust
1916                   --  accordingly. We also adjust the size to match the
1917                   --  alignment here.
1918
1919                   Esiz := (End_NPMax + Align - 1) / Align * Align * SSU;
1920
1921                   --  Compute the resulting Value_Size (RM_Size). For this
1922                   --  purpose we do not force alignment of the record or
1923                   --  storage size alignment of the result.
1924
1925                   Get_Next_Component_Location
1926                     (Prev_Comp,
1927                      Uint_0,
1928                      End_Npos,
1929                      End_Fbit,
1930                      End_NPMax,
1931                      Force_SU => False);
1932
1933                   RM_Siz := End_Npos * SSU + End_Fbit;
1934                   Set_And_Check_Static_Size (E, Esiz, RM_Siz);
1935                end if;
1936             end;
1937          end if;
1938       end Layout_Components;
1939
1940       -------------------------------
1941       -- Layout_Non_Variant_Record --
1942       -------------------------------
1943
1944       procedure Layout_Non_Variant_Record is
1945          Esiz   : SO_Ref;
1946          RM_Siz : SO_Ref;
1947       begin
1948          Layout_Components (First_Entity (E), Last_Entity (E), Esiz, RM_Siz);
1949          Set_Esize   (E, Esiz);
1950          Set_RM_Size (E, RM_Siz);
1951       end Layout_Non_Variant_Record;
1952
1953       ---------------------------
1954       -- Layout_Variant_Record --
1955       ---------------------------
1956
1957       procedure Layout_Variant_Record is
1958          Tdef        : constant Node_Id := Type_Definition (Decl);
1959          First_Discr : Entity_Id;
1960          Last_Discr  : Entity_Id;
1961          Esiz        : SO_Ref;
1962
1963          RM_Siz : SO_Ref;
1964          pragma Warnings (Off, SO_Ref);
1965
1966          RM_Siz_Expr : Node_Id := Empty;
1967          --  Expression for the evolving RM_Siz value. This is typically a
1968          --  conditional expression which involves tests of discriminant values
1969          --  that are formed as references to the entity V. At the end of
1970          --  scanning all the components, a suitable function is constructed
1971          --  in which V is the parameter.
1972
1973          -----------------------
1974          -- Local Subprograms --
1975          -----------------------
1976
1977          procedure Layout_Component_List
1978            (Clist       : Node_Id;
1979             Esiz        : out SO_Ref;
1980             RM_Siz_Expr : out Node_Id);
1981          --  Recursive procedure, called to lay out one component list Esiz
1982          --  and RM_Siz_Expr are set to the Object_Size and Value_Size values
1983          --  respectively representing the record size up to and including the
1984          --  last component in the component list (including any variants in
1985          --  this component list). RM_Siz_Expr is returned as an expression
1986          --  which may in the general case involve some references to the
1987          --  discriminants of the current record value, referenced by selecting
1988          --  from the entity V.
1989
1990          ---------------------------
1991          -- Layout_Component_List --
1992          ---------------------------
1993
1994          procedure Layout_Component_List
1995            (Clist       : Node_Id;
1996             Esiz        : out SO_Ref;
1997             RM_Siz_Expr : out Node_Id)
1998          is
1999             Citems  : constant List_Id := Component_Items (Clist);
2000             Vpart   : constant Node_Id := Variant_Part (Clist);
2001             Prv     : Node_Id;
2002             Var     : Node_Id;
2003             RM_Siz  : Uint;
2004             RMS_Ent : Entity_Id;
2005
2006          begin
2007             if Is_Non_Empty_List (Citems) then
2008                Layout_Components
2009                  (From   => Defining_Identifier (First (Citems)),
2010                   To     => Defining_Identifier (Last  (Citems)),
2011                   Esiz   => Esiz,
2012                   RM_Siz => RM_Siz);
2013             else
2014                Layout_Components (Empty, Empty, Esiz, RM_Siz);
2015             end if;
2016
2017             --  Case where no variants are present in the component list
2018
2019             if No (Vpart) then
2020
2021                --  The Esiz value has been correctly set by the call to
2022                --  Layout_Components, so there is nothing more to be done.
2023
2024                --  For RM_Siz, we have an SO_Ref value, which we must convert
2025                --  to an appropriate expression.
2026
2027                if Is_Static_SO_Ref (RM_Siz) then
2028                   RM_Siz_Expr :=
2029                     Make_Integer_Literal (Loc,
2030                                           Intval => RM_Siz);
2031
2032                else
2033                   RMS_Ent := Get_Dynamic_SO_Entity (RM_Siz);
2034
2035                   --  If the size is represented by a function, then we create
2036                   --  an appropriate function call using V as the parameter to
2037                   --  the call.
2038
2039                   if Is_Discrim_SO_Function (RMS_Ent) then
2040                      RM_Siz_Expr :=
2041                        Make_Function_Call (Loc,
2042                          Name => New_Occurrence_Of (RMS_Ent, Loc),
2043                          Parameter_Associations => New_List (
2044                            Make_Identifier (Loc, Vname)));
2045
2046                   --  If the size is represented by a constant, then the
2047                   --  expression we want is a reference to this constant
2048
2049                   else
2050                      RM_Siz_Expr := New_Occurrence_Of (RMS_Ent, Loc);
2051                   end if;
2052                end if;
2053
2054             --  Case where variants are present in this component list
2055
2056             else
2057                declare
2058                   EsizV    : SO_Ref;
2059                   RM_SizV  : Node_Id;
2060                   Dchoice  : Node_Id;
2061                   Discrim  : Node_Id;
2062                   Dtest    : Node_Id;
2063                   D_List   : List_Id;
2064                   D_Entity : Entity_Id;
2065
2066                begin
2067                   RM_Siz_Expr := Empty;
2068                   Prv := Prev_Comp;
2069
2070                   Var := Last (Variants (Vpart));
2071                   while Present (Var) loop
2072                      Prev_Comp := Prv;
2073                      Layout_Component_List
2074                        (Component_List (Var), EsizV, RM_SizV);
2075
2076                      --  Set the Object_Size. If this is the first variant,
2077                      --  we just set the size of this first variant.
2078
2079                      if Var = Last (Variants (Vpart)) then
2080                         Esiz := EsizV;
2081
2082                      --  Otherwise the Object_Size is formed as a maximum
2083                      --  of Esiz so far from previous variants, and the new
2084                      --  Esiz value from the variant we just processed.
2085
2086                      --  If both values are static, we can just compute the
2087                      --  maximum directly to save building junk nodes.
2088
2089                      elsif not Is_Dynamic_SO_Ref (Esiz)
2090                        and then not Is_Dynamic_SO_Ref (EsizV)
2091                      then
2092                         Esiz := UI_Max (Esiz, EsizV);
2093
2094                      --  If either value is dynamic, then we have to generate
2095                      --  an appropriate Standard_Unsigned'Max attribute call.
2096                      --  If one of the values is static then it needs to be
2097                      --  converted from bits to storage units to be compatible
2098                      --  with the dynamic value.
2099
2100                      else
2101                         if Is_Static_SO_Ref (Esiz) then
2102                            Esiz := (Esiz + SSU - 1) / SSU;
2103                         end if;
2104
2105                         if Is_Static_SO_Ref (EsizV) then
2106                            EsizV := (EsizV + SSU - 1) / SSU;
2107                         end if;
2108
2109                         Esiz :=
2110                           SO_Ref_From_Expr
2111                             (Make_Attribute_Reference (Loc,
2112                                Attribute_Name => Name_Max,
2113                                Prefix         =>
2114                                  New_Occurrence_Of (Standard_Unsigned, Loc),
2115                                Expressions => New_List (
2116                                  Expr_From_SO_Ref (Loc, Esiz),
2117                                  Expr_From_SO_Ref (Loc, EsizV))),
2118                              Ins_Type => E,
2119                              Vtype    => E);
2120                      end if;
2121
2122                      --  Now deal with Value_Size (RM_Siz). We are aiming at
2123                      --  an expression that looks like:
2124
2125                      --    if      xxDx (V.disc) then rmsiz1
2126                      --    else if xxDx (V.disc) then rmsiz2
2127                      --    else ...
2128
2129                      --  Where rmsiz1, rmsiz2... are the RM_Siz values for the
2130                      --  individual variants, and xxDx are the discriminant
2131                      --  checking functions generated for the variant type.
2132
2133                      --  If this is the first variant, we simply set the result
2134                      --  as the expression. Note that this takes care of the
2135                      --  others case.
2136
2137                      if No (RM_Siz_Expr) then
2138                         RM_Siz_Expr := Bits_To_SU (RM_SizV);
2139
2140                      --  Otherwise construct the appropriate test
2141
2142                      else
2143                         --  The test to be used in general is a call to the
2144                         --  discriminant checking function. However, it is
2145                         --  definitely worth special casing the very common
2146                         --  case where a single value is involved.
2147
2148                         Dchoice := First (Discrete_Choices (Var));
2149
2150                         if No (Next (Dchoice))
2151                           and then Nkind (Dchoice) /= N_Range
2152                         then
2153                            --  Discriminant to be tested
2154
2155                            Discrim :=
2156                              Make_Selected_Component (Loc,
2157                                Prefix        =>
2158                                  Make_Identifier (Loc, Vname),
2159                                Selector_Name =>
2160                                  New_Occurrence_Of
2161                                    (Entity (Name (Vpart)), Loc));
2162
2163                            Dtest :=
2164                              Make_Op_Eq (Loc,
2165                                Left_Opnd  => Discrim,
2166                                Right_Opnd => New_Copy (Dchoice));
2167
2168                         --  Generate a call to the discriminant-checking
2169                         --  function for the variant. Note that the result
2170                         --  has to be complemented since the function returns
2171                         --  False when the passed discriminant value matches.
2172
2173                         else
2174                            --  The checking function takes all of the type's
2175                            --  discriminants as parameters, so a list of all
2176                            --  the selected discriminants must be constructed.
2177
2178                            D_List := New_List;
2179                            D_Entity := First_Discriminant (E);
2180                            while Present (D_Entity) loop
2181                               Append (
2182                                 Make_Selected_Component (Loc,
2183                                   Prefix        =>
2184                                     Make_Identifier (Loc, Vname),
2185                                   Selector_Name =>
2186                                     New_Occurrence_Of (D_Entity, Loc)),
2187                                 D_List);
2188
2189                               D_Entity := Next_Discriminant (D_Entity);
2190                            end loop;
2191
2192                            Dtest :=
2193                              Make_Op_Not (Loc,
2194                                Right_Opnd =>
2195                                  Make_Function_Call (Loc,
2196                                    Name =>
2197                                      New_Occurrence_Of
2198                                        (Dcheck_Function (Var), Loc),
2199                                    Parameter_Associations =>
2200                                      D_List));
2201                         end if;
2202
2203                         RM_Siz_Expr :=
2204                           Make_Conditional_Expression (Loc,
2205                             Expressions =>
2206                               New_List
2207                                 (Dtest, Bits_To_SU (RM_SizV), RM_Siz_Expr));
2208                      end if;
2209
2210                      Prev (Var);
2211                   end loop;
2212                end;
2213             end if;
2214          end Layout_Component_List;
2215
2216       --  Start of processing for Layout_Variant_Record
2217
2218       begin
2219          --  We need the discriminant checking functions, since we generate
2220          --  calls to these functions for the RM_Size expression, so make
2221          --  sure that these functions have been constructed in time.
2222
2223          Build_Discr_Checking_Funcs (Decl);
2224
2225          --  Lay out the discriminants
2226
2227          First_Discr := First_Discriminant (E);
2228          Last_Discr  := First_Discr;
2229          while Present (Next_Discriminant (Last_Discr)) loop
2230             Next_Discriminant (Last_Discr);
2231          end loop;
2232
2233          Layout_Components
2234            (From   => First_Discr,
2235             To     => Last_Discr,
2236             Esiz   => Esiz,
2237             RM_Siz => RM_Siz);
2238
2239          --  Lay out the main component list (this will make recursive calls
2240          --  to lay out all component lists nested within variants).
2241
2242          Layout_Component_List (Component_List (Tdef), Esiz, RM_Siz_Expr);
2243          Set_Esize (E, Esiz);
2244
2245          --  If the RM_Size is a literal, set its value
2246
2247          if Nkind (RM_Siz_Expr) = N_Integer_Literal then
2248             Set_RM_Size (E, Intval (RM_Siz_Expr));
2249
2250          --  Otherwise we construct a dynamic SO_Ref
2251
2252          else
2253             Set_RM_Size (E,
2254               SO_Ref_From_Expr
2255                 (RM_Siz_Expr,
2256                  Ins_Type => E,
2257                  Vtype    => E));
2258          end if;
2259       end Layout_Variant_Record;
2260
2261    --  Start of processing for Layout_Record_Type
2262
2263    begin
2264       --  If this is a cloned subtype, just copy the size fields from the
2265       --  original, nothing else needs to be done in this case, since the
2266       --  components themselves are all shared.
2267
2268       if (Ekind (E) = E_Record_Subtype
2269             or else
2270           Ekind (E) = E_Class_Wide_Subtype)
2271         and then Present (Cloned_Subtype (E))
2272       then
2273          Set_Esize     (E, Esize     (Cloned_Subtype (E)));
2274          Set_RM_Size   (E, RM_Size   (Cloned_Subtype (E)));
2275          Set_Alignment (E, Alignment (Cloned_Subtype (E)));
2276
2277       --  Another special case, class-wide types. The RM says that the size
2278       --  of such types is implementation defined (RM 13.3(48)). What we do
2279       --  here is to leave the fields set as unknown values, and the backend
2280       --  determines the actual behavior.
2281
2282       elsif Ekind (E) = E_Class_Wide_Type then
2283          null;
2284
2285       --  All other cases
2286
2287       else
2288          --  Initialize alignment conservatively to 1. This value will be
2289          --  increased as necessary during processing of the record.
2290
2291          if Unknown_Alignment (E) then
2292             Set_Alignment (E, Uint_1);
2293          end if;
2294
2295          --  Initialize previous component. This is Empty unless there are
2296          --  components which have already been laid out by component clauses.
2297          --  If there are such components, we start our lay out of the
2298          --  remaining components following the last such component.
2299
2300          Prev_Comp := Empty;
2301
2302          Comp := First_Component_Or_Discriminant (E);
2303          while Present (Comp) loop
2304             if Present (Component_Clause (Comp)) then
2305                if No (Prev_Comp)
2306                  or else
2307                    Component_Bit_Offset (Comp) >
2308                    Component_Bit_Offset (Prev_Comp)
2309                then
2310                   Prev_Comp := Comp;
2311                end if;
2312             end if;
2313
2314             Next_Component_Or_Discriminant (Comp);
2315          end loop;
2316
2317          --  We have two separate circuits, one for non-variant records and
2318          --  one for variant records. For non-variant records, we simply go
2319          --  through the list of components. This handles all the non-variant
2320          --  cases including those cases of subtypes where there is no full
2321          --  type declaration, so the tree cannot be used to drive the layout.
2322          --  For variant records, we have to drive the layout from the tree
2323          --  since we need to understand the variant structure in this case.
2324
2325          if Present (Full_View (E)) then
2326             Decl := Declaration_Node (Full_View (E));
2327          else
2328             Decl := Declaration_Node (E);
2329          end if;
2330
2331          --  Scan all the components
2332
2333          if Nkind (Decl) = N_Full_Type_Declaration
2334            and then Has_Discriminants (E)
2335            and then Nkind (Type_Definition (Decl)) = N_Record_Definition
2336            and then Present (Component_List (Type_Definition (Decl)))
2337            and then
2338              Present (Variant_Part (Component_List (Type_Definition (Decl))))
2339          then
2340             Layout_Variant_Record;
2341          else
2342             Layout_Non_Variant_Record;
2343          end if;
2344       end if;
2345    end Layout_Record_Type;
2346
2347    -----------------
2348    -- Layout_Type --
2349    -----------------
2350
2351    procedure Layout_Type (E : Entity_Id) is
2352       Desig_Type : Entity_Id;
2353
2354    begin
2355       --  For string literal types, for now, kill the size always, this is
2356       --  because gigi does not like or need the size to be set ???
2357
2358       if Ekind (E) = E_String_Literal_Subtype then
2359          Set_Esize (E, Uint_0);
2360          Set_RM_Size (E, Uint_0);
2361          return;
2362       end if;
2363
2364       --  For access types, set size/alignment. This is system address size,
2365       --  except for fat pointers (unconstrained array access types), where the
2366       --  size is two times the address size, to accommodate the two pointers
2367       --  that are required for a fat pointer (data and template). Note that
2368       --  E_Access_Protected_Subprogram_Type is not an access type for this
2369       --  purpose since it is not a pointer but is equivalent to a record. For
2370       --  access subtypes, copy the size from the base type since Gigi
2371       --  represents them the same way.
2372
2373       if Is_Access_Type (E) then
2374
2375          Desig_Type :=  Underlying_Type (Designated_Type (E));
2376
2377          --  If we only have a limited view of the type, see whether the
2378          --  non-limited view is available.
2379
2380          if From_With_Type (Designated_Type (E))
2381            and then Ekind (Designated_Type (E)) = E_Incomplete_Type
2382            and then Present (Non_Limited_View (Designated_Type (E)))
2383          then
2384             Desig_Type := Non_Limited_View (Designated_Type (E));
2385          end if;
2386
2387          --  If Esize already set (e.g. by a size clause), then nothing further
2388          --  to be done here.
2389
2390          if Known_Esize (E) then
2391             null;
2392
2393          --  Access to subprogram is a strange beast, and we let the backend
2394          --  figure out what is needed (it may be some kind of fat pointer,
2395          --  including the static link for example.
2396
2397          elsif Is_Access_Protected_Subprogram_Type (E) then
2398             null;
2399
2400          --  For access subtypes, copy the size information from base type
2401
2402          elsif Ekind (E) = E_Access_Subtype then
2403             Set_Size_Info (E, Base_Type (E));
2404             Set_RM_Size   (E, RM_Size (Base_Type (E)));
2405
2406          --  For other access types, we use either address size, or, if a fat
2407          --  pointer is used (pointer-to-unconstrained array case), twice the
2408          --  address size to accommodate a fat pointer.
2409
2410          elsif Present (Desig_Type)
2411             and then Is_Array_Type (Desig_Type)
2412             and then not Is_Constrained (Desig_Type)
2413             and then not Has_Completion_In_Body (Desig_Type)
2414             and then not Debug_Flag_6
2415          then
2416             Init_Size (E, 2 * System_Address_Size);
2417
2418             --  Check for bad convention set
2419
2420             if Warn_On_Export_Import
2421               and then
2422                 (Convention (E) = Convention_C
2423                    or else
2424                  Convention (E) = Convention_CPP)
2425             then
2426                Error_Msg_N
2427                  ("?this access type does not correspond to C pointer", E);
2428             end if;
2429
2430          --  If the designated type is a limited view it is unanalyzed. We can
2431          --  examine the declaration itself to determine whether it will need a
2432          --  fat pointer.
2433
2434          elsif Present (Desig_Type)
2435             and then Present (Parent (Desig_Type))
2436             and then Nkind (Parent (Desig_Type)) = N_Full_Type_Declaration
2437             and then
2438               Nkind (Type_Definition (Parent (Desig_Type)))
2439                  = N_Unconstrained_Array_Definition
2440          then
2441             Init_Size (E, 2 * System_Address_Size);
2442
2443          --  When the target is AAMP, access-to-subprogram types are fat
2444          --  pointers consisting of the subprogram address and a static link
2445          --  (with the exception of library-level access types, where a simple
2446          --  subprogram address is used).
2447
2448          elsif AAMP_On_Target
2449            and then
2450              (Ekind (E) = E_Anonymous_Access_Subprogram_Type
2451                or else (Ekind (E) = E_Access_Subprogram_Type
2452                          and then Present (Enclosing_Subprogram (E))))
2453          then
2454             Init_Size (E, 2 * System_Address_Size);
2455
2456          else
2457             Init_Size (E, System_Address_Size);
2458          end if;
2459
2460          --  On VMS, reset size to 32 for convention C access type if no
2461          --  explicit size clause is given and the default size is 64. Really
2462          --  we do not know the size, since depending on options for the VMS
2463          --  compiler, the size of a pointer type can be 32 or 64, but choosing
2464          --  32 as the default improves compatibility with legacy VMS code.
2465
2466          --  Note: we do not use Has_Size_Clause in the test below, because we
2467          --  want to catch the case of a derived type inheriting a size clause.
2468          --  We want to consider this to be an explicit size clause for this
2469          --  purpose, since it would be weird not to inherit the size in this
2470          --  case.
2471
2472          --  We do NOT do this if we are in -gnatdm mode on a non-VMS target
2473          --  since in that case we want the normal pointer representation.
2474
2475          if Opt.True_VMS_Target
2476            and then (Convention (E) = Convention_C
2477                       or else
2478                      Convention (E) = Convention_CPP)
2479            and then No (Get_Attribute_Definition_Clause (E, Attribute_Size))
2480            and then Esize (E) = 64
2481          then
2482             Init_Size (E, 32);
2483          end if;
2484
2485          Set_Elem_Alignment (E);
2486
2487       --  Scalar types: set size and alignment
2488
2489       elsif Is_Scalar_Type (E) then
2490
2491          --  For discrete types, the RM_Size and Esize must be set already,
2492          --  since this is part of the earlier processing and the front end is
2493          --  always required to lay out the sizes of such types (since they are
2494          --  available as static attributes). All we do is to check that this
2495          --  rule is indeed obeyed!
2496
2497          if Is_Discrete_Type (E) then
2498
2499             --  If the RM_Size is not set, then here is where we set it
2500
2501             --  Note: an RM_Size of zero looks like not set here, but this
2502             --  is a rare case, and we can simply reset it without any harm.
2503
2504             if not Known_RM_Size (E) then
2505                Set_Discrete_RM_Size (E);
2506             end if;
2507
2508             --  If Esize for a discrete type is not set then set it
2509
2510             if not Known_Esize (E) then
2511                declare
2512                   S : Int := 8;
2513
2514                begin
2515                   loop
2516                      --  If size is big enough, set it and exit
2517
2518                      if S >= RM_Size (E) then
2519                         Init_Esize (E, S);
2520                         exit;
2521
2522                      --  If the RM_Size is greater than 64 (happens only when
2523                      --  strange values are specified by the user, then Esize
2524                      --  is simply a copy of RM_Size, it will be further
2525                      --  refined later on)
2526
2527                      elsif S = 64 then
2528                         Set_Esize (E, RM_Size (E));
2529                         exit;
2530
2531                      --  Otherwise double possible size and keep trying
2532
2533                      else
2534                         S := S * 2;
2535                      end if;
2536                   end loop;
2537                end;
2538             end if;
2539
2540          --  For non-discrete scalar types, if the RM_Size is not set, then set
2541          --  it now to a copy of the Esize if the Esize is set.
2542
2543          else
2544             if Known_Esize (E) and then Unknown_RM_Size (E) then
2545                Set_RM_Size (E, Esize (E));
2546             end if;
2547          end if;
2548
2549          Set_Elem_Alignment (E);
2550
2551       --  Non-elementary (composite) types
2552
2553       else
2554          --  For packed arrays, take size and alignment values from the packed
2555          --  array type if a packed array type has been created and the fields
2556          --  are not currently set.
2557
2558          if Is_Array_Type (E) and then Present (Packed_Array_Type (E)) then
2559             declare
2560                PAT : constant Entity_Id := Packed_Array_Type (E);
2561
2562             begin
2563                if Unknown_Esize (E) then
2564                   Set_Esize     (E, Esize     (PAT));
2565                end if;
2566
2567                if Unknown_RM_Size (E) then
2568                   Set_RM_Size   (E, RM_Size   (PAT));
2569                end if;
2570
2571                if Unknown_Alignment (E) then
2572                   Set_Alignment (E, Alignment (PAT));
2573                end if;
2574             end;
2575          end if;
2576
2577          --  If Esize is set, and RM_Size is not, RM_Size is copied from Esize.
2578          --  At least for now this seems reasonable, and is in any case needed
2579          --  for compatibility with old versions of gigi.
2580
2581          if Known_Esize (E) and then Unknown_RM_Size (E) then
2582             Set_RM_Size (E, Esize (E));
2583          end if;
2584
2585          --  For array base types, set component size if object size of the
2586          --  component type is known and is a small power of 2 (8, 16, 32, 64),
2587          --  since this is what will always be used.
2588
2589          if Ekind (E) = E_Array_Type
2590            and then Unknown_Component_Size (E)
2591          then
2592             declare
2593                CT : constant Entity_Id := Component_Type (E);
2594
2595             begin
2596                --  For some reasons, access types can cause trouble, So let's
2597                --  just do this for scalar types ???
2598
2599                if Present (CT)
2600                  and then Is_Scalar_Type (CT)
2601                  and then Known_Static_Esize (CT)
2602                then
2603                   declare
2604                      S : constant Uint := Esize (CT);
2605                   begin
2606                      if Addressable (S) then
2607                         Set_Component_Size (E, S);
2608                      end if;
2609                   end;
2610                end if;
2611             end;
2612          end if;
2613       end if;
2614
2615       --  Lay out array and record types if front end layout set
2616
2617       if Frontend_Layout_On_Target then
2618          if Is_Array_Type (E) and then not Is_Bit_Packed_Array (E) then
2619             Layout_Array_Type (E);
2620          elsif Is_Record_Type (E) then
2621             Layout_Record_Type (E);
2622          end if;
2623
2624       --  Case of backend layout, we still do a little in the front end
2625
2626       else
2627          --  Processing for record types
2628
2629          if Is_Record_Type (E) then
2630
2631             --  Special remaining processing for record types with a known
2632             --  size of 16, 32, or 64 bits whose alignment is not yet set.
2633             --  For these types, we set a corresponding alignment matching
2634             --  the size if possible, or as large as possible if not.
2635
2636             if Convention (E) = Convention_Ada
2637                and then not Debug_Flag_Q
2638             then
2639                Set_Composite_Alignment (E);
2640             end if;
2641
2642          --  Processing for array types
2643
2644          elsif Is_Array_Type (E) then
2645
2646             --  For arrays that are required to be atomic, we do the same
2647             --  processing as described above for short records, since we
2648             --  really need to have the alignment set for the whole array.
2649
2650             if Is_Atomic (E) and then not Debug_Flag_Q then
2651                Set_Composite_Alignment (E);
2652             end if;
2653
2654             --  For unpacked array types, set an alignment of 1 if we know
2655             --  that the component alignment is not greater than 1. The reason
2656             --  we do this is to avoid unnecessary copying of slices of such
2657             --  arrays when passed to subprogram parameters (see special test
2658             --  in Exp_Ch6.Expand_Actuals).
2659
2660             if not Is_Packed (E)
2661               and then Unknown_Alignment (E)
2662             then
2663                if Known_Static_Component_Size (E)
2664                  and then Component_Size (E) = 1
2665                then
2666                   Set_Alignment (E, Uint_1);
2667                end if;
2668             end if;
2669
2670             --  We need to know whether the size depends on the value of one
2671             --  or more discriminants to select the return mechanism. Skip if
2672             --  errors are present, to prevent cascaded messages.
2673
2674             if Serious_Errors_Detected = 0 then
2675                Compute_Size_Depends_On_Discriminant (E);
2676             end if;
2677
2678          end if;
2679       end if;
2680
2681       --  Final step is to check that Esize and RM_Size are compatible
2682
2683       if Known_Static_Esize (E) and then Known_Static_RM_Size (E) then
2684          if Esize (E) < RM_Size (E) then
2685
2686             --  Esize is less than RM_Size. That's not good. First we test
2687             --  whether this was set deliberately with an Object_Size clause
2688             --  and if so, object to the clause.
2689
2690             if Has_Object_Size_Clause (E) then
2691                Error_Msg_Uint_1 := RM_Size (E);
2692                Error_Msg_F
2693                  ("object size is too small, minimum allowed is ^",
2694                   Expression (Get_Attribute_Definition_Clause
2695                                              (E, Attribute_Object_Size)));
2696             end if;
2697
2698             --  Adjust Esize up to RM_Size value
2699
2700             declare
2701                Size : constant Uint := RM_Size (E);
2702
2703             begin
2704                Set_Esize (E, RM_Size (E));
2705
2706                --  For scalar types, increase Object_Size to power of 2, but
2707                --  not less than a storage unit in any case (i.e., normally
2708                --  this means it will be storage-unit addressable).
2709
2710                if Is_Scalar_Type (E) then
2711                   if Size <= System_Storage_Unit then
2712                      Init_Esize (E, System_Storage_Unit);
2713                   elsif Size <= 16 then
2714                      Init_Esize (E, 16);
2715                   elsif Size <= 32 then
2716                      Init_Esize (E, 32);
2717                   else
2718                      Set_Esize  (E, (Size + 63) / 64 * 64);
2719                   end if;
2720
2721                   --  Finally, make sure that alignment is consistent with
2722                   --  the newly assigned size.
2723
2724                   while Alignment (E) * System_Storage_Unit < Esize (E)
2725                     and then Alignment (E) < Maximum_Alignment
2726                   loop
2727                      Set_Alignment (E, 2 * Alignment (E));
2728                   end loop;
2729                end if;
2730             end;
2731          end if;
2732       end if;
2733    end Layout_Type;
2734
2735    ---------------------
2736    -- Rewrite_Integer --
2737    ---------------------
2738
2739    procedure Rewrite_Integer (N : Node_Id; V : Uint) is
2740       Loc : constant Source_Ptr := Sloc (N);
2741       Typ : constant Entity_Id  := Etype (N);
2742    begin
2743       Rewrite (N, Make_Integer_Literal (Loc, Intval => V));
2744       Set_Etype (N, Typ);
2745    end Rewrite_Integer;
2746
2747    -------------------------------
2748    -- Set_And_Check_Static_Size --
2749    -------------------------------
2750
2751    procedure Set_And_Check_Static_Size
2752      (E      : Entity_Id;
2753       Esiz   : SO_Ref;
2754       RM_Siz : SO_Ref)
2755    is
2756       SC : Node_Id;
2757
2758       procedure Check_Size_Too_Small (Spec : Uint; Min : Uint);
2759       --  Spec is the number of bit specified in the size clause, and Min is
2760       --  the minimum computed size. An error is given that the specified size
2761       --  is too small if Spec < Min, and in this case both Esize and RM_Size
2762       --  are set to unknown in E. The error message is posted on node SC.
2763
2764       procedure Check_Unused_Bits (Spec : Uint; Max : Uint);
2765       --  Spec is the number of bits specified in the size clause, and Max is
2766       --  the maximum computed size. A warning is given about unused bits if
2767       --  Spec > Max. This warning is posted on node SC.
2768
2769       --------------------------
2770       -- Check_Size_Too_Small --
2771       --------------------------
2772
2773       procedure Check_Size_Too_Small (Spec : Uint; Min : Uint) is
2774       begin
2775          if Spec < Min then
2776             Error_Msg_Uint_1 := Min;
2777             Error_Msg_NE ("size for & too small, minimum allowed is ^", SC, E);
2778             Init_Esize   (E);
2779             Init_RM_Size (E);
2780          end if;
2781       end Check_Size_Too_Small;
2782
2783       -----------------------
2784       -- Check_Unused_Bits --
2785       -----------------------
2786
2787       procedure Check_Unused_Bits (Spec : Uint; Max : Uint) is
2788       begin
2789          if Spec > Max then
2790             Error_Msg_Uint_1 := Spec - Max;
2791             Error_Msg_NE ("?^ bits of & unused", SC, E);
2792          end if;
2793       end Check_Unused_Bits;
2794
2795    --  Start of processing for Set_And_Check_Static_Size
2796
2797    begin
2798       --  Case where Object_Size (Esize) is already set by a size clause
2799
2800       if Known_Static_Esize (E) then
2801          SC := Size_Clause (E);
2802
2803          if No (SC) then
2804             SC := Get_Attribute_Definition_Clause (E, Attribute_Object_Size);
2805          end if;
2806
2807          --  Perform checks on specified size against computed sizes
2808
2809          if Present (SC) then
2810             Check_Unused_Bits    (Esize (E), Esiz);
2811             Check_Size_Too_Small (Esize (E), RM_Siz);
2812          end if;
2813       end if;
2814
2815       --  Case where Value_Size (RM_Size) is set by specific Value_Size clause
2816       --  (we do not need to worry about Value_Size being set by a Size clause,
2817       --  since that will have set Esize as well, and we already took care of
2818       --  that case).
2819
2820       if Known_Static_RM_Size (E) then
2821          SC := Get_Attribute_Definition_Clause (E, Attribute_Value_Size);
2822
2823          --  Perform checks on specified size against computed sizes
2824
2825          if Present (SC) then
2826             Check_Unused_Bits    (RM_Size (E), Esiz);
2827             Check_Size_Too_Small (RM_Size (E), RM_Siz);
2828          end if;
2829       end if;
2830
2831       --  Set sizes if unknown
2832
2833       if Unknown_Esize (E) then
2834          Set_Esize (E, Esiz);
2835       end if;
2836
2837       if Unknown_RM_Size (E) then
2838          Set_RM_Size (E, RM_Siz);
2839       end if;
2840    end Set_And_Check_Static_Size;
2841
2842    -----------------------------
2843    -- Set_Composite_Alignment --
2844    -----------------------------
2845
2846    procedure Set_Composite_Alignment (E : Entity_Id) is
2847       Siz   : Uint;
2848       Align : Nat;
2849
2850    begin
2851       --  If alignment is already set, then nothing to do
2852
2853       if Known_Alignment (E) then
2854          return;
2855       end if;
2856
2857       --  Alignment is not known, see if we can set it, taking into account
2858       --  the setting of the Optimize_Alignment mode.
2859
2860       --  If Optimize_Alignment is set to Space, then packed records always
2861       --  have an alignment of 1. But don't do anything for atomic records
2862       --  since we may need higher alignment for indivisible access.
2863
2864       if Optimize_Alignment_Space (E)
2865         and then Is_Record_Type (E)
2866         and then Is_Packed (E)
2867         and then not Is_Atomic (E)
2868       then
2869          Align := 1;
2870
2871       --  Not a record, or not packed
2872
2873       else
2874          --  The only other cases we worry about here are where the size is
2875          --  statically known at compile time.
2876
2877          if Known_Static_Esize (E) then
2878             Siz := Esize (E);
2879
2880          elsif Unknown_Esize (E)
2881            and then Known_Static_RM_Size (E)
2882          then
2883             Siz := RM_Size (E);
2884
2885          else
2886             return;
2887          end if;
2888
2889          --  Size is known, alignment is not set
2890
2891          --  Reset alignment to match size if the known size is exactly 2, 4,
2892          --  or 8 storage units.
2893
2894          if Siz = 2 * System_Storage_Unit then
2895             Align := 2;
2896          elsif Siz = 4 * System_Storage_Unit then
2897             Align := 4;
2898          elsif Siz = 8 * System_Storage_Unit then
2899             Align := 8;
2900
2901             --  If Optimize_Alignment is set to Space, then make sure the
2902             --  alignment matches the size, for example, if the size is 17
2903             --  bytes then we want an alignment of 1 for the type.
2904
2905          elsif Optimize_Alignment_Space (E) then
2906             if Siz mod (8 * System_Storage_Unit) = 0 then
2907                Align := 8;
2908             elsif Siz mod (4 * System_Storage_Unit) = 0 then
2909                Align := 4;
2910             elsif Siz mod (2 * System_Storage_Unit) = 0 then
2911                Align := 2;
2912             else
2913                Align := 1;
2914             end if;
2915
2916             --  If Optimize_Alignment is set to Time, then we reset for odd
2917             --  "in between sizes", for example a 17 bit record is given an
2918             --  alignment of 4. Note that this matches the old VMS behavior
2919             --  in versions of GNAT prior to 6.1.1.
2920
2921          elsif Optimize_Alignment_Time (E)
2922            and then Siz > System_Storage_Unit
2923            and then Siz <= 8 * System_Storage_Unit
2924          then
2925             if Siz <= 2 * System_Storage_Unit then
2926                Align := 2;
2927             elsif Siz <= 4 * System_Storage_Unit then
2928                Align := 4;
2929             else -- Siz <= 8 * System_Storage_Unit then
2930                Align := 8;
2931             end if;
2932
2933             --  No special alignment fiddling needed
2934
2935          else
2936             return;
2937          end if;
2938       end if;
2939
2940       --  Here we have Set Align to the proposed improved value. Make sure the
2941       --  value set does not exceed Maximum_Alignment for the target.
2942
2943       if Align > Maximum_Alignment then
2944          Align := Maximum_Alignment;
2945       end if;
2946
2947       --  Further processing for record types only to reduce the alignment
2948       --  set by the above processing in some specific cases. We do not
2949       --  do this for atomic records, since we need max alignment there,
2950
2951       if Is_Record_Type (E) and then not Is_Atomic (E) then
2952
2953          --  For records, there is generally no point in setting alignment
2954          --  higher than word size since we cannot do better than move by
2955          --  words in any case. Omit this if we are optimizing for time,
2956          --  since conceivably we may be able to do better.
2957
2958          if Align > System_Word_Size / System_Storage_Unit
2959            and then not Optimize_Alignment_Time (E)
2960          then
2961             Align := System_Word_Size / System_Storage_Unit;
2962          end if;
2963
2964          --  Check components. If any component requires a higher alignment,
2965          --  then we set that higher alignment in any case. Don't do this if
2966          --  we have Optimize_Alignment set to Space. Note that that covers
2967          --  the case of packed records, where we already set alignment to 1.
2968
2969          if not Optimize_Alignment_Space (E) then
2970             declare
2971                Comp : Entity_Id;
2972
2973             begin
2974                Comp := First_Component (E);
2975                while Present (Comp) loop
2976                   if Known_Alignment (Etype (Comp)) then
2977                      declare
2978                         Calign : constant Uint := Alignment (Etype (Comp));
2979
2980                      begin
2981                         --  The cases to process are when the alignment of the
2982                         --  component type is larger than the alignment we have
2983                         --  so far, and either there is no component clause for
2984                         --  the component, or the length set by the component
2985                         --  clause matches the length of the component type.
2986
2987                         if Calign > Align
2988                           and then
2989                             (Unknown_Esize (Comp)
2990                               or else (Known_Static_Esize (Comp)
2991                                         and then
2992                                          Esize (Comp) =
2993                                               Calign * System_Storage_Unit))
2994                         then
2995                            Align := UI_To_Int (Calign);
2996                         end if;
2997                      end;
2998                   end if;
2999
3000                   Next_Component (Comp);
3001                end loop;
3002             end;
3003          end if;
3004       end if;
3005
3006       --  Set chosen alignment, and increase Esize if necessary to match the
3007       --  chosen alignment.
3008
3009       Set_Alignment (E, UI_From_Int (Align));
3010
3011       if Known_Static_Esize (E)
3012         and then Esize (E) < Align * System_Storage_Unit
3013       then
3014          Set_Esize (E, UI_From_Int (Align * System_Storage_Unit));
3015       end if;
3016    end Set_Composite_Alignment;
3017
3018    --------------------------
3019    -- Set_Discrete_RM_Size --
3020    --------------------------
3021
3022    procedure Set_Discrete_RM_Size (Def_Id : Entity_Id) is
3023       FST : constant Entity_Id := First_Subtype (Def_Id);
3024
3025    begin
3026       --  All discrete types except for the base types in standard are
3027       --  constrained, so indicate this by setting Is_Constrained.
3028
3029       Set_Is_Constrained (Def_Id);
3030
3031       --  Set generic types to have an unknown size, since the representation
3032       --  of a generic type is irrelevant, in view of the fact that they have
3033       --  nothing to do with code.
3034
3035       if Is_Generic_Type (Root_Type (FST)) then
3036          Set_RM_Size (Def_Id, Uint_0);
3037
3038       --  If the subtype statically matches the first subtype, then it is
3039       --  required to have exactly the same layout. This is required by
3040       --  aliasing considerations.
3041
3042       elsif Def_Id /= FST and then
3043         Subtypes_Statically_Match (Def_Id, FST)
3044       then
3045          Set_RM_Size   (Def_Id, RM_Size (FST));
3046          Set_Size_Info (Def_Id, FST);
3047
3048       --  In all other cases the RM_Size is set to the minimum size. Note that
3049       --  this routine is never called for subtypes for which the RM_Size is
3050       --  set explicitly by an attribute clause.
3051
3052       else
3053          Set_RM_Size (Def_Id, UI_From_Int (Minimum_Size (Def_Id)));
3054       end if;
3055    end Set_Discrete_RM_Size;
3056
3057    ------------------------
3058    -- Set_Elem_Alignment --
3059    ------------------------
3060
3061    procedure Set_Elem_Alignment (E : Entity_Id) is
3062    begin
3063       --  Do not set alignment for packed array types, unless we are doing
3064       --  front end layout, because otherwise this is always handled in the
3065       --  backend.
3066
3067       if Is_Packed_Array_Type (E) and then not Frontend_Layout_On_Target then
3068          return;
3069
3070       --  If there is an alignment clause, then we respect it
3071
3072       elsif Has_Alignment_Clause (E) then
3073          return;
3074
3075       --  If the size is not set, then don't attempt to set the alignment. This
3076       --  happens in the backend layout case for access-to-subprogram types.
3077
3078       elsif not Known_Static_Esize (E) then
3079          return;
3080
3081       --  For access types, do not set the alignment if the size is less than
3082       --  the allowed minimum size. This avoids cascaded error messages.
3083
3084       elsif Is_Access_Type (E)
3085         and then Esize (E) < System_Address_Size
3086       then
3087          return;
3088       end if;
3089
3090       --  Here we calculate the alignment as the largest power of two multiple
3091       --  of System.Storage_Unit that does not exceed either the actual size of
3092       --  the type, or the maximum allowed alignment.
3093
3094       declare
3095          S             : constant Int := UI_To_Int (Esize (E)) / SSU;
3096          A             : Nat;
3097          Max_Alignment : Nat;
3098
3099       begin
3100          --  If the default alignment of "double" floating-point types is
3101          --  specifically capped, enforce the cap.
3102
3103          if Ttypes.Target_Double_Float_Alignment > 0
3104            and then S = 8
3105            and then Is_Floating_Point_Type (E)
3106          then
3107             Max_Alignment := Ttypes.Target_Double_Float_Alignment;
3108
3109          --  If the default alignment of "double" or larger scalar types is
3110          --  specifically capped, enforce the cap.
3111
3112          elsif Ttypes.Target_Double_Scalar_Alignment > 0
3113            and then S >= 8
3114            and then Is_Scalar_Type (E)
3115          then
3116             Max_Alignment := Ttypes.Target_Double_Scalar_Alignment;
3117
3118          --  Otherwise enforce the overall alignment cap
3119
3120          else
3121             Max_Alignment := Ttypes.Maximum_Alignment;
3122          end if;
3123
3124          A := 1;
3125          while 2 * A <= Max_Alignment and then 2 * A <= S loop
3126             A := 2 * A;
3127          end loop;
3128
3129          --  Now we think we should set the alignment to A, but we skip this if
3130          --  an alignment is already set to a value greater than A (happens for
3131          --  derived types).
3132
3133          --  However, if the alignment is known and too small it must be
3134          --  increased, this happens in a case like:
3135
3136          --     type R is new Character;
3137          --     for R'Size use 16;
3138
3139          --  Here the alignment inherited from Character is 1, but it must be
3140          --  increased to 2 to reflect the increased size.
3141
3142          if Unknown_Alignment (E) or else Alignment (E) < A then
3143             Init_Alignment (E, A);
3144          end if;
3145       end;
3146    end Set_Elem_Alignment;
3147
3148    ----------------------
3149    -- SO_Ref_From_Expr --
3150    ----------------------
3151
3152    function SO_Ref_From_Expr
3153      (Expr      : Node_Id;
3154       Ins_Type  : Entity_Id;
3155       Vtype     : Entity_Id := Empty;
3156       Make_Func : Boolean   := False) return Dynamic_SO_Ref
3157    is
3158       Loc  : constant Source_Ptr := Sloc (Ins_Type);
3159       K    : constant Entity_Id := Make_Temporary (Loc, 'K');
3160       Decl : Node_Id;
3161
3162       Vtype_Primary_View : Entity_Id;
3163
3164       function Check_Node_V_Ref (N : Node_Id) return Traverse_Result;
3165       --  Function used to check one node for reference to V
3166
3167       function Has_V_Ref is new Traverse_Func (Check_Node_V_Ref);
3168       --  Function used to traverse tree to check for reference to V
3169
3170       ----------------------
3171       -- Check_Node_V_Ref --
3172       ----------------------
3173
3174       function Check_Node_V_Ref (N : Node_Id) return Traverse_Result is
3175       begin
3176          if Nkind (N) = N_Identifier then
3177             if Chars (N) = Vname then
3178                return Abandon;
3179             else
3180                return Skip;
3181             end if;
3182
3183          else
3184             return OK;
3185          end if;
3186       end Check_Node_V_Ref;
3187
3188    --  Start of processing for SO_Ref_From_Expr
3189
3190    begin
3191       --  Case of expression is an integer literal, in this case we just
3192       --  return the value (which must always be non-negative, since size
3193       --  and offset values can never be negative).
3194
3195       if Nkind (Expr) = N_Integer_Literal then
3196          pragma Assert (Intval (Expr) >= 0);
3197          return Intval (Expr);
3198       end if;
3199
3200       --  Case where there is a reference to V, create function
3201
3202       if Has_V_Ref (Expr) = Abandon then
3203
3204          pragma Assert (Present (Vtype));
3205
3206          --  Check whether Vtype is a view of a private type and ensure that
3207          --  we use the primary view of the type (which is denoted by its
3208          --  Etype, whether it's the type's partial or full view entity).
3209          --  This is needed to make sure that we use the same (primary) view
3210          --  of the type for all V formals, whether the current view of the
3211          --  type is the partial or full view, so that types will always
3212          --  match on calls from one size function to another.
3213
3214          if  Has_Private_Declaration (Vtype) then
3215             Vtype_Primary_View := Etype (Vtype);
3216          else
3217             Vtype_Primary_View := Vtype;
3218          end if;
3219
3220          Set_Is_Discrim_SO_Function (K);
3221
3222          Decl :=
3223            Make_Subprogram_Body (Loc,
3224
3225              Specification =>
3226                Make_Function_Specification (Loc,
3227                  Defining_Unit_Name => K,
3228                    Parameter_Specifications => New_List (
3229                      Make_Parameter_Specification (Loc,
3230                        Defining_Identifier =>
3231                          Make_Defining_Identifier (Loc, Chars => Vname),
3232                        Parameter_Type      =>
3233                          New_Occurrence_Of (Vtype_Primary_View, Loc))),
3234                    Result_Definition =>
3235                      New_Occurrence_Of (Standard_Unsigned, Loc)),
3236
3237              Declarations => Empty_List,
3238
3239              Handled_Statement_Sequence =>
3240                Make_Handled_Sequence_Of_Statements (Loc,
3241                  Statements => New_List (
3242                    Make_Simple_Return_Statement (Loc,
3243                      Expression => Expr))));
3244
3245       --  The caller requests that the expression be encapsulated in a
3246       --  parameterless function.
3247
3248       elsif Make_Func then
3249          Decl :=
3250            Make_Subprogram_Body (Loc,
3251
3252              Specification =>
3253                Make_Function_Specification (Loc,
3254                  Defining_Unit_Name => K,
3255                    Parameter_Specifications => Empty_List,
3256                    Result_Definition =>
3257                      New_Occurrence_Of (Standard_Unsigned, Loc)),
3258
3259              Declarations => Empty_List,
3260
3261              Handled_Statement_Sequence =>
3262                Make_Handled_Sequence_Of_Statements (Loc,
3263                  Statements => New_List (
3264                    Make_Simple_Return_Statement (Loc, Expression => Expr))));
3265
3266       --  No reference to V and function not requested, so create a constant
3267
3268       else
3269          Decl :=
3270            Make_Object_Declaration (Loc,
3271              Defining_Identifier => K,
3272              Object_Definition   =>
3273                New_Occurrence_Of (Standard_Unsigned, Loc),
3274              Constant_Present    => True,
3275              Expression          => Expr);
3276       end if;
3277
3278       Append_Freeze_Action (Ins_Type, Decl);
3279       Analyze (Decl);
3280       return Create_Dynamic_SO_Ref (K);
3281    end SO_Ref_From_Expr;
3282
3283 end Layout;