Add initial version of C++17 <memory_resource> header
[official-gcc.git] / gcc / ada / layout.adb
blob6b77757b9b22f712446195e739b67aaf0abad7a0
1 ------------------------------------------------------------------------------
2 -- --
3 -- GNAT COMPILER COMPONENTS --
4 -- --
5 -- L A Y O U T --
6 -- --
7 -- B o d y --
8 -- --
9 -- Copyright (C) 2001-2018, 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 ------------------------------------------------------------------------------
26 with Atree; use Atree;
27 with Debug; use Debug;
28 with Einfo; use Einfo;
29 with Errout; use Errout;
30 with Opt; use Opt;
31 with Sem_Aux; use Sem_Aux;
32 with Sem_Ch13; use Sem_Ch13;
33 with Sem_Eval; use Sem_Eval;
34 with Sem_Util; use Sem_Util;
35 with Sinfo; use Sinfo;
36 with Snames; use Snames;
37 with Ttypes; use Ttypes;
38 with Uintp; use Uintp;
40 package body Layout is
42 ------------------------
43 -- Local Declarations --
44 ------------------------
46 SSU : constant Int := Ttypes.System_Storage_Unit;
47 -- Short hand for System_Storage_Unit
49 -----------------------
50 -- Local Subprograms --
51 -----------------------
53 procedure Compute_Size_Depends_On_Discriminant (E : Entity_Id);
54 -- Given an array type or an array subtype E, compute whether its size
55 -- depends on the value of one or more discriminants and set the flag
56 -- Size_Depends_On_Discriminant accordingly. This need not be called
57 -- in front end layout mode since it does the computation on its own.
59 procedure Set_Composite_Alignment (E : Entity_Id);
60 -- This procedure is called for record types and subtypes, and also for
61 -- atomic array types and subtypes. If no alignment is set, and the size
62 -- is 2 or 4 (or 8 if the word size is 8), then the alignment is set to
63 -- match the size.
65 ----------------------------
66 -- Adjust_Esize_Alignment --
67 ----------------------------
69 procedure Adjust_Esize_Alignment (E : Entity_Id) is
70 Abits : Int;
71 Esize_Set : Boolean;
73 begin
74 -- Nothing to do if size unknown
76 if Unknown_Esize (E) then
77 return;
78 end if;
80 -- Determine if size is constrained by an attribute definition clause
81 -- which must be obeyed. If so, we cannot increase the size in this
82 -- routine.
84 -- For a type, the issue is whether an object size clause has been set.
85 -- A normal size clause constrains only the value size (RM_Size)
87 if Is_Type (E) then
88 Esize_Set := Has_Object_Size_Clause (E);
90 -- For an object, the issue is whether a size clause is present
92 else
93 Esize_Set := Has_Size_Clause (E);
94 end if;
96 -- If size is known it must be a multiple of the storage unit size
98 if Esize (E) mod SSU /= 0 then
100 -- If not, and size specified, then give error
102 if Esize_Set then
103 Error_Msg_NE
104 ("size for& not a multiple of storage unit size",
105 Size_Clause (E), E);
106 return;
108 -- Otherwise bump up size to a storage unit boundary
110 else
111 Set_Esize (E, (Esize (E) + SSU - 1) / SSU * SSU);
112 end if;
113 end if;
115 -- Now we have the size set, it must be a multiple of the alignment
116 -- nothing more we can do here if the alignment is unknown here.
118 if Unknown_Alignment (E) then
119 return;
120 end if;
122 -- At this point both the Esize and Alignment are known, so we need
123 -- to make sure they are consistent.
125 Abits := UI_To_Int (Alignment (E)) * SSU;
127 if Esize (E) mod Abits = 0 then
128 return;
129 end if;
131 -- Here we have a situation where the Esize is not a multiple of the
132 -- alignment. We must either increase Esize or reduce the alignment to
133 -- correct this situation.
135 -- The case in which we can decrease the alignment is where the
136 -- alignment was not set by an alignment clause, and the type in
137 -- question is a discrete type, where it is definitely safe to reduce
138 -- the alignment. For example:
140 -- t : integer range 1 .. 2;
141 -- for t'size use 8;
143 -- In this situation, the initial alignment of t is 4, copied from
144 -- the Integer base type, but it is safe to reduce it to 1 at this
145 -- stage, since we will only be loading a single storage unit.
147 if Is_Discrete_Type (Etype (E)) and then not Has_Alignment_Clause (E)
148 then
149 loop
150 Abits := Abits / 2;
151 exit when Esize (E) mod Abits = 0;
152 end loop;
154 Init_Alignment (E, Abits / SSU);
155 return;
156 end if;
158 -- Now the only possible approach left is to increase the Esize but we
159 -- can't do that if the size was set by a specific clause.
161 if Esize_Set then
162 Error_Msg_NE
163 ("size for& is not a multiple of alignment",
164 Size_Clause (E), E);
166 -- Otherwise we can indeed increase the size to a multiple of alignment
168 else
169 Set_Esize (E, ((Esize (E) + (Abits - 1)) / Abits) * Abits);
170 end if;
171 end Adjust_Esize_Alignment;
173 ------------------------------------------
174 -- Compute_Size_Depends_On_Discriminant --
175 ------------------------------------------
177 procedure Compute_Size_Depends_On_Discriminant (E : Entity_Id) is
178 Indx : Node_Id;
179 Ityp : Entity_Id;
180 Lo : Node_Id;
181 Hi : Node_Id;
182 Res : Boolean := False;
184 begin
185 -- Loop to process array indexes
187 Indx := First_Index (E);
188 while Present (Indx) loop
189 Ityp := Etype (Indx);
191 -- If an index of the array is a generic formal type then there is
192 -- no point in determining a size for the array type.
194 if Is_Generic_Type (Ityp) then
195 return;
196 end if;
198 Lo := Type_Low_Bound (Ityp);
199 Hi := Type_High_Bound (Ityp);
201 if (Nkind (Lo) = N_Identifier
202 and then Ekind (Entity (Lo)) = E_Discriminant)
203 or else
204 (Nkind (Hi) = N_Identifier
205 and then Ekind (Entity (Hi)) = E_Discriminant)
206 then
207 Res := True;
208 end if;
210 Next_Index (Indx);
211 end loop;
213 if Res then
214 Set_Size_Depends_On_Discriminant (E);
215 end if;
216 end Compute_Size_Depends_On_Discriminant;
218 -------------------
219 -- Layout_Object --
220 -------------------
222 procedure Layout_Object (E : Entity_Id) is
223 pragma Unreferenced (E);
224 begin
225 -- Nothing to do for now, assume backend does the layout
227 return;
228 end Layout_Object;
230 -----------------
231 -- Layout_Type --
232 -----------------
234 procedure Layout_Type (E : Entity_Id) is
235 Desig_Type : Entity_Id;
237 begin
238 -- For string literal types, for now, kill the size always, this is
239 -- because gigi does not like or need the size to be set ???
241 if Ekind (E) = E_String_Literal_Subtype then
242 Set_Esize (E, Uint_0);
243 Set_RM_Size (E, Uint_0);
244 return;
245 end if;
247 -- For access types, set size/alignment. This is system address size,
248 -- except for fat pointers (unconstrained array access types), where the
249 -- size is two times the address size, to accommodate the two pointers
250 -- that are required for a fat pointer (data and template). Note that
251 -- E_Access_Protected_Subprogram_Type is not an access type for this
252 -- purpose since it is not a pointer but is equivalent to a record. For
253 -- access subtypes, copy the size from the base type since Gigi
254 -- represents them the same way.
256 if Is_Access_Type (E) then
257 Desig_Type := Underlying_Type (Designated_Type (E));
259 -- If we only have a limited view of the type, see whether the
260 -- non-limited view is available.
262 if From_Limited_With (Designated_Type (E))
263 and then Ekind (Designated_Type (E)) = E_Incomplete_Type
264 and then Present (Non_Limited_View (Designated_Type (E)))
265 then
266 Desig_Type := Non_Limited_View (Designated_Type (E));
267 end if;
269 -- If Esize already set (e.g. by a size clause), then nothing further
270 -- to be done here.
272 if Known_Esize (E) then
273 null;
275 -- Access to subprogram is a strange beast, and we let the backend
276 -- figure out what is needed (it may be some kind of fat pointer,
277 -- including the static link for example.
279 elsif Is_Access_Protected_Subprogram_Type (E) then
280 null;
282 -- For access subtypes, copy the size information from base type
284 elsif Ekind (E) = E_Access_Subtype then
285 Set_Size_Info (E, Base_Type (E));
286 Set_RM_Size (E, RM_Size (Base_Type (E)));
288 -- For other access types, we use either address size, or, if a fat
289 -- pointer is used (pointer-to-unconstrained array case), twice the
290 -- address size to accommodate a fat pointer.
292 elsif Present (Desig_Type)
293 and then Is_Array_Type (Desig_Type)
294 and then not Is_Constrained (Desig_Type)
295 and then not Has_Completion_In_Body (Desig_Type)
297 -- Debug Flag -gnatd6 says make all pointers to unconstrained thin
299 and then not Debug_Flag_6
300 then
301 Init_Size (E, 2 * System_Address_Size);
303 -- Check for bad convention set
305 if Warn_On_Export_Import
306 and then
307 (Convention (E) = Convention_C
308 or else
309 Convention (E) = Convention_CPP)
310 then
311 Error_Msg_N
312 ("?x?this access type does not correspond to C pointer", E);
313 end if;
315 -- If the designated type is a limited view it is unanalyzed. We can
316 -- examine the declaration itself to determine whether it will need a
317 -- fat pointer.
319 elsif Present (Desig_Type)
320 and then Present (Parent (Desig_Type))
321 and then Nkind (Parent (Desig_Type)) = N_Full_Type_Declaration
322 and then Nkind (Type_Definition (Parent (Desig_Type))) =
323 N_Unconstrained_Array_Definition
324 and then not Debug_Flag_6
325 then
326 Init_Size (E, 2 * System_Address_Size);
328 -- Normal case of thin pointer
330 else
331 Init_Size (E, System_Address_Size);
332 end if;
334 Set_Elem_Alignment (E);
336 -- Scalar types: set size and alignment
338 elsif Is_Scalar_Type (E) then
340 -- For discrete types, the RM_Size and Esize must be set already,
341 -- since this is part of the earlier processing and the front end is
342 -- always required to lay out the sizes of such types (since they are
343 -- available as static attributes). All we do is to check that this
344 -- rule is indeed obeyed.
346 if Is_Discrete_Type (E) then
348 -- If the RM_Size is not set, then here is where we set it
350 -- Note: an RM_Size of zero looks like not set here, but this
351 -- is a rare case, and we can simply reset it without any harm.
353 if not Known_RM_Size (E) then
354 Set_Discrete_RM_Size (E);
355 end if;
357 -- If Esize for a discrete type is not set then set it
359 if not Known_Esize (E) then
360 declare
361 S : Int := 8;
363 begin
364 loop
365 -- If size is big enough, set it and exit
367 if S >= RM_Size (E) then
368 Init_Esize (E, S);
369 exit;
371 -- If the RM_Size is greater than 64 (happens only when
372 -- strange values are specified by the user, then Esize
373 -- is simply a copy of RM_Size, it will be further
374 -- refined later on)
376 elsif S = 64 then
377 Set_Esize (E, RM_Size (E));
378 exit;
380 -- Otherwise double possible size and keep trying
382 else
383 S := S * 2;
384 end if;
385 end loop;
386 end;
387 end if;
389 -- For non-discrete scalar types, if the RM_Size is not set, then set
390 -- it now to a copy of the Esize if the Esize is set.
392 else
393 if Known_Esize (E) and then Unknown_RM_Size (E) then
394 Set_RM_Size (E, Esize (E));
395 end if;
396 end if;
398 Set_Elem_Alignment (E);
400 -- Non-elementary (composite) types
402 else
403 -- For packed arrays, take size and alignment values from the packed
404 -- array type if a packed array type has been created and the fields
405 -- are not currently set.
407 if Is_Array_Type (E)
408 and then Present (Packed_Array_Impl_Type (E))
409 then
410 declare
411 PAT : constant Entity_Id := Packed_Array_Impl_Type (E);
413 begin
414 if Unknown_Esize (E) then
415 Set_Esize (E, Esize (PAT));
416 end if;
418 if Unknown_RM_Size (E) then
419 Set_RM_Size (E, RM_Size (PAT));
420 end if;
422 if Unknown_Alignment (E) then
423 Set_Alignment (E, Alignment (PAT));
424 end if;
425 end;
426 end if;
428 -- If Esize is set, and RM_Size is not, RM_Size is copied from Esize.
429 -- At least for now this seems reasonable, and is in any case needed
430 -- for compatibility with old versions of gigi.
432 if Known_Esize (E) and then Unknown_RM_Size (E) then
433 Set_RM_Size (E, Esize (E));
434 end if;
436 -- For array base types, set component size if object size of the
437 -- component type is known and is a small power of 2 (8, 16, 32, 64),
438 -- since this is what will always be used.
440 if Ekind (E) = E_Array_Type and then Unknown_Component_Size (E) then
441 declare
442 CT : constant Entity_Id := Component_Type (E);
444 begin
445 -- For some reason, access types can cause trouble, So let's
446 -- just do this for scalar types ???
448 if Present (CT)
449 and then Is_Scalar_Type (CT)
450 and then Known_Static_Esize (CT)
451 then
452 declare
453 S : constant Uint := Esize (CT);
454 begin
455 if Addressable (S) then
456 Set_Component_Size (E, S);
457 end if;
458 end;
459 end if;
460 end;
461 end if;
462 end if;
464 -- Even if the backend performs the layout, we still do a little in
465 -- the front end
467 -- Processing for record types
469 if Is_Record_Type (E) then
471 -- Special remaining processing for record types with a known
472 -- size of 16, 32, or 64 bits whose alignment is not yet set.
473 -- For these types, we set a corresponding alignment matching
474 -- the size if possible, or as large as possible if not.
476 if Convention (E) = Convention_Ada and then not Debug_Flag_Q then
477 Set_Composite_Alignment (E);
478 end if;
480 -- Processing for array types
482 elsif Is_Array_Type (E) then
484 -- For arrays that are required to be atomic/VFA, we do the same
485 -- processing as described above for short records, since we
486 -- really need to have the alignment set for the whole array.
488 if Is_Atomic_Or_VFA (E) and then not Debug_Flag_Q then
489 Set_Composite_Alignment (E);
490 end if;
492 -- For unpacked array types, set an alignment of 1 if we know
493 -- that the component alignment is not greater than 1. The reason
494 -- we do this is to avoid unnecessary copying of slices of such
495 -- arrays when passed to subprogram parameters (see special test
496 -- in Exp_Ch6.Expand_Actuals).
498 if not Is_Packed (E) and then Unknown_Alignment (E) then
499 if Known_Static_Component_Size (E)
500 and then Component_Size (E) = 1
501 then
502 Set_Alignment (E, Uint_1);
503 end if;
504 end if;
506 -- We need to know whether the size depends on the value of one
507 -- or more discriminants to select the return mechanism. Skip if
508 -- errors are present, to prevent cascaded messages.
510 if Serious_Errors_Detected = 0 then
511 Compute_Size_Depends_On_Discriminant (E);
512 end if;
513 end if;
515 -- Final step is to check that Esize and RM_Size are compatible
517 if Known_Static_Esize (E) and then Known_Static_RM_Size (E) then
518 if Esize (E) < RM_Size (E) then
520 -- Esize is less than RM_Size. That's not good. First we test
521 -- whether this was set deliberately with an Object_Size clause
522 -- and if so, object to the clause.
524 if Has_Object_Size_Clause (E) then
525 Error_Msg_Uint_1 := RM_Size (E);
526 Error_Msg_F
527 ("object size is too small, minimum allowed is ^",
528 Expression (Get_Attribute_Definition_Clause
529 (E, Attribute_Object_Size)));
530 end if;
532 -- Adjust Esize up to RM_Size value
534 declare
535 Size : constant Uint := RM_Size (E);
537 begin
538 Set_Esize (E, RM_Size (E));
540 -- For scalar types, increase Object_Size to power of 2, but
541 -- not less than a storage unit in any case (i.e., normally
542 -- this means it will be storage-unit addressable).
544 if Is_Scalar_Type (E) then
545 if Size <= SSU then
546 Init_Esize (E, SSU);
547 elsif Size <= 16 then
548 Init_Esize (E, 16);
549 elsif Size <= 32 then
550 Init_Esize (E, 32);
551 else
552 Set_Esize (E, (Size + 63) / 64 * 64);
553 end if;
555 -- Finally, make sure that alignment is consistent with
556 -- the newly assigned size.
558 while Alignment (E) * SSU < Esize (E)
559 and then Alignment (E) < Maximum_Alignment
560 loop
561 Set_Alignment (E, 2 * Alignment (E));
562 end loop;
563 end if;
564 end;
565 end if;
566 end if;
567 end Layout_Type;
569 -----------------------------
570 -- Set_Composite_Alignment --
571 -----------------------------
573 procedure Set_Composite_Alignment (E : Entity_Id) is
574 Siz : Uint;
575 Align : Nat;
577 begin
578 -- If alignment is already set, then nothing to do
580 if Known_Alignment (E) then
581 return;
582 end if;
584 -- Alignment is not known, see if we can set it, taking into account
585 -- the setting of the Optimize_Alignment mode.
587 -- If Optimize_Alignment is set to Space, then we try to give packed
588 -- records an aligmment of 1, unless there is some reason we can't.
590 if Optimize_Alignment_Space (E)
591 and then Is_Record_Type (E)
592 and then Is_Packed (E)
593 then
594 -- No effect for record with atomic/VFA components
596 if Is_Atomic_Or_VFA (E) then
597 Error_Msg_N ("Optimize_Alignment has no effect for &??", E);
599 if Is_Atomic (E) then
600 Error_Msg_N
601 ("\pragma ignored for atomic record??", E);
602 else
603 Error_Msg_N
604 ("\pragma ignored for bolatile full access record??", E);
605 end if;
607 return;
608 end if;
610 -- No effect if independent components
612 if Has_Independent_Components (E) then
613 Error_Msg_N ("Optimize_Alignment has no effect for &??", E);
614 Error_Msg_N
615 ("\pragma ignored for record with independent components??", E);
616 return;
617 end if;
619 -- No effect if any component is atomic/VFA or is a by-reference type
621 declare
622 Ent : Entity_Id;
624 begin
625 Ent := First_Component_Or_Discriminant (E);
626 while Present (Ent) loop
627 if Is_By_Reference_Type (Etype (Ent))
628 or else Is_Atomic_Or_VFA (Etype (Ent))
629 or else Is_Atomic_Or_VFA (Ent)
630 then
631 Error_Msg_N ("Optimize_Alignment has no effect for &??", E);
633 if Is_Atomic (Etype (Ent)) or else Is_Atomic (Ent) then
634 Error_Msg_N
635 ("\pragma is ignored if atomic "
636 & "components present??", E);
637 else
638 Error_Msg_N
639 ("\pragma is ignored if bolatile full access "
640 & "components present??", E);
641 end if;
643 return;
644 else
645 Next_Component_Or_Discriminant (Ent);
646 end if;
647 end loop;
648 end;
650 -- Optimize_Alignment has no effect on variable length record
652 if not Size_Known_At_Compile_Time (E) then
653 Error_Msg_N ("Optimize_Alignment has no effect for &??", E);
654 Error_Msg_N ("\pragma is ignored for variable length record??", E);
655 return;
656 end if;
658 -- All tests passed, we can set alignment to 1
660 Align := 1;
662 -- Not a record, or not packed
664 else
665 -- The only other cases we worry about here are where the size is
666 -- statically known at compile time.
668 if Known_Static_Esize (E) then
669 Siz := Esize (E);
670 elsif Unknown_Esize (E) and then Known_Static_RM_Size (E) then
671 Siz := RM_Size (E);
672 else
673 return;
674 end if;
676 -- Size is known, alignment is not set
678 -- Reset alignment to match size if the known size is exactly 2, 4,
679 -- or 8 storage units.
681 if Siz = 2 * SSU then
682 Align := 2;
683 elsif Siz = 4 * SSU then
684 Align := 4;
685 elsif Siz = 8 * SSU then
686 Align := 8;
688 -- If Optimize_Alignment is set to Space, then make sure the
689 -- alignment matches the size, for example, if the size is 17
690 -- bytes then we want an alignment of 1 for the type.
692 elsif Optimize_Alignment_Space (E) then
693 if Siz mod (8 * SSU) = 0 then
694 Align := 8;
695 elsif Siz mod (4 * SSU) = 0 then
696 Align := 4;
697 elsif Siz mod (2 * SSU) = 0 then
698 Align := 2;
699 else
700 Align := 1;
701 end if;
703 -- If Optimize_Alignment is set to Time, then we reset for odd
704 -- "in between sizes", for example a 17 bit record is given an
705 -- alignment of 4.
707 elsif Optimize_Alignment_Time (E)
708 and then Siz > SSU
709 and then Siz <= 8 * SSU
710 then
711 if Siz <= 2 * SSU then
712 Align := 2;
713 elsif Siz <= 4 * SSU then
714 Align := 4;
715 else -- Siz <= 8 * SSU then
716 Align := 8;
717 end if;
719 -- No special alignment fiddling needed
721 else
722 return;
723 end if;
724 end if;
726 -- Here we have Set Align to the proposed improved value. Make sure the
727 -- value set does not exceed Maximum_Alignment for the target.
729 if Align > Maximum_Alignment then
730 Align := Maximum_Alignment;
731 end if;
733 -- Further processing for record types only to reduce the alignment
734 -- set by the above processing in some specific cases. We do not
735 -- do this for atomic/VFA records, since we need max alignment there,
737 if Is_Record_Type (E) and then not Is_Atomic_Or_VFA (E) then
739 -- For records, there is generally no point in setting alignment
740 -- higher than word size since we cannot do better than move by
741 -- words in any case. Omit this if we are optimizing for time,
742 -- since conceivably we may be able to do better.
744 if Align > System_Word_Size / SSU
745 and then not Optimize_Alignment_Time (E)
746 then
747 Align := System_Word_Size / SSU;
748 end if;
750 -- Check components. If any component requires a higher alignment,
751 -- then we set that higher alignment in any case. Don't do this if
752 -- we have Optimize_Alignment set to Space. Note that that covers
753 -- the case of packed records, where we already set alignment to 1.
755 if not Optimize_Alignment_Space (E) then
756 declare
757 Comp : Entity_Id;
759 begin
760 Comp := First_Component (E);
761 while Present (Comp) loop
762 if Known_Alignment (Etype (Comp)) then
763 declare
764 Calign : constant Uint := Alignment (Etype (Comp));
766 begin
767 -- The cases to process are when the alignment of the
768 -- component type is larger than the alignment we have
769 -- so far, and either there is no component clause for
770 -- the component, or the length set by the component
771 -- clause matches the length of the component type.
773 if Calign > Align
774 and then
775 (Unknown_Esize (Comp)
776 or else (Known_Static_Esize (Comp)
777 and then
778 Esize (Comp) = Calign * SSU))
779 then
780 Align := UI_To_Int (Calign);
781 end if;
782 end;
783 end if;
785 Next_Component (Comp);
786 end loop;
787 end;
788 end if;
789 end if;
791 -- Set chosen alignment, and increase Esize if necessary to match the
792 -- chosen alignment.
794 Set_Alignment (E, UI_From_Int (Align));
796 if Known_Static_Esize (E)
797 and then Esize (E) < Align * SSU
798 then
799 Set_Esize (E, UI_From_Int (Align * SSU));
800 end if;
801 end Set_Composite_Alignment;
803 --------------------------
804 -- Set_Discrete_RM_Size --
805 --------------------------
807 procedure Set_Discrete_RM_Size (Def_Id : Entity_Id) is
808 FST : constant Entity_Id := First_Subtype (Def_Id);
810 begin
811 -- All discrete types except for the base types in standard are
812 -- constrained, so indicate this by setting Is_Constrained.
814 Set_Is_Constrained (Def_Id);
816 -- Set generic types to have an unknown size, since the representation
817 -- of a generic type is irrelevant, in view of the fact that they have
818 -- nothing to do with code.
820 if Is_Generic_Type (Root_Type (FST)) then
821 Set_RM_Size (Def_Id, Uint_0);
823 -- If the subtype statically matches the first subtype, then it is
824 -- required to have exactly the same layout. This is required by
825 -- aliasing considerations.
827 elsif Def_Id /= FST and then
828 Subtypes_Statically_Match (Def_Id, FST)
829 then
830 Set_RM_Size (Def_Id, RM_Size (FST));
831 Set_Size_Info (Def_Id, FST);
833 -- In all other cases the RM_Size is set to the minimum size. Note that
834 -- this routine is never called for subtypes for which the RM_Size is
835 -- set explicitly by an attribute clause.
837 else
838 Set_RM_Size (Def_Id, UI_From_Int (Minimum_Size (Def_Id)));
839 end if;
840 end Set_Discrete_RM_Size;
842 ------------------------
843 -- Set_Elem_Alignment --
844 ------------------------
846 procedure Set_Elem_Alignment (E : Entity_Id; Align : Nat := 0) is
847 begin
848 -- Do not set alignment for packed array types, this is handled in the
849 -- backend.
851 if Is_Packed_Array_Impl_Type (E) then
852 return;
854 -- If there is an alignment clause, then we respect it
856 elsif Has_Alignment_Clause (E) then
857 return;
859 -- If the size is not set, then don't attempt to set the alignment. This
860 -- happens in the backend layout case for access-to-subprogram types.
862 elsif not Known_Static_Esize (E) then
863 return;
865 -- For access types, do not set the alignment if the size is less than
866 -- the allowed minimum size. This avoids cascaded error messages.
868 elsif Is_Access_Type (E) and then Esize (E) < System_Address_Size then
869 return;
870 end if;
872 -- We attempt to set the alignment in all the other cases
874 declare
875 S : Int;
876 A : Nat;
877 M : Nat;
879 begin
880 -- The given Esize may be larger that int'last because of a previous
881 -- error, and the call to UI_To_Int will fail, so use default.
883 if Esize (E) / SSU > Ttypes.Maximum_Alignment then
884 S := Ttypes.Maximum_Alignment;
886 -- If this is an access type and the target doesn't have strict
887 -- alignment, then cap the alignment to that of a regular access
888 -- type. This will avoid giving fat pointers twice the usual
889 -- alignment for no practical benefit since the misalignment doesn't
890 -- really matter.
892 elsif Is_Access_Type (E)
893 and then not Target_Strict_Alignment
894 then
895 S := System_Address_Size / SSU;
897 else
898 S := UI_To_Int (Esize (E)) / SSU;
899 end if;
901 -- If the default alignment of "double" floating-point types is
902 -- specifically capped, enforce the cap.
904 if Ttypes.Target_Double_Float_Alignment > 0
905 and then S = 8
906 and then Is_Floating_Point_Type (E)
907 then
908 M := Ttypes.Target_Double_Float_Alignment;
910 -- If the default alignment of "double" or larger scalar types is
911 -- specifically capped, enforce the cap.
913 elsif Ttypes.Target_Double_Scalar_Alignment > 0
914 and then S >= 8
915 and then Is_Scalar_Type (E)
916 then
917 M := Ttypes.Target_Double_Scalar_Alignment;
919 -- Otherwise enforce the overall alignment cap
921 else
922 M := Ttypes.Maximum_Alignment;
923 end if;
925 -- We calculate the alignment as the largest power-of-two multiple
926 -- of System.Storage_Unit that does not exceed the object size of
927 -- the type and the maximum allowed alignment, if none was specified.
928 -- Otherwise we only cap it to the maximum allowed alignment.
930 if Align = 0 then
931 A := 1;
932 while 2 * A <= S and then 2 * A <= M loop
933 A := 2 * A;
934 end loop;
935 else
936 A := Nat'Min (Align, M);
937 end if;
939 -- If alignment is currently not set, then we can safely set it to
940 -- this new calculated value.
942 if Unknown_Alignment (E) then
943 Init_Alignment (E, A);
945 -- Cases where we have inherited an alignment
947 -- For constructed types, always reset the alignment, these are
948 -- generally invisible to the user anyway, and that way we are
949 -- sure that no constructed types have weird alignments.
951 elsif not Comes_From_Source (E) then
952 Init_Alignment (E, A);
954 -- If this inherited alignment is the same as the one we computed,
955 -- then obviously everything is fine, and we do not need to reset it.
957 elsif Alignment (E) = A then
958 null;
960 else
961 -- Now we come to the difficult cases of subtypes for which we
962 -- have inherited an alignment different from the computed one.
963 -- We resort to the presence of alignment and size clauses to
964 -- guide our choices. Note that they can generally be present
965 -- only on the first subtype (except for Object_Size) and that
966 -- we need to look at the Rep_Item chain to correctly handle
967 -- derived types.
969 declare
970 FST : constant Entity_Id := First_Subtype (E);
972 function Has_Attribute_Clause
973 (E : Entity_Id;
974 Id : Attribute_Id) return Boolean;
975 -- Wrapper around Get_Attribute_Definition_Clause which tests
976 -- for the presence of the specified attribute clause.
978 --------------------------
979 -- Has_Attribute_Clause --
980 --------------------------
982 function Has_Attribute_Clause
983 (E : Entity_Id;
984 Id : Attribute_Id) return Boolean is
985 begin
986 return Present (Get_Attribute_Definition_Clause (E, Id));
987 end Has_Attribute_Clause;
989 begin
990 -- If the alignment comes from a clause, then we respect it.
991 -- Consider for example:
993 -- type R is new Character;
994 -- for R'Alignment use 1;
995 -- for R'Size use 16;
996 -- subtype S is R;
998 -- Here R has a specified size of 16 and a specified alignment
999 -- of 1, and it seems right for S to inherit both values.
1001 if Has_Attribute_Clause (FST, Attribute_Alignment) then
1002 null;
1004 -- Now we come to the cases where we have inherited alignment
1005 -- and size, and overridden the size but not the alignment.
1007 elsif Has_Attribute_Clause (FST, Attribute_Size)
1008 or else Has_Attribute_Clause (FST, Attribute_Object_Size)
1009 or else Has_Attribute_Clause (E, Attribute_Object_Size)
1010 then
1011 -- This is tricky, it might be thought that we should try to
1012 -- inherit the alignment, since that's what the RM implies,
1013 -- but that leads to complex rules and oddities. Consider
1014 -- for example:
1016 -- type R is new Character;
1017 -- for R'Size use 16;
1019 -- It seems quite bogus in this case to inherit an alignment
1020 -- of 1 from the parent type Character. Furthermore, if that
1021 -- is what the programmer really wanted for some odd reason,
1022 -- then he could specify the alignment directly.
1024 -- Moreover we really don't want to inherit the alignment in
1025 -- the case of a specified Object_Size for a subtype, since
1026 -- there would be no way of overriding to give a reasonable
1027 -- value (as we don't have an Object_Alignment attribute).
1028 -- Consider for example:
1030 -- subtype R is Character;
1031 -- for R'Object_Size use 16;
1033 -- If we inherit the alignment of 1, then it will be very
1034 -- inefficient for the subtype and this cannot be fixed.
1036 -- So we make the decision that if Size (or Object_Size) is
1037 -- given and the alignment is not specified with a clause,
1038 -- we reset the alignment to the appropriate value for the
1039 -- specified size. This is a nice simple rule to implement
1040 -- and document.
1042 -- There is a theoretical glitch, which is that a confirming
1043 -- size clause could now change the alignment, which, if we
1044 -- really think that confirming rep clauses should have no
1045 -- effect, could be seen as a no-no. However that's already
1046 -- implemented by Alignment_Check_For_Size_Change so we do
1047 -- not change the philosophy here.
1049 -- Historical note: in versions prior to Nov 6th, 2011, an
1050 -- odd distinction was made between inherited alignments
1051 -- larger than the computed alignment (where the larger
1052 -- alignment was inherited) and inherited alignments smaller
1053 -- than the computed alignment (where the smaller alignment
1054 -- was overridden). This was a dubious fix to get around an
1055 -- ACATS problem which seems to have disappeared anyway, and
1056 -- in any case, this peculiarity was never documented.
1058 Init_Alignment (E, A);
1060 -- If no Size (or Object_Size) was specified, then we have
1061 -- inherited the object size, so we should also inherit the
1062 -- alignment and not modify it.
1064 else
1065 null;
1066 end if;
1067 end;
1068 end if;
1069 end;
1070 end Set_Elem_Alignment;
1072 end Layout;