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