gcc/ada/layout.adb

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