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 --                                                                          --
  10 --          Copyright (C) 2001-2002 Free Software Foundation, Inc.          --
  11 --                                                                          --
  12 -- GNAT is free software;  you can  redistribute it  and/or modify it under --
  13 -- terms of the  GNU General Public License as published  by the Free Soft- --
  14 -- ware  Foundation;  either version 2,  or (at your option) any later ver- --
  15 -- sion.  GNAT is distributed in the hope that it will be useful, but WITH- --
  16 -- OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY --
  17 -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  18 -- for  more details.  You should have  received  a copy of the GNU General --
  19 -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
  20 -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
  21 -- MA 02111-1307, USA.                                                      --
  22 --                                                                          --
  23 -- GNAT was originally developed  by the GNAT team at  New York University. --
  24 -- Extensive contributions were provided by Ada Core Technologies Inc.      --
  25 --                                                                          --
  26 ------------------------------------------------------------------------------
  27
  28 with Atree;    use Atree;
  29 with Checks;   use Checks;
  30 with Debug;    use Debug;
  31 with Einfo;    use Einfo;
  32 with Errout;   use Errout;
  33 with Exp_Ch3;  use Exp_Ch3;
  34 with Exp_Util; use Exp_Util;
  35 with Nlists;   use Nlists;
  36 with Nmake;    use Nmake;
  37 with Repinfo;  use Repinfo;
  38 with Sem;      use Sem;
  39 with Sem_Ch13; use Sem_Ch13;
  40 with Sem_Eval; use Sem_Eval;
  41 with Sem_Util; use Sem_Util;
  42 with Sinfo;    use Sinfo;
  43 with Snames;   use Snames;
  44 with Stand;    use Stand;
  45 with Targparm; use Targparm;
  46 with Tbuild;   use Tbuild;
  47 with Ttypes;   use Ttypes;
  48 with Uintp;    use Uintp;
  49
  50 package body Layout is
  51
  52    ------------------------
  53    -- Local Declarations --
  54    ------------------------
  55
  56    SSU : constant Int := Ttypes.System_Storage_Unit;
  57    --  Short hand for System_Storage_Unit
  58
  59    Vname : constant Name_Id := Name_uV;
  60    --  Formal parameter name used for functions generated for size offset
  61    --  values that depend on the discriminant. All such functions have the
  62    --  following form:
  63    --
  64    --     function xxx (V : vtyp) return Unsigned is
  65    --     begin
  66    --        return ... expression involving V.discrim
  67    --     end xxx;
  68
  69    -----------------------
  70    -- Local Subprograms --
  71    -----------------------
  72
  73    procedure Adjust_Esize_Alignment (E : Entity_Id);
  74    --  E is the entity for a type or object. This procedure checks that the
  75    --  size and alignment are compatible, and if not either gives an error
  76    --  message if they cannot be adjusted or else adjusts them appropriately.
  77
  78    function Assoc_Add
  79      (Loc        : Source_Ptr;
  80       Left_Opnd  : Node_Id;
  81       Right_Opnd : Node_Id)
  82       return       Node_Id;
  83    --  This is like Make_Op_Add except that it optimizes some cases knowing
  84    --  that associative rearrangement is allowed for constant folding if one
  85    --  of the operands is a compile time known value.
  86
  87    function Assoc_Multiply
  88      (Loc        : Source_Ptr;
  89       Left_Opnd  : Node_Id;
  90       Right_Opnd : Node_Id)
  91       return       Node_Id;
  92    --  This is like Make_Op_Multiply except that it optimizes some cases
  93    --  knowing that associative rearrangement is allowed for constant
  94    --  folding if one of the operands is a compile time known value
  95
  96    function Assoc_Subtract
  97      (Loc        : Source_Ptr;
  98       Left_Opnd  : Node_Id;
  99       Right_Opnd : Node_Id)
 100       return       Node_Id;
 101    --  This is like Make_Op_Subtract except that it optimizes some cases
 102    --  knowing that associative rearrangement is allowed for constant
 103    --  folding if one of the operands is a compile time known value
 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    function Expr_From_SO_Ref
 113      (Loc  : Source_Ptr;
 114       D    : SO_Ref)
 115       return Node_Id;
 116    --  Given a value D from a size or offset field, return an expression
 117    --  representing the value stored. If the value is known at compile time,
 118    --  then an N_Integer_Literal is returned with the appropriate value. If
 119    --  the value references a constant entity, then an N_Identifier node
 120    --  referencing this entity is returned. The Loc value is used for the
 121    --  Sloc value of constructed notes.
 122
 123    function SO_Ref_From_Expr
 124      (Expr      : Node_Id;
 125       Ins_Type  : Entity_Id;
 126       Vtype     : Entity_Id := Empty)
 127       return      Dynamic_SO_Ref;
 128    --  This routine is used in the case where a size/offset value is dynamic
 129    --  and is represented by the expression Expr. SO_Ref_From_Expr checks if
 130    --  the Expr contains a reference to the identifier V, and if so builds
 131    --  a function depending on discriminants of the formal parameter V which
 132    --  is of type Vtype. If not, then a constant entity with the value Expr
 133    --  is built. The result is a Dynamic_SO_Ref to the created entity. Note
 134    --  that Vtype can be omitted if Expr does not contain any reference to V.
 135    --  the created entity. The declaration created is inserted in the freeze
 136    --  actions of Ins_Type, which also supplies the Sloc for created nodes.
 137    --  This function also takes care of making sure that the expression is
 138    --  properly analyzed and resolved (which may not be the case yet if we
 139    --  build the expression in this unit).
 140
 141    function Get_Max_Size (E : Entity_Id) return Node_Id;
 142    --  E is an array type or subtype that has at least one index bound that
 143    --  is the value of a record discriminant. For such an array, the function
 144    --  computes an expression that yields the maximum possible size of the
 145    --  array in storage units. The result is not defined for any other type,
 146    --  or for arrays that do not depend on discriminants, and it is a fatal
 147    --  error to call this unless Size_Depends_On_Discrminant (E) is True.
 148
 149    procedure Layout_Array_Type (E : Entity_Id);
 150    --  Front end layout of non-bit-packed array type or subtype
 151
 152    procedure Layout_Record_Type (E : Entity_Id);
 153    --  Front end layout of record type
 154    --  Variant records not handled yet ???
 155
 156    procedure Rewrite_Integer (N : Node_Id; V : Uint);
 157    --  Rewrite node N with an integer literal whose value is V. The Sloc
 158    --  for the new node is taken from N, and the type of the literal is
 159    --  set to a copy of the type of N on entry.
 160
 161    procedure Set_And_Check_Static_Size
 162      (E      : Entity_Id;
 163       Esiz   : SO_Ref;
 164       RM_Siz : SO_Ref);
 165    --  This procedure is called to check explicit given sizes (possibly
 166    --  stored in the Esize and RM_Size fields of E) against computed
 167    --  Object_Size (Esiz) and Value_Size (RM_Siz) values. Appropriate
 168    --  errors and warnings are posted if specified sizes are inconsistent
 169    --  with specified sizes. On return, the Esize and RM_Size fields of
 170    --  E are set (either from previously given values, or from the newly
 171    --  computed values, as appropriate).
 172
 173    procedure Set_Composite_Alignment (E : Entity_Id);
 174    --  This procedure is called for record types and subtypes, and also for
 175    --  atomic array types and subtypes. If no alignment is set, and the size
 176    --  is 2 or 4 (or 8 if the word size is 8), then the alignment is set to
 177    --  match the size.
 178
 179    ----------------------------
 180    -- Adjust_Esize_Alignment --
 181    ----------------------------
 182
 183    procedure Adjust_Esize_Alignment (E : Entity_Id) is
 184       Abits     : Int;
 185       Esize_Set : Boolean;
 186
 187    begin
 188       --  Nothing to do if size unknown
 189
 190       if Unknown_Esize (E) then
 191          return;
 192       end if;
 193
 194       --  Determine if size is constrained by an attribute definition clause
 195       --  which must be obeyed. If so, we cannot increase the size in this
 196       --  routine.
 197
 198       --  For a type, the issue is whether an object size clause has been
 199       --  set. A normal size clause constrains only the value size (RM_Size)
 200
 201       if Is_Type (E) then
 202          Esize_Set := Has_Object_Size_Clause (E);
 203
 204       --  For an object, the issue is whether a size clause is present
 205
 206       else
 207          Esize_Set := Has_Size_Clause (E);
 208       end if;
 209
 210       --  If size is known it must be a multiple of the byte size
 211
 212       if Esize (E) mod SSU /= 0 then
 213
 214          --  If not, and size specified, then give error
 215
 216          if Esize_Set then
 217             Error_Msg_NE
 218               ("size for& not a multiple of byte size", Size_Clause (E), E);
 219             return;
 220
 221          --  Otherwise bump up size to a byte boundary
 222
 223          else
 224             Set_Esize (E, (Esize (E) + SSU - 1) / SSU * SSU);
 225          end if;
 226       end if;
 227
 228       --  Now we have the size set, it must be a multiple of the alignment
 229       --  nothing more we can do here if the alignment is unknown here.
 230
 231       if Unknown_Alignment (E) then
 232          return;
 233       end if;
 234
 235       --  At this point both the Esize and Alignment are known, so we need
 236       --  to make sure they are consistent.
 237
 238       Abits := UI_To_Int (Alignment (E)) * SSU;
 239
 240       if Esize (E) mod Abits = 0 then
 241          return;
 242       end if;
 243
 244       --  Here we have a situation where the Esize is not a multiple of
 245       --  the alignment. We must either increase Esize or reduce the
 246       --  alignment to correct this situation.
 247
 248       --  The case in which we can decrease the alignment is where the
 249       --  alignment was not set by an alignment clause, and the type in
 250       --  question is a discrete type, where it is definitely safe to
 251       --  reduce the alignment. For example:
 252
 253       --    t : integer range 1 .. 2;
 254       --    for t'size use 8;
 255
 256       --  In this situation, the initial alignment of t is 4, copied from
 257       --  the Integer base type, but it is safe to reduce it to 1 at this
 258       --  stage, since we will only be loading a single byte.
 259
 260       if Is_Discrete_Type (Etype (E))
 261         and then not Has_Alignment_Clause (E)
 262       then
 263          loop
 264             Abits := Abits / 2;
 265             exit when Esize (E) mod Abits = 0;
 266          end loop;
 267
 268          Init_Alignment (E, Abits / SSU);
 269          return;
 270       end if;
 271
 272       --  Now the only possible approach left is to increase the Esize
 273       --  but we can't do that if the size was set by a specific clause.
 274
 275       if Esize_Set then
 276          Error_Msg_NE
 277            ("size for& is not a multiple of alignment",
 278             Size_Clause (E), E);
 279
 280       --  Otherwise we can indeed increase the size to a multiple of alignment
 281
 282       else
 283          Set_Esize (E, ((Esize (E) + (Abits - 1)) / Abits) * Abits);
 284       end if;
 285    end Adjust_Esize_Alignment;
 286
 287    ---------------
 288    -- Assoc_Add --
 289    ---------------
 290
 291    function Assoc_Add
 292      (Loc        : Source_Ptr;
 293       Left_Opnd  : Node_Id;
 294       Right_Opnd : Node_Id)
 295       return       Node_Id
 296    is
 297       L : Node_Id;
 298       R : Uint;
 299
 300    begin
 301       --  Case of right operand is a constant
 302
 303       if Compile_Time_Known_Value (Right_Opnd) then
 304          L := Left_Opnd;
 305          R := Expr_Value (Right_Opnd);
 306
 307       --  Case of left operand is a constant
 308
 309       elsif Compile_Time_Known_Value (Left_Opnd) then
 310          L := Right_Opnd;
 311          R := Expr_Value (Left_Opnd);
 312
 313       --  Neither operand is a constant, do the addition with no optimization
 314
 315       else
 316          return Make_Op_Add (Loc, Left_Opnd, Right_Opnd);
 317       end if;
 318
 319       --  Case of left operand is an addition
 320
 321       if Nkind (L) = N_Op_Add then
 322
 323          --  (C1 + E) + C2 = (C1 + C2) + E
 324
 325          if Compile_Time_Known_Value (Sinfo.Left_Opnd (L)) then
 326             Rewrite_Integer
 327               (Sinfo.Left_Opnd (L),
 328                Expr_Value (Sinfo.Left_Opnd (L)) + R);
 329             return L;
 330
 331          --  (E + C1) + C2 = E + (C1 + C2)
 332
 333          elsif Compile_Time_Known_Value (Sinfo.Right_Opnd (L)) then
 334             Rewrite_Integer
 335               (Sinfo.Right_Opnd (L),
 336                Expr_Value (Sinfo.Right_Opnd (L)) + R);
 337             return L;
 338          end if;
 339
 340       --  Case of left operand is a subtraction
 341
 342       elsif Nkind (L) = N_Op_Subtract then
 343
 344          --  (C1 - E) + C2 = (C1 + C2) + E
 345
 346          if Compile_Time_Known_Value (Sinfo.Left_Opnd (L)) then
 347             Rewrite_Integer
 348               (Sinfo.Left_Opnd (L),
 349                Expr_Value (Sinfo.Left_Opnd (L)) + R);
 350             return L;
 351
 352          --  (E - C1) + C2 = E - (C1 - C2)
 353
 354          elsif Compile_Time_Known_Value (Sinfo.Right_Opnd (L)) then
 355             Rewrite_Integer
 356               (Sinfo.Right_Opnd (L),
 357                Expr_Value (Sinfo.Right_Opnd (L)) - R);
 358             return L;
 359          end if;
 360       end if;
 361
 362       --  Not optimizable, do the addition
 363
 364       return Make_Op_Add (Loc, Left_Opnd, Right_Opnd);
 365    end Assoc_Add;
 366
 367    --------------------
 368    -- Assoc_Multiply --
 369    --------------------
 370
 371    function Assoc_Multiply
 372      (Loc        : Source_Ptr;
 373       Left_Opnd  : Node_Id;
 374       Right_Opnd : Node_Id)
 375       return       Node_Id
 376    is
 377       L : Node_Id;
 378       R : Uint;
 379
 380    begin
 381       --  Case of right operand is a constant
 382
 383       if Compile_Time_Known_Value (Right_Opnd) then
 384          L := Left_Opnd;
 385          R := Expr_Value (Right_Opnd);
 386
 387       --  Case of left operand is a constant
 388
 389       elsif Compile_Time_Known_Value (Left_Opnd) then
 390          L := Right_Opnd;
 391          R := Expr_Value (Left_Opnd);
 392
 393       --  Neither operand is a constant, do the multiply with no optimization
 394
 395       else
 396          return Make_Op_Multiply (Loc, Left_Opnd, Right_Opnd);
 397       end if;
 398
 399       --  Case of left operand is an multiplication
 400
 401       if Nkind (L) = N_Op_Multiply then
 402
 403          --  (C1 * E) * C2 = (C1 * C2) + E
 404
 405          if Compile_Time_Known_Value (Sinfo.Left_Opnd (L)) then
 406             Rewrite_Integer
 407               (Sinfo.Left_Opnd (L),
 408                Expr_Value (Sinfo.Left_Opnd (L)) * R);
 409             return L;
 410
 411          --  (E * C1) * C2 = E * (C1 * C2)
 412
 413          elsif Compile_Time_Known_Value (Sinfo.Right_Opnd (L)) then
 414             Rewrite_Integer
 415               (Sinfo.Right_Opnd (L),
 416                Expr_Value (Sinfo.Right_Opnd (L)) * R);
 417             return L;
 418          end if;
 419       end if;
 420
 421       --  Not optimizable, do the multiplication
 422
 423       return Make_Op_Multiply (Loc, Left_Opnd, Right_Opnd);
 424    end Assoc_Multiply;
 425
 426    --------------------
 427    -- Assoc_Subtract --
 428    --------------------
 429
 430    function Assoc_Subtract
 431      (Loc        : Source_Ptr;
 432       Left_Opnd  : Node_Id;
 433       Right_Opnd : Node_Id)
 434       return       Node_Id
 435    is
 436       L : Node_Id;
 437       R : Uint;
 438
 439    begin
 440       --  Case of right operand is a constant
 441
 442       if Compile_Time_Known_Value (Right_Opnd) then
 443          L := Left_Opnd;
 444          R := Expr_Value (Right_Opnd);
 445
 446       --  Right operand is a constant, do the subtract with no optimization
 447
 448       else
 449          return Make_Op_Subtract (Loc, Left_Opnd, Right_Opnd);
 450       end if;
 451
 452       --  Case of left operand is an addition
 453
 454       if Nkind (L) = N_Op_Add then
 455
 456          --  (C1 + E) - C2 = (C1 - C2) + E
 457
 458          if Compile_Time_Known_Value (Sinfo.Left_Opnd (L)) then
 459             Rewrite_Integer
 460               (Sinfo.Left_Opnd (L),
 461                Expr_Value (Sinfo.Left_Opnd (L)) - R);
 462             return L;
 463
 464          --  (E + C1) - C2 = E + (C1 - C2)
 465
 466          elsif Compile_Time_Known_Value (Sinfo.Right_Opnd (L)) then
 467             Rewrite_Integer
 468               (Sinfo.Right_Opnd (L),
 469                Expr_Value (Sinfo.Right_Opnd (L)) - R);
 470             return L;
 471          end if;
 472
 473       --  Case of left operand is a subtraction
 474
 475       elsif Nkind (L) = N_Op_Subtract then
 476
 477          --  (C1 - E) - C2 = (C1 - C2) + E
 478
 479          if Compile_Time_Known_Value (Sinfo.Left_Opnd (L)) then
 480             Rewrite_Integer
 481               (Sinfo.Left_Opnd (L),
 482                Expr_Value (Sinfo.Left_Opnd (L)) + R);
 483             return L;
 484
 485          --  (E - C1) - C2 = E - (C1 + C2)
 486
 487          elsif Compile_Time_Known_Value (Sinfo.Right_Opnd (L)) then
 488             Rewrite_Integer
 489               (Sinfo.Right_Opnd (L),
 490                Expr_Value (Sinfo.Right_Opnd (L)) + R);
 491             return L;
 492          end if;
 493       end if;
 494
 495       --  Not optimizable, do the subtraction
 496
 497       return Make_Op_Subtract (Loc, Left_Opnd, Right_Opnd);
 498    end Assoc_Subtract;
 499
 500    --------------------
 501    -- Compute_Length --
 502    --------------------
 503
 504    function Compute_Length (Lo : Node_Id; Hi : Node_Id) return Node_Id is
 505       Loc   : constant Source_Ptr := Sloc (Lo);
 506       Typ   : constant Entity_Id  := Etype (Lo);
 507       Lo_Op : Node_Id;
 508       Hi_Op : Node_Id;
 509
 510    begin
 511       Lo_Op := New_Copy_Tree (Lo);
 512       Hi_Op := New_Copy_Tree (Hi);
 513
 514       --  If type is enumeration type, then use Pos attribute to convert
 515       --  to integer type for which subtraction is a permitted operation.
 516
 517       if Is_Enumeration_Type (Typ) then
 518          Lo_Op :=
 519            Make_Attribute_Reference (Loc,
 520              Prefix         => New_Occurrence_Of (Typ, Loc),
 521              Attribute_Name => Name_Pos,
 522              Expressions    => New_List (Lo_Op));
 523
 524          Hi_Op :=
 525            Make_Attribute_Reference (Loc,
 526              Prefix         => New_Occurrence_Of (Typ, Loc),
 527              Attribute_Name => Name_Pos,
 528              Expressions    => New_List (Hi_Op));
 529       end if;
 530
 531       return
 532         Assoc_Add (Loc,
 533           Left_Opnd =>
 534             Assoc_Subtract (Loc,
 535               Left_Opnd  => Hi_Op,
 536               Right_Opnd => Lo_Op),
 537           Right_Opnd => Make_Integer_Literal (Loc, 1));
 538    end Compute_Length;
 539
 540    ----------------------
 541    -- Expr_From_SO_Ref --
 542    ----------------------
 543
 544    function Expr_From_SO_Ref
 545      (Loc  : Source_Ptr;
 546       D    : SO_Ref)
 547       return Node_Id
 548    is
 549       Ent : Entity_Id;
 550
 551    begin
 552       if Is_Dynamic_SO_Ref (D) then
 553          Ent := Get_Dynamic_SO_Entity (D);
 554
 555          if Is_Discrim_SO_Function (Ent) then
 556             return
 557               Make_Function_Call (Loc,
 558                 Name                   => New_Occurrence_Of (Ent, Loc),
 559                 Parameter_Associations => New_List (
 560                   Make_Identifier (Loc, Chars => Vname)));
 561
 562          else
 563             return New_Occurrence_Of (Ent, Loc);
 564          end if;
 565
 566       else
 567          return Make_Integer_Literal (Loc, D);
 568       end if;
 569    end Expr_From_SO_Ref;
 570
 571    ------------------
 572    -- Get_Max_Size --
 573    ------------------
 574
 575    function Get_Max_Size (E : Entity_Id) return Node_Id is
 576       Loc  : constant Source_Ptr := Sloc (E);
 577       Indx : Node_Id;
 578       Ityp : Entity_Id;
 579       Lo   : Node_Id;
 580       Hi   : Node_Id;
 581       S    : Uint;
 582       Len  : Node_Id;
 583
 584       type Val_Status_Type is (Const, Dynamic);
 585
 586       type Val_Type (Status : Val_Status_Type := Const) is
 587          record
 588             case Status is
 589                when Const   => Val : Uint;
 590                when Dynamic => Nod : Node_Id;
 591             end case;
 592          end record;
 593       --  Shows the status of the value so far. Const means that the value
 594       --  is constant, and Val is the current constant value. Dynamic means
 595       --  that the value is dynamic, and in this case Nod is the Node_Id of
 596       --  the expression to compute the value.
 597
 598       Size : Val_Type;
 599       --  Calculated value so far if Size.Status = Const,
 600       --  or expression value so far if Size.Status = Dynamic.
 601
 602       SU_Convert_Required : Boolean := False;
 603       --  This is set to True if the final result must be converted from
 604       --  bits to storage units (rounding up to a storage unit boundary).
 605
 606       -----------------------
 607       -- Local Subprograms --
 608       -----------------------
 609
 610       procedure Max_Discrim (N : in out Node_Id);
 611       --  If the node N represents a discriminant, replace it by the maximum
 612       --  value of the discriminant.
 613
 614       procedure Min_Discrim (N : in out Node_Id);
 615       --  If the node N represents a discriminant, replace it by the minimum
 616       --  value of the discriminant.
 617
 618       -----------------
 619       -- Max_Discrim --
 620       -----------------
 621
 622       procedure Max_Discrim (N : in out Node_Id) is
 623       begin
 624          if Nkind (N) = N_Identifier
 625            and then Ekind (Entity (N)) = E_Discriminant
 626          then
 627             N := Type_High_Bound (Etype (N));
 628          end if;
 629       end Max_Discrim;
 630
 631       -----------------
 632       -- Min_Discrim --
 633       -----------------
 634
 635       procedure Min_Discrim (N : in out Node_Id) is
 636       begin
 637          if Nkind (N) = N_Identifier
 638            and then Ekind (Entity (N)) = E_Discriminant
 639          then
 640             N := Type_Low_Bound (Etype (N));
 641          end if;
 642       end Min_Discrim;
 643
 644    --  Start of processing for Get_Max_Size
 645
 646    begin
 647       pragma Assert (Size_Depends_On_Discriminant (E));
 648
 649       --  Initialize status from component size
 650
 651       if Known_Static_Component_Size (E) then
 652          Size := (Const, Component_Size (E));
 653
 654       else
 655          Size := (Dynamic, Expr_From_SO_Ref (Loc, Component_Size (E)));
 656       end if;
 657
 658       --  Loop through indices
 659
 660       Indx := First_Index (E);
 661       while Present (Indx) loop
 662          Ityp := Etype (Indx);
 663          Lo := Type_Low_Bound (Ityp);
 664          Hi := Type_High_Bound (Ityp);
 665
 666          Min_Discrim (Lo);
 667          Max_Discrim (Hi);
 668
 669          --  Value of the current subscript range is statically known
 670
 671          if Compile_Time_Known_Value (Lo)
 672            and then Compile_Time_Known_Value (Hi)
 673          then
 674             S := Expr_Value (Hi) - Expr_Value (Lo) + 1;
 675
 676             --  If known flat bound, entire size of array is zero!
 677
 678             if S <= 0 then
 679                return Make_Integer_Literal (Loc, 0);
 680             end if;
 681
 682             --  Current value is constant, evolve value
 683
 684             if Size.Status = Const then
 685                Size.Val := Size.Val * S;
 686
 687             --  Current value is dynamic
 688
 689             else
 690                --  An interesting little optimization, if we have a pending
 691                --  conversion from bits to storage units, and the current
 692                --  length is a multiple of the storage unit size, then we
 693                --  can take the factor out here statically, avoiding some
 694                --  extra dynamic computations at the end.
 695
 696                if SU_Convert_Required and then S mod SSU = 0 then
 697                   S := S / SSU;
 698                   SU_Convert_Required := False;
 699                end if;
 700
 701                Size.Nod :=
 702                  Assoc_Multiply (Loc,
 703                    Left_Opnd  => Size.Nod,
 704                    Right_Opnd =>
 705                      Make_Integer_Literal (Loc, Intval => S));
 706             end if;
 707
 708          --  Value of the current subscript range is dynamic
 709
 710          else
 711             --  If the current size value is constant, then here is where we
 712             --  make a transition to dynamic values, which are always stored
 713             --  in storage units, However, we do not want to convert to SU's
 714             --  too soon, consider the case of a packed array of single bits,
 715             --  we want to do the SU conversion after computing the size in
 716             --  this case.
 717
 718             if Size.Status = Const then
 719
 720                --  If the current value is a multiple of the storage unit,
 721                --  then most certainly we can do the conversion now, simply
 722                --  by dividing the current value by the storage unit value.
 723                --  If this works, we set SU_Convert_Required to False.
 724
 725                if Size.Val mod SSU = 0 then
 726
 727                   Size :=
 728                     (Dynamic, Make_Integer_Literal (Loc, Size.Val / SSU));
 729                   SU_Convert_Required := False;
 730
 731                --  Otherwise, we go ahead and convert the value in bits,
 732                --  and set SU_Convert_Required to True to ensure that the
 733                --  final value is indeed properly converted.
 734
 735                else
 736                   Size := (Dynamic, Make_Integer_Literal (Loc, Size.Val));
 737                   SU_Convert_Required := True;
 738                end if;
 739             end if;
 740
 741             --  Length is hi-lo+1
 742
 743             Len := Compute_Length (Lo, Hi);
 744
 745             --  Check possible range of Len
 746
 747             declare
 748                OK  : Boolean;
 749                LLo : Uint;
 750                LHi : Uint;
 751
 752             begin
 753                Set_Parent (Len, E);
 754                Determine_Range (Len, OK, LLo, LHi);
 755
 756                Len := Convert_To (Standard_Unsigned, Len);
 757
 758                --  If we cannot verify that range cannot be super-flat,
 759                --  we need a max with zero, since length must be non-neg.
 760
 761                if not OK or else LLo < 0 then
 762                   Len :=
 763                     Make_Attribute_Reference (Loc,
 764                       Prefix         =>
 765                         New_Occurrence_Of (Standard_Unsigned, Loc),
 766                       Attribute_Name => Name_Max,
 767                       Expressions    => New_List (
 768                         Make_Integer_Literal (Loc, 0),
 769                         Len));
 770                end if;
 771             end;
 772          end if;
 773
 774          Next_Index (Indx);
 775       end loop;
 776
 777       --  Here after processing all bounds to set sizes. If the value is
 778       --  a constant, then it is bits, and we just return the value.
 779
 780       if Size.Status = Const then
 781          return Make_Integer_Literal (Loc, Size.Val);
 782
 783       --  Case where the value is dynamic
 784
 785       else
 786          --  Do convert from bits to SU's if needed
 787
 788          if SU_Convert_Required then
 789
 790             --  The expression required is (Size.Nod + SU - 1) / SU
 791
 792             Size.Nod :=
 793               Make_Op_Divide (Loc,
 794                 Left_Opnd =>
 795                   Make_Op_Add (Loc,
 796                     Left_Opnd  => Size.Nod,
 797                     Right_Opnd => Make_Integer_Literal (Loc, SSU - 1)),
 798                 Right_Opnd => Make_Integer_Literal (Loc, SSU));
 799          end if;
 800
 801          return Size.Nod;
 802       end if;
 803    end Get_Max_Size;
 804
 805    -----------------------
 806    -- Layout_Array_Type --
 807    -----------------------
 808
 809    procedure Layout_Array_Type (E : Entity_Id) is
 810       Loc  : constant Source_Ptr := Sloc (E);
 811       Ctyp : constant Entity_Id  := Component_Type (E);
 812       Indx : Node_Id;
 813       Ityp : Entity_Id;
 814       Lo   : Node_Id;
 815       Hi   : Node_Id;
 816       S    : Uint;
 817       Len  : Node_Id;
 818
 819       Insert_Typ : Entity_Id;
 820       --  This is the type with which any generated constants or functions
 821       --  will be associated (i.e. inserted into the freeze actions). This
 822       --  is normally the type being layed out. The exception occurs when
 823       --  we are laying out Itype's which are local to a record type, and
 824       --  whose scope is this record type. Such types do not have freeze
 825       --  nodes (because we have no place to put them).
 826
 827       ------------------------------------
 828       -- How An Array Type is Layed Out --
 829       ------------------------------------
 830
 831       --  Here is what goes on. We need to multiply the component size of
 832       --  the array (which has already been set) by the length of each of
 833       --  the indexes. If all these values are known at compile time, then
 834       --  the resulting size of the array is the appropriate constant value.
 835
 836       --  If the component size or at least one bound is dynamic (but no
 837       --  discriminants are present), then the size will be computed as an
 838       --  expression that calculates the proper size.
 839
 840       --  If there is at least one discriminant bound, then the size is also
 841       --  computed as an expression, but this expression contains discriminant
 842       --  values which are obtained by selecting from a function parameter, and
 843       --  the size is given by a function that is passed the variant record in
 844       --  question, and whose body is the expression.
 845
 846       type Val_Status_Type is (Const, Dynamic, Discrim);
 847
 848       type Val_Type (Status : Val_Status_Type := Const) is
 849          record
 850             case Status is
 851                when Const =>
 852                   Val : Uint;
 853                   --  Calculated value so far if Val_Status = Const
 854
 855                when Dynamic | Discrim =>
 856                   Nod : Node_Id;
 857                   --  Expression value so far if Val_Status /= Const
 858
 859             end case;
 860          end record;
 861       --  Records the value or expression computed so far. Const means that
 862       --  the value is constant, and Val is the current constant value.
 863       --  Dynamic means that the value is dynamic, and in this case Nod is
 864       --  the Node_Id of the expression to compute the value, and Discrim
 865       --  means that at least one bound is a discriminant, in which case Nod
 866       --  is the expression so far (which will be the body of the function).
 867
 868       Size : Val_Type;
 869       --  Value of size computed so far. See comments above.
 870
 871       Vtyp : Entity_Id := Empty;
 872       --  Variant record type for the formal parameter of the
 873       --  discriminant function V if Status = Discrim.
 874
 875       SU_Convert_Required : Boolean := False;
 876       --  This is set to True if the final result must be converted from
 877       --  bits to storage units (rounding up to a storage unit boundary).
 878
 879       procedure Discrimify (N : in out Node_Id);
 880       --  If N represents a discriminant, then the Size.Status is set to
 881       --  Discrim, and Vtyp is set. The parameter N is replaced with the
 882       --  proper expression to extract the discriminant value from V.
 883
 884       ----------------
 885       -- Discrimify --
 886       ----------------
 887
 888       procedure Discrimify (N : in out Node_Id) is
 889          Decl : Node_Id;
 890          Typ  : Entity_Id;
 891
 892       begin
 893          if Nkind (N) = N_Identifier
 894            and then Ekind (Entity (N)) = E_Discriminant
 895          then
 896             Set_Size_Depends_On_Discriminant (E);
 897
 898             if Size.Status /= Discrim then
 899                Decl := Parent (Parent (Entity (N)));
 900                Size := (Discrim, Size.Nod);
 901                Vtyp := Defining_Identifier (Decl);
 902             end if;
 903
 904             Typ := Etype (N);
 905
 906             N :=
 907               Make_Selected_Component (Loc,
 908                 Prefix        => Make_Identifier (Loc, Chars => Vname),
 909                 Selector_Name => New_Occurrence_Of (Entity (N), Loc));
 910
 911             --  Set the Etype attributes of the selected name and its prefix.
 912             --  Analyze_And_Resolve can't be called here because the Vname
 913             --  entity denoted by the prefix will not yet exist (it's created
 914             --  by SO_Ref_From_Expr, called at the end of Layout_Array_Type).
 915
 916             Set_Etype (Prefix (N), Vtyp);
 917             Set_Etype (N, Typ);
 918          end if;
 919       end Discrimify;
 920
 921    --  Start of processing for Layout_Array_Type
 922
 923    begin
 924       --  Default alignment is component alignment
 925
 926       if Unknown_Alignment (E) then
 927          Set_Alignment (E, Alignment (Ctyp));
 928       end if;
 929
 930       --  Calculate proper type for insertions
 931
 932       if Is_Record_Type (Scope (E)) then
 933          Insert_Typ := Scope (E);
 934       else
 935          Insert_Typ := E;
 936       end if;
 937
 938       --  Deal with component size if base type
 939
 940       if Ekind (E) = E_Array_Type then
 941
 942          --  Cannot do anything if Esize of component type unknown
 943
 944          if Unknown_Esize (Ctyp) then
 945             return;
 946          end if;
 947
 948          --  Set component size if not set already
 949
 950          if Unknown_Component_Size (E) then
 951             Set_Component_Size (E, Esize (Ctyp));
 952          end if;
 953       end if;
 954
 955       --  (RM 13.3 (48)) says that the size of an unconstrained array
 956       --  is implementation defined. We choose to leave it as Unknown
 957       --  here, and the actual behavior is determined by the back end.
 958
 959       if not Is_Constrained (E) then
 960          return;
 961       end if;
 962
 963       --  Initialize status from component size
 964
 965       if Known_Static_Component_Size (E) then
 966          Size := (Const, Component_Size (E));
 967
 968       else
 969          Size := (Dynamic, Expr_From_SO_Ref (Loc, Component_Size (E)));
 970       end if;
 971
 972       --  Loop to process array indices
 973
 974       Indx := First_Index (E);
 975       while Present (Indx) loop
 976          Ityp := Etype (Indx);
 977          Lo := Type_Low_Bound (Ityp);
 978          Hi := Type_High_Bound (Ityp);
 979
 980          --  Value of the current subscript range is statically known
 981
 982          if Compile_Time_Known_Value (Lo)
 983            and then Compile_Time_Known_Value (Hi)
 984          then
 985             S := Expr_Value (Hi) - Expr_Value (Lo) + 1;
 986
 987             --  If known flat bound, entire size of array is zero!
 988
 989             if S <= 0 then
 990                Set_Esize (E, Uint_0);
 991                Set_RM_Size (E, Uint_0);
 992                return;
 993             end if;
 994
 995             --  If constant, evolve value
 996
 997             if Size.Status = Const then
 998                Size.Val := Size.Val * S;
 999
1000             --  Current value is dynamic
1001
1002             else
1003                --  An interesting little optimization, if we have a pending
1004                --  conversion from bits to storage units, and the current
1005                --  length is a multiple of the storage unit size, then we
1006                --  can take the factor out here statically, avoiding some
1007                --  extra dynamic computations at the end.
1008
1009                if SU_Convert_Required and then S mod SSU = 0 then
1010                   S := S / SSU;
1011                   SU_Convert_Required := False;
1012                end if;
1013
1014                --  Now go ahead and evolve the expression
1015
1016                Size.Nod :=
1017                  Assoc_Multiply (Loc,
1018                    Left_Opnd  => Size.Nod,
1019                    Right_Opnd =>
1020                      Make_Integer_Literal (Loc, Intval => S));
1021             end if;
1022
1023          --  Value of the current subscript range is dynamic
1024
1025          else
1026             --  If the current size value is constant, then here is where we
1027             --  make a transition to dynamic values, which are always stored
1028             --  in storage units, However, we do not want to convert to SU's
1029             --  too soon, consider the case of a packed array of single bits,
1030             --  we want to do the SU conversion after computing the size in
1031             --  this case.
1032
1033             if Size.Status = Const then
1034
1035                --  If the current value is a multiple of the storage unit,
1036                --  then most certainly we can do the conversion now, simply
1037                --  by dividing the current value by the storage unit value.
1038                --  If this works, we set SU_Convert_Required to False.
1039
1040                if Size.Val mod SSU = 0 then
1041                   Size :=
1042                     (Dynamic, Make_Integer_Literal (Loc, Size.Val / SSU));
1043                   SU_Convert_Required := False;
1044
1045                --  Otherwise, we go ahead and convert the value in bits,
1046                --  and set SU_Convert_Required to True to ensure that the
1047                --  final value is indeed properly converted.
1048
1049                else
1050                   Size := (Dynamic, Make_Integer_Literal (Loc, Size.Val));
1051                   SU_Convert_Required := True;
1052                end if;
1053             end if;
1054
1055             Discrimify (Lo);
1056             Discrimify (Hi);
1057
1058             --  Length is hi-lo+1
1059
1060             Len := Compute_Length (Lo, Hi);
1061
1062             --  Check possible range of Len
1063
1064             declare
1065                OK  : Boolean;
1066                LLo : Uint;
1067                LHi : Uint;
1068
1069             begin
1070                Set_Parent (Len, E);
1071                Determine_Range (Len, OK, LLo, LHi);
1072
1073                Len := Convert_To (Standard_Unsigned, Len);
1074
1075                --  If range definitely flat or superflat, result size is zero
1076
1077                if OK and then LHi <= 0 then
1078                   Set_Esize (E, Uint_0);
1079                   Set_RM_Size (E, Uint_0);
1080                   return;
1081                end if;
1082
1083                --  If we cannot verify that range cannot be super-flat, we
1084                --  need a maximum with zero, since length cannot be negative.
1085
1086                if not OK or else LLo < 0 then
1087                   Len :=
1088                     Make_Attribute_Reference (Loc,
1089                       Prefix         =>
1090                         New_Occurrence_Of (Standard_Unsigned, Loc),
1091                       Attribute_Name => Name_Max,
1092                       Expressions    => New_List (
1093                         Make_Integer_Literal (Loc, 0),
1094                         Len));
1095                end if;
1096             end;
1097
1098             --  At this stage, Len has the expression for the length
1099
1100             Size.Nod :=
1101               Assoc_Multiply (Loc,
1102                 Left_Opnd  => Size.Nod,
1103                 Right_Opnd => Len);
1104          end if;
1105
1106          Next_Index (Indx);
1107       end loop;
1108
1109       --  Here after processing all bounds to set sizes. If the value is
1110       --  a constant, then it is bits, and the only thing we need to do
1111       --  is to check against explicit given size and do alignment adjust.
1112
1113       if Size.Status = Const then
1114          Set_And_Check_Static_Size (E, Size.Val, Size.Val);
1115          Adjust_Esize_Alignment (E);
1116
1117       --  Case where the value is dynamic
1118
1119       else
1120          --  Do convert from bits to SU's if needed
1121
1122          if SU_Convert_Required then
1123
1124             --  The expression required is (Size.Nod + SU - 1) / SU
1125
1126             Size.Nod :=
1127               Make_Op_Divide (Loc,
1128                 Left_Opnd =>
1129                   Make_Op_Add (Loc,
1130                     Left_Opnd  => Size.Nod,
1131                     Right_Opnd => Make_Integer_Literal (Loc, SSU - 1)),
1132                 Right_Opnd => Make_Integer_Literal (Loc, SSU));
1133          end if;
1134
1135          --  Now set the dynamic size (the Value_Size is always the same
1136          --  as the Object_Size for arrays whose length is dynamic).
1137
1138          --  ??? If Size.Status = Dynamic, Vtyp will not have been set.
1139          --  The added initialization sets it to Empty now, but is this
1140          --  correct?
1141
1142          Set_Esize (E, SO_Ref_From_Expr (Size.Nod, Insert_Typ, Vtyp));
1143          Set_RM_Size (E, Esize (E));
1144       end if;
1145    end Layout_Array_Type;
1146
1147    -------------------
1148    -- Layout_Object --
1149    -------------------
1150
1151    procedure Layout_Object (E : Entity_Id) is
1152       T : constant Entity_Id := Etype (E);
1153
1154    begin
1155       --  Nothing to do if backend does layout
1156
1157       if not Frontend_Layout_On_Target then
1158          return;
1159       end if;
1160
1161       --  Set size if not set for object and known for type. Use the
1162       --  RM_Size if that is known for the type and Esize is not.
1163
1164       if Unknown_Esize (E) then
1165          if Known_Esize (T) then
1166             Set_Esize (E, Esize (T));
1167
1168          elsif Known_RM_Size (T) then
1169             Set_Esize (E, RM_Size (T));
1170          end if;
1171       end if;
1172
1173       --  Set alignment from type if unknown and type alignment known
1174
1175       if Unknown_Alignment (E) and then Known_Alignment (T) then
1176          Set_Alignment (E, Alignment (T));
1177       end if;
1178
1179       --  Make sure size and alignment are consistent
1180
1181       Adjust_Esize_Alignment (E);
1182
1183       --  Final adjustment, if we don't know the alignment, and the Esize
1184       --  was not set by an explicit Object_Size attribute clause, then
1185       --  we reset the Esize to unknown, since we really don't know it.
1186
1187       if Unknown_Alignment (E)
1188         and then not Has_Size_Clause (E)
1189       then
1190          Set_Esize (E, Uint_0);
1191       end if;
1192    end Layout_Object;
1193
1194    ------------------------
1195    -- Layout_Record_Type --
1196    ------------------------
1197
1198    procedure Layout_Record_Type (E : Entity_Id) is
1199       Loc  : constant Source_Ptr := Sloc (E);
1200       Decl : Node_Id;
1201
1202       Comp : Entity_Id;
1203       --  Current component being layed out
1204
1205       Prev_Comp : Entity_Id;
1206       --  Previous layed out component
1207
1208       procedure Get_Next_Component_Location
1209         (Prev_Comp  : Entity_Id;
1210          Align      : Uint;
1211          New_Npos   : out SO_Ref;
1212          New_Fbit   : out SO_Ref;
1213          New_NPMax  : out SO_Ref;
1214          Force_SU   : Boolean);
1215       --  Given the previous component in Prev_Comp, which is already laid
1216       --  out, and the alignment of the following component, lays out the
1217       --  following component, and returns its starting position in New_Npos
1218       --  (Normalized_Position value), New_Fbit (Normalized_First_Bit value),
1219       --  and New_NPMax (Normalized_Position_Max value). If Prev_Comp is empty
1220       --  (no previous component is present), then New_Npos, New_Fbit and
1221       --  New_NPMax are all set to zero on return. This procedure is also
1222       --  used to compute the size of a record or variant by giving it the
1223       --  last component, and the record alignment. Force_SU is used to force
1224       --  the new component location to be aligned on a storage unit boundary,
1225       --  even in a packed record, False means that the new position does not
1226       --  need to be bumped to a storage unit boundary, True means a storage
1227       --  unit boundary is always required.
1228
1229       procedure Layout_Component (Comp : Entity_Id; Prev_Comp : Entity_Id);
1230       --  Lays out component Comp, given Prev_Comp, the previously laid-out
1231       --  component (Prev_Comp = Empty if no components laid out yet). The
1232       --  alignment of the record itself is also updated if needed. Both
1233       --  Comp and Prev_Comp can be either components or discriminants. A
1234       --  special case is when Comp is Empty, this is used at the end
1235       --  to determine the size of the entire record. For this special
1236       --  call the resulting offset is placed in Final_Offset.
1237
1238       procedure Layout_Components
1239         (From   : Entity_Id;
1240          To     : Entity_Id;
1241          Esiz   : out SO_Ref;
1242          RM_Siz : out SO_Ref);
1243       --  This procedure lays out the components of the given component list
1244       --  which contains the components starting with From, and ending with To.
1245       --  The Next_Entity chain is used to traverse the components. On entry
1246       --  Prev_Comp is set to the component preceding the list, so that the
1247       --  list is layed out after this component. Prev_Comp is set to Empty if
1248       --  the component list is to be layed out starting at the start of the
1249       --  record. On return, the components are all layed out, and Prev_Comp is
1250       --  set to the last layed out component. On return, Esiz is set to the
1251       --  resulting Object_Size value, which is the length of the record up
1252       --  to and including the last layed out entity. For Esiz, the value is
1253       --  adjusted to match the alignment of the record. RM_Siz is similarly
1254       --  set to the resulting Value_Size value, which is the same length, but
1255       --  not adjusted to meet the alignment. Note that in the case of variant
1256       --  records, Esiz represents the maximum size.
1257
1258       procedure Layout_Non_Variant_Record;
1259       --  Procedure called to layout a non-variant record type or subtype
1260
1261       procedure Layout_Variant_Record;
1262       --  Procedure called to layout a variant record type. Decl is set to the
1263       --  full type declaration for the variant record.
1264
1265       ---------------------------------
1266       -- Get_Next_Component_Location --
1267       ---------------------------------
1268
1269       procedure Get_Next_Component_Location
1270         (Prev_Comp  : Entity_Id;
1271          Align      : Uint;
1272          New_Npos   : out SO_Ref;
1273          New_Fbit   : out SO_Ref;
1274          New_NPMax  : out SO_Ref;
1275          Force_SU   : Boolean)
1276       is
1277       begin
1278          --  No previous component, return zero position
1279
1280          if No (Prev_Comp) then
1281             New_Npos  := Uint_0;
1282             New_Fbit  := Uint_0;
1283             New_NPMax := Uint_0;
1284             return;
1285          end if;
1286
1287          --  Here we have a previous component
1288
1289          declare
1290             Loc       : constant Source_Ptr := Sloc (Prev_Comp);
1291
1292             Old_Npos  : constant SO_Ref := Normalized_Position     (Prev_Comp);
1293             Old_Fbit  : constant SO_Ref := Normalized_First_Bit    (Prev_Comp);
1294             Old_NPMax : constant SO_Ref := Normalized_Position_Max (Prev_Comp);
1295             Old_Esiz  : constant SO_Ref := Esize                   (Prev_Comp);
1296
1297             Old_Maxsz : Node_Id;
1298             --  Expression representing maximum size of previous component
1299
1300          begin
1301             --  Case where previous field had a dynamic size
1302
1303             if Is_Dynamic_SO_Ref (Esize (Prev_Comp)) then
1304
1305                --  If the previous field had a dynamic length, then it is
1306                --  required to occupy an integral number of storage units,
1307                --  and start on a storage unit boundary. This means that
1308                --  the Normalized_First_Bit value is zero in the previous
1309                --  component, and the new value is also set to zero.
1310
1311                New_Fbit := Uint_0;
1312
1313                --  In this case, the new position is given by an expression
1314                --  that is the sum of old normalized position and old size.
1315
1316                New_Npos :=
1317                  SO_Ref_From_Expr
1318                    (Assoc_Add (Loc,
1319                       Left_Opnd  => Expr_From_SO_Ref (Loc, Old_Npos),
1320                       Right_Opnd => Expr_From_SO_Ref (Loc, Old_Esiz)),
1321                     Ins_Type => E,
1322                     Vtype    => E);
1323
1324                --  Get maximum size of previous component
1325
1326                if Size_Depends_On_Discriminant (Etype (Prev_Comp)) then
1327                   Old_Maxsz := Get_Max_Size (Etype (Prev_Comp));
1328                else
1329                   Old_Maxsz := Expr_From_SO_Ref (Loc, Old_Esiz);
1330                end if;
1331
1332                --  Now we can compute the new max position. If the max size
1333                --  is static and the old position is static, then we can
1334                --  compute the new position statically.
1335
1336                if Nkind (Old_Maxsz) = N_Integer_Literal
1337                  and then Known_Static_Normalized_Position_Max (Prev_Comp)
1338                then
1339                   New_NPMax := Old_NPMax + Intval (Old_Maxsz);
1340
1341                --  Otherwise new max position is dynamic
1342
1343                else
1344                   New_NPMax :=
1345                     SO_Ref_From_Expr
1346                       (Assoc_Add (Loc,
1347                          Left_Opnd  => Expr_From_SO_Ref (Loc, Old_NPMax),
1348                          Right_Opnd => Old_Maxsz),
1349                        Ins_Type => E,
1350                        Vtype    => E);
1351                end if;
1352
1353             --  Previous field has known static Esize
1354
1355             else
1356                New_Fbit := Old_Fbit + Old_Esiz;
1357
1358                --  Bump New_Fbit to storage unit boundary if required
1359
1360                if New_Fbit /= 0 and then Force_SU then
1361                   New_Fbit := (New_Fbit + SSU - 1) / SSU * SSU;
1362                end if;
1363
1364                --  If old normalized position is static, we can go ahead
1365                --  and compute the new normalized position directly.
1366
1367                if Known_Static_Normalized_Position (Prev_Comp) then
1368                   New_Npos := Old_Npos;
1369
1370                   if New_Fbit >= SSU then
1371                      New_Npos := New_Npos + New_Fbit / SSU;
1372                      New_Fbit := New_Fbit mod SSU;
1373                   end if;
1374
1375                   --  Bump alignment if stricter than prev
1376
1377                   if Align > Alignment (Prev_Comp) then
1378                      New_Npos := (New_Npos + Align - 1) / Align * Align;
1379                   end if;
1380
1381                   --  The max position is always equal to the position if
1382                   --  the latter is static, since arrays depending on the
1383                   --  values of discriminants never have static sizes.
1384
1385                   New_NPMax := New_Npos;
1386                   return;
1387
1388                --  Case of old normalized position is dynamic
1389
1390                else
1391                   --  If new bit position is within the current storage unit,
1392                   --  we can just copy the old position as the result position
1393                   --  (we have already set the new first bit value).
1394
1395                   if New_Fbit < SSU then
1396                      New_Npos  := Old_Npos;
1397                      New_NPMax := Old_NPMax;
1398
1399                   --  If new bit position is past the current storage unit, we
1400                   --  need to generate a new dynamic value for the position
1401                   --  ??? need to deal with alignment
1402
1403                   else
1404                      New_Npos :=
1405                        SO_Ref_From_Expr
1406                          (Assoc_Add (Loc,
1407                             Left_Opnd  => Expr_From_SO_Ref (Loc, Old_Npos),
1408                             Right_Opnd =>
1409                               Make_Integer_Literal (Loc,
1410                                 Intval => New_Fbit / SSU)),
1411                           Ins_Type => E,
1412                           Vtype    => E);
1413
1414                      New_NPMax :=
1415                        SO_Ref_From_Expr
1416                          (Assoc_Add (Loc,
1417                             Left_Opnd  => Expr_From_SO_Ref (Loc, Old_NPMax),
1418                             Right_Opnd =>
1419                               Make_Integer_Literal (Loc,
1420                                 Intval => New_Fbit / SSU)),
1421                             Ins_Type => E,
1422                             Vtype    => E);
1423                      New_Fbit := New_Fbit mod SSU;
1424                   end if;
1425                end if;
1426             end if;
1427          end;
1428       end Get_Next_Component_Location;
1429
1430       ----------------------
1431       -- Layout_Component --
1432       ----------------------
1433
1434       procedure Layout_Component (Comp : Entity_Id; Prev_Comp : Entity_Id) is
1435          Ctyp  : constant Entity_Id := Etype (Comp);
1436          Npos  : SO_Ref;
1437          Fbit  : SO_Ref;
1438          NPMax : SO_Ref;
1439          Forc  : Boolean;
1440
1441       begin
1442          --  Parent field is always at start of record, this will overlap
1443          --  the actual fields that are part of the parent, and that's fine
1444
1445          if Chars (Comp) = Name_uParent then
1446             Set_Normalized_Position     (Comp, Uint_0);
1447             Set_Normalized_First_Bit    (Comp, Uint_0);
1448             Set_Normalized_Position_Max (Comp, Uint_0);
1449             Set_Component_Bit_Offset    (Comp, Uint_0);
1450             Set_Esize                   (Comp, Esize (Ctyp));
1451             return;
1452          end if;
1453
1454          --  Check case of type of component has a scope of the record we
1455          --  are laying out. When this happens, the type in question is an
1456          --  Itype that has not yet been layed out (that's because such
1457          --  types do not get frozen in the normal manner, because there
1458          --  is no place for the freeze nodes).
1459
1460          if Scope (Ctyp) = E then
1461             Layout_Type (Ctyp);
1462          end if;
1463
1464          --  Increase alignment of record if necessary. Note that we do not
1465          --  do this for packed records, which have an alignment of one by
1466          --  default, or for records for which an explicit alignment was
1467          --  specified with an alignment clause.
1468
1469          if not Is_Packed (E)
1470            and then not Has_Alignment_Clause (E)
1471            and then Alignment (Ctyp) > Alignment (E)
1472          then
1473             Set_Alignment (E, Alignment (Ctyp));
1474          end if;
1475
1476          --  If component already laid out, then we are done
1477
1478          if Known_Normalized_Position (Comp) then
1479             return;
1480          end if;
1481
1482          --  Set size of component from type. We use the Esize except in a
1483          --  packed record, where we use the RM_Size (since that is exactly
1484          --  what the RM_Size value, as distinct from the Object_Size is
1485          --  useful for!)
1486
1487          if Is_Packed (E) then
1488             Set_Esize (Comp, RM_Size (Ctyp));
1489          else
1490             Set_Esize (Comp, Esize (Ctyp));
1491          end if;
1492
1493          --  Compute the component position from the previous one. See if
1494          --  current component requires being on a storage unit boundary.
1495
1496          --  If record is not packed, we always go to a storage unit boundary
1497
1498          if not Is_Packed (E) then
1499             Forc := True;
1500
1501          --  Packed cases
1502
1503          else
1504             --  Elementary types do not need SU boundary in packed record
1505
1506             if Is_Elementary_Type (Ctyp) then
1507                Forc := False;
1508
1509             --  Packed array types with a modular packed array type do not
1510             --  force a storage unit boundary (since the code generation
1511             --  treats these as equivalent to the underlying modular type),
1512
1513             elsif Is_Array_Type (Ctyp)
1514               and then Is_Bit_Packed_Array (Ctyp)
1515               and then Is_Modular_Integer_Type (Packed_Array_Type (Ctyp))
1516             then
1517                Forc := False;
1518
1519             --  Record types with known length less than or equal to the length
1520             --  of long long integer can also be unaligned, since they can be
1521             --  treated as scalars.
1522
1523             elsif Is_Record_Type (Ctyp)
1524               and then not Is_Dynamic_SO_Ref (Esize (Ctyp))
1525               and then Esize (Ctyp) <= Esize (Standard_Long_Long_Integer)
1526             then
1527                Forc := False;
1528
1529             --  All other cases force a storage unit boundary, even when packed
1530
1531             else
1532                Forc := True;
1533             end if;
1534          end if;
1535
1536          --  Now get the next component location
1537
1538          Get_Next_Component_Location
1539            (Prev_Comp, Alignment (Ctyp), Npos, Fbit, NPMax, Forc);
1540          Set_Normalized_Position     (Comp, Npos);
1541          Set_Normalized_First_Bit    (Comp, Fbit);
1542          Set_Normalized_Position_Max (Comp, NPMax);
1543
1544          --  Set Component_Bit_Offset in the static case
1545
1546          if Known_Static_Normalized_Position (Comp)
1547            and then Known_Normalized_First_Bit (Comp)
1548          then
1549             Set_Component_Bit_Offset (Comp, SSU * Npos + Fbit);
1550          end if;
1551       end Layout_Component;
1552
1553       -----------------------
1554       -- Layout_Components --
1555       -----------------------
1556
1557       procedure Layout_Components
1558         (From   : Entity_Id;
1559          To     : Entity_Id;
1560          Esiz   : out SO_Ref;
1561          RM_Siz : out SO_Ref)
1562       is
1563          End_Npos  : SO_Ref;
1564          End_Fbit  : SO_Ref;
1565          End_NPMax : SO_Ref;
1566
1567       begin
1568          --  Only layout components if there are some to layout!
1569
1570          if Present (From) then
1571
1572             --  Layout components with no component clauses
1573
1574             Comp := From;
1575             loop
1576                if (Ekind (Comp) = E_Component
1577                     or else Ekind (Comp) = E_Discriminant)
1578                  and then No (Component_Clause (Comp))
1579                then
1580                   Layout_Component (Comp, Prev_Comp);
1581                   Prev_Comp := Comp;
1582                end if;
1583
1584                exit when Comp = To;
1585                Next_Entity (Comp);
1586             end loop;
1587          end if;
1588
1589          --  Set size fields, both are zero if no components
1590
1591          if No (Prev_Comp) then
1592             Esiz := Uint_0;
1593             RM_Siz := Uint_0;
1594
1595          else
1596             --  First the object size, for which we align past the last
1597             --  field to the alignment of the record (the object size
1598             --  is required to be a multiple of the alignment).
1599
1600             Get_Next_Component_Location
1601               (Prev_Comp,
1602                Alignment (E),
1603                End_Npos,
1604                End_Fbit,
1605                End_NPMax,
1606                Force_SU => True);
1607
1608             --  If the resulting normalized position is a dynamic reference,
1609             --  then the size is dynamic, and is stored in storage units.
1610             --  In this case, we set the RM_Size to the same value, it is
1611             --  simply not worth distinguishing Esize and RM_Size values in
1612             --  the dynamic case, since the RM has nothing to say about them.
1613
1614             --  Note that a size cannot have been given in this case, since
1615             --  size specifications cannot be given for variable length types.
1616
1617             declare
1618                Align : constant Uint := Alignment (E);
1619
1620             begin
1621                if Is_Dynamic_SO_Ref (End_Npos) then
1622                   RM_Siz := End_Npos;
1623
1624                   --  Set the Object_Size allowing for alignment. In the
1625                   --  dynamic case, we have to actually do the runtime
1626                   --  computation. We can skip this in the non-packed
1627                   --  record case if the last component has a smaller
1628                   --  alignment than the overall record alignment.
1629
1630                   if Is_Dynamic_SO_Ref (End_NPMax) then
1631                      Esiz := End_NPMax;
1632
1633                      if Is_Packed (E)
1634                        or else Alignment (Prev_Comp) < Align
1635                      then
1636                         --  The expression we build is
1637                         --  (expr + align - 1) / align * align
1638
1639                         Esiz :=
1640                           SO_Ref_From_Expr
1641                             (Expr =>
1642                                Make_Op_Multiply (Loc,
1643                                  Left_Opnd =>
1644                                    Make_Op_Divide (Loc,
1645                                      Left_Opnd =>
1646                                        Make_Op_Add (Loc,
1647                                          Left_Opnd =>
1648                                            Expr_From_SO_Ref (Loc, Esiz),
1649                                          Right_Opnd =>
1650                                            Make_Integer_Literal (Loc,
1651                                              Intval => Align - 1)),
1652                                      Right_Opnd =>
1653                                        Make_Integer_Literal (Loc, Align)),
1654                                  Right_Opnd =>
1655                                    Make_Integer_Literal (Loc, Align)),
1656                             Ins_Type => E,
1657                             Vtype    => E);
1658                      end if;
1659
1660                   --  Here Esiz is static, so we can adjust the alignment
1661                   --  directly go give the required aligned value.
1662
1663                   else
1664                      Esiz := (End_NPMax + Align - 1) / Align * Align * SSU;
1665                   end if;
1666
1667                --  Case where computed size is static
1668
1669                else
1670                   --  The ending size was computed in Npos in storage units,
1671                   --  but the actual size is stored in bits, so adjust
1672                   --  accordingly. We also adjust the size to match the
1673                   --  alignment here.
1674
1675                   Esiz  := (End_NPMax + Align - 1) / Align * Align * SSU;
1676
1677                   --  Compute the resulting Value_Size (RM_Size). For this
1678                   --  purpose we do not force alignment of the record or
1679                   --  storage size alignment of the result.
1680
1681                   Get_Next_Component_Location
1682                     (Prev_Comp,
1683                      Uint_0,
1684                      End_Npos,
1685                      End_Fbit,
1686                      End_NPMax,
1687                      Force_SU => False);
1688
1689                   RM_Siz := End_Npos * SSU + End_Fbit;
1690                   Set_And_Check_Static_Size (E, Esiz, RM_Siz);
1691                end if;
1692             end;
1693          end if;
1694       end Layout_Components;
1695
1696       -------------------------------
1697       -- Layout_Non_Variant_Record --
1698       -------------------------------
1699
1700       procedure Layout_Non_Variant_Record is
1701          Esiz   : SO_Ref;
1702          RM_Siz : SO_Ref;
1703
1704       begin
1705          Layout_Components (First_Entity (E), Last_Entity (E), Esiz, RM_Siz);
1706          Set_Esize   (E, Esiz);
1707          Set_RM_Size (E, RM_Siz);
1708       end Layout_Non_Variant_Record;
1709
1710       ---------------------------
1711       -- Layout_Variant_Record --
1712       ---------------------------
1713
1714       procedure Layout_Variant_Record is
1715          Tdef   : constant Node_Id := Type_Definition (Decl);
1716          Dlist  : constant List_Id := Discriminant_Specifications (Decl);
1717          Esiz   : SO_Ref;
1718          RM_Siz : SO_Ref;
1719
1720          RM_Siz_Expr : Node_Id := Empty;
1721          --  Expression for the evolving RM_Siz value. This is typically a
1722          --  conditional expression which involves tests of discriminant
1723          --  values that are formed as references to the entity V. At
1724          --  the end of scanning all the components, a suitable function
1725          --  is constructed in which V is the parameter.
1726
1727          -----------------------
1728          -- Local Subprograms --
1729          -----------------------
1730
1731          procedure Layout_Component_List
1732            (Clist       : Node_Id;
1733             Esiz        : out SO_Ref;
1734             RM_Siz_Expr : out Node_Id);
1735          --  Recursive procedure, called to layout one component list
1736          --  Esiz and RM_Siz_Expr are set to the Object_Size and Value_Size
1737          --  values respectively representing the record size up to and
1738          --  including the last component in the component list (including
1739          --  any variants in this component list). RM_Siz_Expr is returned
1740          --  as an expression which may in the general case involve some
1741          --  references to the discriminants of the current record value,
1742          --  referenced by selecting from the entity V.
1743
1744          ---------------------------
1745          -- Layout_Component_List --
1746          ---------------------------
1747
1748          procedure Layout_Component_List
1749            (Clist       : Node_Id;
1750             Esiz        : out SO_Ref;
1751             RM_Siz_Expr : out Node_Id)
1752          is
1753             Citems  : constant List_Id := Component_Items (Clist);
1754             Vpart   : constant Node_Id := Variant_Part (Clist);
1755             Prv     : Node_Id;
1756             Var     : Node_Id;
1757             RM_Siz  : Uint;
1758             RMS_Ent : Entity_Id;
1759
1760          begin
1761             if Is_Non_Empty_List (Citems) then
1762                Layout_Components
1763                  (From   => Defining_Identifier (First (Citems)),
1764                   To     => Defining_Identifier (Last  (Citems)),
1765                   Esiz   => Esiz,
1766                   RM_Siz => RM_Siz);
1767             else
1768                Layout_Components (Empty, Empty, Esiz, RM_Siz);
1769             end if;
1770
1771             --  Case where no variants are present in the component list
1772
1773             if No (Vpart) then
1774
1775                --  The Esiz value has been correctly set by the call to
1776                --  Layout_Components, so there is nothing more to be done.
1777
1778                --  For RM_Siz, we have an SO_Ref value, which we must convert
1779                --  to an appropriate expression.
1780
1781                if Is_Static_SO_Ref (RM_Siz) then
1782                   RM_Siz_Expr :=
1783                     Make_Integer_Literal (Loc,
1784                       Intval => RM_Siz);
1785
1786                else
1787                   RMS_Ent := Get_Dynamic_SO_Entity (RM_Siz);
1788
1789                   --  If the size is represented by a function, then we
1790                   --  create an appropriate function call using V as
1791                   --  the parameter to the call.
1792
1793                   if Is_Discrim_SO_Function (RMS_Ent) then
1794                      RM_Siz_Expr :=
1795                        Make_Function_Call (Loc,
1796                          Name => New_Occurrence_Of (RMS_Ent, Loc),
1797                          Parameter_Associations => New_List (
1798                            Make_Identifier (Loc, Chars => Vname)));
1799
1800                   --  If the size is represented by a constant, then the
1801                   --  expression we want is a reference to this constant
1802
1803                   else
1804                      RM_Siz_Expr := New_Occurrence_Of (RMS_Ent, Loc);
1805                   end if;
1806                end if;
1807
1808             --  Case where variants are present in this component list
1809
1810             else
1811                declare
1812                   EsizV   : SO_Ref;
1813                   RM_SizV : Node_Id;
1814                   Dchoice : Node_Id;
1815                   Discrim : Node_Id;
1816                   Dtest   : Node_Id;
1817
1818                begin
1819                   RM_Siz_Expr := Empty;
1820                   Prv := Prev_Comp;
1821
1822                   Var := Last (Variants (Vpart));
1823                   while Present (Var) loop
1824                      Prev_Comp := Prv;
1825                      Layout_Component_List
1826                        (Component_List (Var), EsizV, RM_SizV);
1827
1828                      --  Set the Object_Size. If this is the first variant,
1829                      --  we just set the size of this first variant.
1830
1831                      if Var = Last (Variants (Vpart)) then
1832                         Esiz := EsizV;
1833
1834                      --  Otherwise the Object_Size is formed as a maximum
1835                      --  of Esiz so far from previous variants, and the new
1836                      --  Esiz value from the variant we just processed.
1837
1838                      --  If both values are static, we can just compute the
1839                      --  maximum directly to save building junk nodes.
1840
1841                      elsif not Is_Dynamic_SO_Ref (Esiz)
1842                        and then not Is_Dynamic_SO_Ref (EsizV)
1843                      then
1844                         Esiz := UI_Max (Esiz, EsizV);
1845
1846                      --  If either value is dynamic, then we have to generate
1847                      --  an appropriate Standard_Unsigned'Max attribute call.
1848
1849                      else
1850                         Esiz :=
1851                           SO_Ref_From_Expr
1852                             (Make_Attribute_Reference (Loc,
1853                                Attribute_Name => Name_Max,
1854                                Prefix         =>
1855                                  New_Occurrence_Of (Standard_Unsigned, Loc),
1856                                Expressions => New_List (
1857                                  Expr_From_SO_Ref (Loc, Esiz),
1858                                  Expr_From_SO_Ref (Loc, EsizV))),
1859                              Ins_Type => E,
1860                              Vtype    => E);
1861                      end if;
1862
1863                      --  Now deal with Value_Size (RM_Siz). We are aiming at
1864                      --  an expression that looks like:
1865
1866                      --    if      xxDx (V.disc) then rmsiz1
1867                      --    else if xxDx (V.disc) then rmsiz2
1868                      --    else ...
1869
1870                      --  Where rmsiz1, rmsiz2... are the RM_Siz values for the
1871                      --  individual variants, and xxDx are the discriminant
1872                      --  checking functions generated for the variant type.
1873
1874                      --  If this is the first variant, we simply set the
1875                      --  result as the expression. Note that this takes
1876                      --  care of the others case.
1877
1878                      if No (RM_Siz_Expr) then
1879                         RM_Siz_Expr := RM_SizV;
1880
1881                      --  Otherwise construct the appropriate test
1882
1883                      else
1884                         --  Discriminant to be tested
1885
1886                         Discrim :=
1887                           Make_Selected_Component (Loc,
1888                             Prefix        =>
1889                               Make_Identifier (Loc, Chars => Vname),
1890                             Selector_Name =>
1891                               New_Occurrence_Of
1892                                 (Entity (Name (Vpart)), Loc));
1893
1894                         --  The test to be used in general is a call to the
1895                         --  discriminant checking function. However, it is
1896                         --  definitely worth special casing the very common
1897                         --  case where a single value is involved.
1898
1899                         Dchoice := First (Discrete_Choices (Var));
1900
1901                         if No (Next (Dchoice))
1902                           and then Nkind (Dchoice) /= N_Range
1903                         then
1904                            Dtest :=
1905                              Make_Op_Eq (Loc,
1906                                Left_Opnd  => Discrim,
1907                                Right_Opnd => New_Copy (Dchoice));
1908
1909                         else
1910                            Dtest :=
1911                              Make_Function_Call (Loc,
1912                                Name =>
1913                                  New_Occurrence_Of
1914                                    (Dcheck_Function (Var), Loc),
1915                                Parameter_Associations => New_List (Discrim));
1916                         end if;
1917
1918                         RM_Siz_Expr :=
1919                           Make_Conditional_Expression (Loc,
1920                             Expressions =>
1921                               New_List (Dtest, RM_SizV, RM_Siz_Expr));
1922                      end if;
1923
1924                      Prev (Var);
1925                   end loop;
1926                end;
1927             end if;
1928          end Layout_Component_List;
1929
1930       --  Start of processing for Layout_Variant_Record
1931
1932       begin
1933          --  We need the discriminant checking functions, since we generate
1934          --  calls to these functions for the RM_Size expression, so make
1935          --  sure that these functions have been constructed in time.
1936
1937          Build_Discr_Checking_Funcs (Decl);
1938
1939          --  Layout the discriminants
1940
1941          Layout_Components
1942            (From   => Defining_Identifier (First (Dlist)),
1943             To     => Defining_Identifier (Last  (Dlist)),
1944             Esiz   => Esiz,
1945             RM_Siz => RM_Siz);
1946
1947          --  Layout the main component list (this will make recursive calls
1948          --  to layout all component lists nested within variants).
1949
1950          Layout_Component_List (Component_List (Tdef), Esiz, RM_Siz_Expr);
1951          Set_Esize   (E, Esiz);
1952
1953          --  If the RM_Size is a literal, set its value
1954
1955          if Nkind (RM_Siz_Expr) = N_Integer_Literal then
1956             Set_RM_Size (E, Intval (RM_Siz_Expr));
1957
1958          --  Otherwise we construct a dynamic SO_Ref
1959
1960          else
1961             Set_RM_Size (E,
1962               SO_Ref_From_Expr
1963                 (RM_Siz_Expr,
1964                  Ins_Type => E,
1965                  Vtype    => E));
1966          end if;
1967       end Layout_Variant_Record;
1968
1969    --  Start of processing for Layout_Record_Type
1970
1971    begin
1972       --  If this is a cloned subtype, just copy the size fields from the
1973       --  original, nothing else needs to be done in this case, since the
1974       --  components themselves are all shared.
1975
1976       if (Ekind (E) = E_Record_Subtype
1977            or else Ekind (E) = E_Class_Wide_Subtype)
1978         and then Present (Cloned_Subtype (E))
1979       then
1980          Set_Esize     (E, Esize     (Cloned_Subtype (E)));
1981          Set_RM_Size   (E, RM_Size   (Cloned_Subtype (E)));
1982          Set_Alignment (E, Alignment (Cloned_Subtype (E)));
1983
1984       --  Another special case, class-wide types. The RM says that the size
1985       --  of such types is implementation defined (RM 13.3(48)). What we do
1986       --  here is to leave the fields set as unknown values, and the backend
1987       --  determines the actual behavior.
1988
1989       elsif Ekind (E) = E_Class_Wide_Type then
1990          null;
1991
1992       --  All other cases
1993
1994       else
1995          --  Initialize aligment conservatively to 1. This value will
1996          --  be increased as necessary during processing of the record.
1997
1998          if Unknown_Alignment (E) then
1999             Set_Alignment (E, Uint_1);
2000          end if;
2001
2002          --  Initialize previous component. This is Empty unless there
2003          --  are components which have already been laid out by component
2004          --  clauses. If there are such components, we start our layout of
2005          --  the remaining components following the last such component
2006
2007          Prev_Comp := Empty;
2008
2009          Comp := First_Entity (E);
2010          while Present (Comp) loop
2011             if (Ekind (Comp) = E_Component
2012                  or else Ekind (Comp) = E_Discriminant)
2013               and then Present (Component_Clause (Comp))
2014             then
2015                if No (Prev_Comp)
2016                  or else
2017                    Component_Bit_Offset (Comp) >
2018                    Component_Bit_Offset (Prev_Comp)
2019                then
2020                   Prev_Comp := Comp;
2021                end if;
2022             end if;
2023
2024             Next_Entity (Comp);
2025          end loop;
2026
2027          --  We have two separate circuits, one for non-variant records and
2028          --  one for variant records. For non-variant records, we simply go
2029          --  through the list of components. This handles all the non-variant
2030          --  cases including those cases of subtypes where there is no full
2031          --  type declaration, so the tree cannot be used to drive the layout.
2032          --  For variant records, we have to drive the layout from the tree
2033          --  since we need to understand the variant structure in this case.
2034
2035          if Present (Full_View (E)) then
2036             Decl := Declaration_Node (Full_View (E));
2037          else
2038             Decl := Declaration_Node (E);
2039          end if;
2040
2041          --  Scan all the components
2042
2043          if Nkind (Decl) = N_Full_Type_Declaration
2044            and then Has_Discriminants (E)
2045            and then Nkind (Type_Definition (Decl)) = N_Record_Definition
2046            and then
2047              Present (Variant_Part (Component_List (Type_Definition (Decl))))
2048          then
2049             Layout_Variant_Record;
2050          else
2051             Layout_Non_Variant_Record;
2052          end if;
2053       end if;
2054    end Layout_Record_Type;
2055
2056    -----------------
2057    -- Layout_Type --
2058    -----------------
2059
2060    procedure Layout_Type (E : Entity_Id) is
2061    begin
2062       --  For string literal types, for now, kill the size always, this
2063       --  is because gigi does not like or need the size to be set ???
2064
2065       if Ekind (E) = E_String_Literal_Subtype then
2066          Set_Esize (E, Uint_0);
2067          Set_RM_Size (E, Uint_0);
2068          return;
2069       end if;
2070
2071       --  For access types, set size/alignment. This is system address
2072       --  size, except for fat pointers (unconstrained array access types),
2073       --  where the size is two times the address size, to accommodate the
2074       --  two pointers that are required for a fat pointer (data and
2075       --  template). Note that E_Access_Protected_Subprogram_Type is not
2076       --  an access type for this purpose since it is not a pointer but is
2077       --  equivalent to a record. For access subtypes, copy the size from
2078       --  the base type since Gigi represents them the same way.
2079
2080       if Is_Access_Type (E) then
2081
2082          --  If Esize already set (e.g. by a size clause), then nothing
2083          --  further to be done here.
2084
2085          if Known_Esize (E) then
2086             null;
2087
2088          --  Access to subprogram is a strange beast, and we let the
2089          --  backend figure out what is needed (it may be some kind
2090          --  of fat pointer, including the static link for example.
2091
2092          elsif Ekind (E) = E_Access_Protected_Subprogram_Type then
2093             null;
2094
2095          --  For access subtypes, copy the size information from base type
2096
2097          elsif Ekind (E) = E_Access_Subtype then
2098             Set_Size_Info (E, Base_Type (E));
2099             Set_RM_Size   (E, RM_Size (Base_Type (E)));
2100
2101          --  For other access types, we use either address size, or, if
2102          --  a fat pointer is used (pointer-to-unconstrained array case),
2103          --  twice the address size to accommodate a fat pointer.
2104
2105          else
2106             declare
2107                Desig : Entity_Id := Designated_Type (E);
2108
2109             begin
2110                if Is_Private_Type (Desig)
2111                  and then Present (Full_View (Desig))
2112                then
2113                   Desig := Full_View (Desig);
2114                end if;
2115
2116                if (Is_Array_Type (Desig)
2117                  and then not Is_Constrained (Desig)
2118                  and then not Has_Completion_In_Body (Desig)
2119                  and then not Debug_Flag_6)
2120                then
2121                   Init_Size (E, 2 * System_Address_Size);
2122
2123                   --  Check for bad convention set
2124
2125                   if Convention (E) = Convention_C
2126                        or else
2127                      Convention (E) = Convention_CPP
2128                   then
2129                      Error_Msg_N
2130                        ("?this access type does not " &
2131                         "correspond to C pointer", E);
2132                   end if;
2133
2134                else
2135                   Init_Size (E, System_Address_Size);
2136                end if;
2137             end;
2138          end if;
2139
2140          Set_Prim_Alignment (E);
2141
2142       --  Scalar types: set size and alignment
2143
2144       elsif Is_Scalar_Type (E) then
2145
2146          --  For discrete types, the RM_Size and Esize must be set
2147          --  already, since this is part of the earlier processing
2148          --  and the front end is always required to layout the
2149          --  sizes of such types (since they are available as static
2150          --  attributes). All we do is to check that this rule is
2151          --  indeed obeyed!
2152
2153          if Is_Discrete_Type (E) then
2154
2155             --  If the RM_Size is not set, then here is where we set it.
2156
2157             --  Note: an RM_Size of zero looks like not set here, but this
2158             --  is a rare case, and we can simply reset it without any harm.
2159
2160             if not Known_RM_Size (E) then
2161                Set_Discrete_RM_Size (E);
2162             end if;
2163
2164             --  If Esize for a discrete type is not set then set it
2165
2166             if not Known_Esize (E) then
2167                declare
2168                   S : Int := 8;
2169
2170                begin
2171                   loop
2172                      --  If size is big enough, set it and exit
2173
2174                      if S >= RM_Size (E) then
2175                         Init_Esize (E, S);
2176                         exit;
2177
2178                      --  If the RM_Size is greater than 64 (happens only
2179                      --  when strange values are specified by the user,
2180                      --  then Esize is simply a copy of RM_Size, it will
2181                      --  be further refined later on)
2182
2183                      elsif S = 64 then
2184                         Set_Esize (E, RM_Size (E));
2185                         exit;
2186
2187                      --  Otherwise double possible size and keep trying
2188
2189                      else
2190                         S := S * 2;
2191                      end if;
2192                   end loop;
2193                end;
2194             end if;
2195
2196          --  For non-discrete sclar types, if the RM_Size is not set,
2197          --  then set it now to a copy of the Esize if the Esize is set.
2198
2199          else
2200             if Known_Esize (E) and then Unknown_RM_Size (E) then
2201                Set_RM_Size (E, Esize (E));
2202             end if;
2203          end if;
2204
2205          Set_Prim_Alignment (E);
2206
2207       --  Non-primitive types
2208
2209       else
2210          --  If RM_Size is known, set Esize if not known
2211
2212          if Known_RM_Size (E) and then Unknown_Esize (E) then
2213
2214             --  If the alignment is known, we bump the Esize up to the
2215             --  next alignment boundary if it is not already on one.
2216
2217             if Known_Alignment (E) then
2218                declare
2219                   A : constant Uint   := Alignment_In_Bits (E);
2220                   S : constant SO_Ref := RM_Size (E);
2221
2222                begin
2223                   Set_Esize (E, (S * A + A - 1) / A);
2224                end;
2225             end if;
2226
2227          --  If Esize is set, and RM_Size is not, RM_Size is copied from
2228          --  Esize at least for now this seems reasonable, and is in any
2229          --  case needed for compatibility with old versions of gigi.
2230          --  look to be unknown.
2231
2232          elsif Known_Esize (E) and then Unknown_RM_Size (E) then
2233             Set_RM_Size (E, Esize (E));
2234          end if;
2235
2236          --  For array base types, set component size if object size of
2237          --  the component type is known and is a small power of 2 (8,
2238          --  16, 32, 64), since this is what will always be used.
2239
2240          if Ekind (E) = E_Array_Type
2241            and then Unknown_Component_Size (E)
2242          then
2243             declare
2244                CT : constant Entity_Id := Component_Type (E);
2245
2246             begin
2247                --  For some reasons, access types can cause trouble,
2248                --  So let's just do this for discrete types ???
2249
2250                if Present (CT)
2251                  and then Is_Discrete_Type (CT)
2252                  and then Known_Static_Esize (CT)
2253                then
2254                   declare
2255                      S : constant Uint := Esize (CT);
2256
2257                   begin
2258                      if S = 8  or else
2259                         S = 16 or else
2260                         S = 32 or else
2261                         S = 64
2262                      then
2263                         Set_Component_Size (E, Esize (CT));
2264                      end if;
2265                   end;
2266                end if;
2267             end;
2268          end if;
2269       end if;
2270
2271       --  Layout array and record types if front end layout set
2272
2273       if Frontend_Layout_On_Target then
2274          if Is_Array_Type (E) and then not Is_Bit_Packed_Array (E) then
2275             Layout_Array_Type (E);
2276             return;
2277          elsif Is_Record_Type (E) then
2278             Layout_Record_Type (E);
2279             return;
2280          end if;
2281
2282       --  Special remaining processing for record types with a known size
2283       --  of 16, 32, or 64 bits whose alignment is not yet set. For these
2284       --  types, we set a corresponding alignment matching the size if
2285       --  possible, or as large as possible if not.
2286
2287       elsif Is_Record_Type (E) and not Debug_Flag_Q then
2288          Set_Composite_Alignment (E);
2289
2290       --  For arrays, we only do this processing for arrays that are
2291       --  required to be atomic. Here, we really need to have proper
2292       --  alignment, but for the normal case of non-atomic arrays it
2293       --  seems better to use the component alignment as the default.
2294
2295       elsif Is_Array_Type (E)
2296         and then Is_Atomic (E)
2297         and then not Debug_Flag_Q
2298       then
2299          Set_Composite_Alignment (E);
2300       end if;
2301    end Layout_Type;
2302
2303    ---------------------
2304    -- Rewrite_Integer --
2305    ---------------------
2306
2307    procedure Rewrite_Integer (N : Node_Id; V : Uint) is
2308       Loc : constant Source_Ptr := Sloc (N);
2309       Typ : constant Entity_Id  := Etype (N);
2310
2311    begin
2312       Rewrite (N, Make_Integer_Literal (Loc, Intval => V));
2313       Set_Etype (N, Typ);
2314    end Rewrite_Integer;
2315
2316    -------------------------------
2317    -- Set_And_Check_Static_Size --
2318    -------------------------------
2319
2320    procedure Set_And_Check_Static_Size
2321      (E      : Entity_Id;
2322       Esiz   : SO_Ref;
2323       RM_Siz : SO_Ref)
2324    is
2325       SC : Node_Id;
2326
2327       procedure Check_Size_Too_Small (Spec : Uint; Min : Uint);
2328       --  Spec is the number of bit specified in the size clause, and
2329       --  Min is the minimum computed size. An error is given that the
2330       --  specified size is too small if Spec < Min, and in this case
2331       --  both Esize and RM_Size are set to unknown in E. The error
2332       --  message is posted on node SC.
2333
2334       procedure Check_Unused_Bits (Spec : Uint; Max : Uint);
2335       --  Spec is the number of bits specified in the size clause, and
2336       --  Max is the maximum computed size. A warning is given about
2337       --  unused bits if Spec > Max. This warning is posted on node SC.
2338
2339       --------------------------
2340       -- Check_Size_Too_Small --
2341       --------------------------
2342
2343       procedure Check_Size_Too_Small (Spec : Uint; Min : Uint) is
2344       begin
2345          if Spec < Min then
2346             Error_Msg_Uint_1 := Min;
2347             Error_Msg_NE
2348               ("size for & too small, minimum allowed is ^", SC, E);
2349             Init_Esize   (E);
2350             Init_RM_Size (E);
2351          end if;
2352       end Check_Size_Too_Small;
2353
2354       -----------------------
2355       -- Check_Unused_Bits --
2356       -----------------------
2357
2358       procedure Check_Unused_Bits (Spec : Uint; Max : Uint) is
2359       begin
2360          if Spec > Max then
2361             Error_Msg_Uint_1 := Spec - Max;
2362             Error_Msg_NE ("?^ bits of & unused", SC, E);
2363          end if;
2364       end Check_Unused_Bits;
2365
2366    --  Start of processing for Set_And_Check_Static_Size
2367
2368    begin
2369       --  Case where Object_Size (Esize) is already set by a size clause
2370
2371       if Known_Static_Esize (E) then
2372          SC := Size_Clause (E);
2373
2374          if No (SC) then
2375             SC := Get_Attribute_Definition_Clause (E, Attribute_Object_Size);
2376          end if;
2377
2378          --  Perform checks on specified size against computed sizes
2379
2380          if Present (SC) then
2381             Check_Unused_Bits    (Esize (E), Esiz);
2382             Check_Size_Too_Small (Esize (E), RM_Siz);
2383          end if;
2384       end if;
2385
2386       --  Case where Value_Size (RM_Size) is set by specific Value_Size
2387       --  clause (we do not need to worry about Value_Size being set by
2388       --  a Size clause, since that will have set Esize as well, and we
2389       --  already took care of that case).
2390
2391       if Known_Static_RM_Size (E) then
2392          SC := Get_Attribute_Definition_Clause (E, Attribute_Value_Size);
2393
2394          --  Perform checks on specified size against computed sizes
2395
2396          if Present (SC) then
2397             Check_Unused_Bits    (RM_Size (E), Esiz);
2398             Check_Size_Too_Small (RM_Size (E), RM_Siz);
2399          end if;
2400       end if;
2401
2402       --  Set sizes if unknown
2403
2404       if Unknown_Esize (E) then
2405          Set_Esize (E, Esiz);
2406       end if;
2407
2408       if Unknown_RM_Size (E) then
2409          Set_RM_Size (E, RM_Siz);
2410       end if;
2411    end Set_And_Check_Static_Size;
2412
2413    -----------------------------
2414    -- Set_Composite_Alignment --
2415    -----------------------------
2416
2417    procedure Set_Composite_Alignment (E : Entity_Id) is
2418       Siz   : Uint;
2419       Align : Nat;
2420
2421    begin
2422       if Unknown_Alignment (E) then
2423          if Known_Static_Esize (E) then
2424             Siz := Esize (E);
2425
2426          elsif Unknown_Esize (E)
2427            and then Known_Static_RM_Size (E)
2428          then
2429             Siz := RM_Size (E);
2430
2431          else
2432             return;
2433          end if;
2434
2435          --  Size is known, alignment is not set
2436
2437          if Siz = System_Storage_Unit then
2438             Align := 1;
2439          elsif Siz = 2 * System_Storage_Unit then
2440             Align := 2;
2441          elsif Siz = 4 * System_Storage_Unit then
2442             Align := 4;
2443          elsif Siz = 8 * System_Storage_Unit then
2444             Align := 8;
2445          else
2446             return;
2447          end if;
2448
2449          if Align > Maximum_Alignment then
2450             Align := Maximum_Alignment;
2451          end if;
2452
2453          if Align > System_Word_Size / System_Storage_Unit then
2454             Align := System_Word_Size / System_Storage_Unit;
2455          end if;
2456
2457          Set_Alignment (E, UI_From_Int (Align));
2458
2459          if Unknown_Esize (E) then
2460             Set_Esize (E, UI_From_Int (Align * System_Storage_Unit));
2461          end if;
2462       end if;
2463    end Set_Composite_Alignment;
2464
2465    --------------------------
2466    -- Set_Discrete_RM_Size --
2467    --------------------------
2468
2469    procedure Set_Discrete_RM_Size (Def_Id : Entity_Id) is
2470       FST : constant Entity_Id := First_Subtype (Def_Id);
2471
2472    begin
2473       --  All discrete types except for the base types in standard
2474       --  are constrained, so indicate this by setting Is_Constrained.
2475
2476       Set_Is_Constrained (Def_Id);
2477
2478       --  We set generic types to have an unknown size, since the
2479       --  representation of a generic type is irrelevant, in view
2480       --  of the fact that they have nothing to do with code.
2481
2482       if Is_Generic_Type (Root_Type (FST)) then
2483          Set_RM_Size (Def_Id, Uint_0);
2484
2485       --  If the subtype statically matches the first subtype, then
2486       --  it is required to have exactly the same layout. This is
2487       --  required by aliasing considerations.
2488
2489       elsif Def_Id /= FST and then
2490         Subtypes_Statically_Match (Def_Id, FST)
2491       then
2492          Set_RM_Size   (Def_Id, RM_Size (FST));
2493          Set_Size_Info (Def_Id, FST);
2494
2495       --  In all other cases the RM_Size is set to the minimum size.
2496       --  Note that this routine is never called for subtypes for which
2497       --  the RM_Size is set explicitly by an attribute clause.
2498
2499       else
2500          Set_RM_Size (Def_Id, UI_From_Int (Minimum_Size (Def_Id)));
2501       end if;
2502    end Set_Discrete_RM_Size;
2503
2504    ------------------------
2505    -- Set_Prim_Alignment --
2506    ------------------------
2507
2508    procedure Set_Prim_Alignment (E : Entity_Id) is
2509    begin
2510       --  Do not set alignment for packed array types, unless we are doing
2511       --  front end layout, because otherwise this is always handled in the
2512       --  backend.
2513
2514       if Is_Packed_Array_Type (E) and then not Frontend_Layout_On_Target then
2515          return;
2516
2517       --  If there is an alignment clause, then we respect it
2518
2519       elsif Has_Alignment_Clause (E) then
2520          return;
2521
2522       --  If the size is not set, then don't attempt to set the alignment. This
2523       --  happens in the backend layout case for access to subprogram types.
2524
2525       elsif not Known_Static_Esize (E) then
2526          return;
2527
2528       --  For access types, do not set the alignment if the size is less than
2529       --  the allowed minimum size. This avoids cascaded error messages.
2530
2531       elsif Is_Access_Type (E)
2532         and then Esize (E) < System_Address_Size
2533       then
2534          return;
2535       end if;
2536
2537       --  Here we calculate the alignment as the largest power of two
2538       --  multiple of System.Storage_Unit that does not exceed either
2539       --  the actual size of the type, or the maximum allowed alignment.
2540
2541       declare
2542          S : constant Int :=
2543                UI_To_Int (Esize (E)) / SSU;
2544          A : Nat;
2545
2546       begin
2547          A := 1;
2548          while 2 * A <= Ttypes.Maximum_Alignment
2549             and then 2 * A <= S
2550          loop
2551             A := 2 * A;
2552          end loop;
2553
2554          --  Now we think we should set the alignment to A, but we
2555          --  skip this if an alignment is already set to a value
2556          --  greater than A (happens for derived types).
2557
2558          --  However, if the alignment is known and too small it
2559          --  must be increased, this happens in a case like:
2560
2561          --     type R is new Character;
2562          --     for R'Size use 16;
2563
2564          --  Here the alignment inherited from Character is 1, but
2565          --  it must be increased to 2 to reflect the increased size.
2566
2567          if Unknown_Alignment (E) or else Alignment (E) < A then
2568             Init_Alignment (E, A);
2569          end if;
2570       end;
2571    end Set_Prim_Alignment;
2572
2573    ----------------------
2574    -- SO_Ref_From_Expr --
2575    ----------------------
2576
2577    function SO_Ref_From_Expr
2578      (Expr      : Node_Id;
2579       Ins_Type  : Entity_Id;
2580       Vtype     : Entity_Id := Empty)
2581       return    Dynamic_SO_Ref
2582    is
2583       Loc  : constant Source_Ptr := Sloc (Ins_Type);
2584
2585       K : constant Entity_Id :=
2586             Make_Defining_Identifier (Loc,
2587               Chars => New_Internal_Name ('K'));
2588
2589       Decl : Node_Id;
2590
2591       function Check_Node_V_Ref (N : Node_Id) return Traverse_Result;
2592       --  Function used to check one node for reference to V
2593
2594       function Has_V_Ref is new Traverse_Func (Check_Node_V_Ref);
2595       --  Function used to traverse tree to check for reference to V
2596
2597       ----------------------
2598       -- Check_Node_V_Ref --
2599       ----------------------
2600
2601       function Check_Node_V_Ref (N : Node_Id) return Traverse_Result is
2602       begin
2603          if Nkind (N) = N_Identifier then
2604             if Chars (N) = Vname then
2605                return Abandon;
2606             else
2607                return Skip;
2608             end if;
2609
2610          else
2611             return OK;
2612          end if;
2613       end Check_Node_V_Ref;
2614
2615    --  Start of processing for SO_Ref_From_Expr
2616
2617    begin
2618       --  Case of expression is an integer literal, in this case we just
2619       --  return the value (which must always be non-negative, since size
2620       --  and offset values can never be negative).
2621
2622       if Nkind (Expr) = N_Integer_Literal then
2623          pragma Assert (Intval (Expr) >= 0);
2624          return Intval (Expr);
2625       end if;
2626
2627       --  Case where there is a reference to V, create function
2628
2629       if Has_V_Ref (Expr) = Abandon then
2630
2631          pragma Assert (Present (Vtype));
2632          Set_Is_Discrim_SO_Function (K);
2633
2634          Decl :=
2635            Make_Subprogram_Body (Loc,
2636
2637              Specification =>
2638                Make_Function_Specification (Loc,
2639                  Defining_Unit_Name => K,
2640                    Parameter_Specifications => New_List (
2641                      Make_Parameter_Specification (Loc,
2642                        Defining_Identifier =>
2643                          Make_Defining_Identifier (Loc, Chars => Vname),
2644                        Parameter_Type      =>
2645                          New_Occurrence_Of (Vtype, Loc))),
2646                    Subtype_Mark =>
2647                      New_Occurrence_Of (Standard_Unsigned, Loc)),
2648
2649              Declarations => Empty_List,
2650
2651              Handled_Statement_Sequence =>
2652                Make_Handled_Sequence_Of_Statements (Loc,
2653                  Statements => New_List (
2654                    Make_Return_Statement (Loc,
2655                      Expression => Expr))));
2656
2657       --  No reference to V, create constant
2658
2659       else
2660          Decl :=
2661            Make_Object_Declaration (Loc,
2662              Defining_Identifier => K,
2663              Object_Definition   =>
2664                New_Occurrence_Of (Standard_Unsigned, Loc),
2665              Constant_Present    => True,
2666              Expression          => Expr);
2667       end if;
2668
2669       Append_Freeze_Action (Ins_Type, Decl);
2670       Analyze (Decl);
2671       return Create_Dynamic_SO_Ref (K);
2672    end SO_Ref_From_Expr;
2673
2674 end Layout;