OpenCores
URL https://opencores.org/ocsvn/openrisc/openrisc/trunk

Subversion Repositories openrisc

[/] [openrisc/] [trunk/] [gnu-dev/] [or1k-gcc/] [gcc/] [ada/] [layout.adb] - Blame information for rev 706

Details | Compare with Previous | View Log

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

powered by: WebSVN 2.1.0

© copyright 1999-2024 OpenCores.org, equivalent to Oliscience, all rights reserved. OpenCores®, registered trademark.