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