OpenCores
URL https://opencores.org/ocsvn/openrisc_2011-10-31/openrisc_2011-10-31/trunk

Subversion Repositories openrisc_2011-10-31

[/] [openrisc/] [trunk/] [gnu-src/] [gcc-4.5.1/] [gcc/] [ada/] [layout.adb] - Blame information for rev 454

Go to most recent revision | Details | Compare with Previous | View Log

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

powered by: WebSVN 2.1.0

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