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-2019, 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 26with Atree; use Atree; 27with Debug; use Debug; 28with Einfo; use Einfo; 29with Errout; use Errout; 30with Opt; use Opt; 31with Sem_Aux; use Sem_Aux; 32with Sem_Ch13; use Sem_Ch13; 33with Sem_Eval; use Sem_Eval; 34with Sem_Util; use Sem_Util; 35with Sinfo; use Sinfo; 36with Snames; use Snames; 37with Ttypes; use Ttypes; 38with Uintp; use Uintp; 39 40package body Layout is 41 42 ------------------------ 43 -- Local Declarations -- 44 ------------------------ 45 46 SSU : constant Int := Ttypes.System_Storage_Unit; 47 -- Short hand for System_Storage_Unit 48 49 ----------------------- 50 -- Local Subprograms -- 51 ----------------------- 52 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. 58 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. 64 65 ---------------------------- 66 -- Adjust_Esize_Alignment -- 67 ---------------------------- 68 69 procedure Adjust_Esize_Alignment (E : Entity_Id) is 70 Abits : Int; 71 Esize_Set : Boolean; 72 73 begin 74 -- Nothing to do if size unknown 75 76 if Unknown_Esize (E) then 77 return; 78 end if; 79 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. 83 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) 86 87 if Is_Type (E) then 88 Esize_Set := Has_Object_Size_Clause (E); 89 90 -- For an object, the issue is whether a size clause is present 91 92 else 93 Esize_Set := Has_Size_Clause (E); 94 end if; 95 96 -- If size is known it must be a multiple of the storage unit size 97 98 if Esize (E) mod SSU /= 0 then 99 100 -- If not, and size specified, then give error 101 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; 107 108 -- Otherwise bump up size to a storage unit boundary 109 110 else 111 Set_Esize (E, (Esize (E) + SSU - 1) / SSU * SSU); 112 end if; 113 end if; 114 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. 117 118 if Unknown_Alignment (E) then 119 return; 120 end if; 121 122 -- At this point both the Esize and Alignment are known, so we need 123 -- to make sure they are consistent. 124 125 Abits := UI_To_Int (Alignment (E)) * SSU; 126 127 if Esize (E) mod Abits = 0 then 128 return; 129 end if; 130 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. 134 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: 139 140 -- t : integer range 1 .. 2; 141 -- for t'size use 8; 142 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. 146 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; 153 154 Init_Alignment (E, Abits / SSU); 155 return; 156 end if; 157 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. 160 161 if Esize_Set then 162 Error_Msg_NE 163 ("size for& is not a multiple of alignment", 164 Size_Clause (E), E); 165 166 -- Otherwise we can indeed increase the size to a multiple of alignment 167 168 else 169 Set_Esize (E, ((Esize (E) + (Abits - 1)) / Abits) * Abits); 170 end if; 171 end Adjust_Esize_Alignment; 172 173 ------------------------------------------ 174 -- Compute_Size_Depends_On_Discriminant -- 175 ------------------------------------------ 176 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; 183 184 begin 185 -- Loop to process array indexes 186 187 Indx := First_Index (E); 188 while Present (Indx) loop 189 Ityp := Etype (Indx); 190 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. 193 194 if Is_Generic_Type (Ityp) then 195 return; 196 end if; 197 198 Lo := Type_Low_Bound (Ityp); 199 Hi := Type_High_Bound (Ityp); 200 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; 209 210 Next_Index (Indx); 211 end loop; 212 213 if Res then 214 Set_Size_Depends_On_Discriminant (E); 215 end if; 216 end Compute_Size_Depends_On_Discriminant; 217 218 ------------------- 219 -- Layout_Object -- 220 ------------------- 221 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 226 227 return; 228 end Layout_Object; 229 230 ----------------- 231 -- Layout_Type -- 232 ----------------- 233 234 procedure Layout_Type (E : Entity_Id) is 235 Desig_Type : Entity_Id; 236 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 ??? 240 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; 246 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. 255 256 if Is_Access_Type (E) then 257 Desig_Type := Underlying_Type (Designated_Type (E)); 258 259 -- If we only have a limited view of the type, see whether the 260 -- non-limited view is available. 261 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; 268 269 -- If Esize already set (e.g. by a size clause), then nothing further 270 -- to be done here. 271 272 if Known_Esize (E) then 273 null; 274 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. 278 279 elsif Is_Access_Protected_Subprogram_Type (E) then 280 null; 281 282 -- For access subtypes, copy the size information from base type 283 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))); 287 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. 291 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) 296 297 -- Debug Flag -gnatd6 says make all pointers to unconstrained thin 298 299 and then not Debug_Flag_6 300 then 301 Init_Size (E, 2 * System_Address_Size); 302 303 -- Check for bad convention set 304 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; 314 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. 318 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); 327 328 -- If unnesting subprograms, subprogram access types contain the 329 -- address of both the subprogram and an activation record. But if we 330 -- set that, we'll get a warning on different unchecked conversion 331 -- sizes in the RTS. So leave unset in that case. 332 333 elsif Unnest_Subprogram_Mode 334 and then Is_Access_Subprogram_Type (E) 335 then 336 null; 337 338 -- Normal case of thin pointer 339 340 else 341 Init_Size (E, System_Address_Size); 342 end if; 343 344 Set_Elem_Alignment (E); 345 346 -- Scalar types: set size and alignment 347 348 elsif Is_Scalar_Type (E) then 349 350 -- For discrete types, the RM_Size and Esize must be set already, 351 -- since this is part of the earlier processing and the front end is 352 -- always required to lay out the sizes of such types (since they are 353 -- available as static attributes). All we do is to check that this 354 -- rule is indeed obeyed. 355 356 if Is_Discrete_Type (E) then 357 358 -- If the RM_Size is not set, then here is where we set it 359 360 -- Note: an RM_Size of zero looks like not set here, but this 361 -- is a rare case, and we can simply reset it without any harm. 362 363 if not Known_RM_Size (E) then 364 Set_Discrete_RM_Size (E); 365 end if; 366 367 -- If Esize for a discrete type is not set then set it 368 369 if not Known_Esize (E) then 370 declare 371 S : Int := 8; 372 373 begin 374 loop 375 -- If size is big enough, set it and exit 376 377 if S >= RM_Size (E) then 378 Init_Esize (E, S); 379 exit; 380 381 -- If the RM_Size is greater than 64 (happens only when 382 -- strange values are specified by the user, then Esize 383 -- is simply a copy of RM_Size, it will be further 384 -- refined later on) 385 386 elsif S = 64 then 387 Set_Esize (E, RM_Size (E)); 388 exit; 389 390 -- Otherwise double possible size and keep trying 391 392 else 393 S := S * 2; 394 end if; 395 end loop; 396 end; 397 end if; 398 399 -- For non-discrete scalar types, if the RM_Size is not set, then set 400 -- it now to a copy of the Esize if the Esize is set. 401 402 else 403 if Known_Esize (E) and then Unknown_RM_Size (E) then 404 Set_RM_Size (E, Esize (E)); 405 end if; 406 end if; 407 408 Set_Elem_Alignment (E); 409 410 -- Non-elementary (composite) types 411 412 else 413 -- For packed arrays, take size and alignment values from the packed 414 -- array type if a packed array type has been created and the fields 415 -- are not currently set. 416 417 if Is_Array_Type (E) 418 and then Present (Packed_Array_Impl_Type (E)) 419 then 420 declare 421 PAT : constant Entity_Id := Packed_Array_Impl_Type (E); 422 423 begin 424 if Unknown_Esize (E) then 425 Set_Esize (E, Esize (PAT)); 426 end if; 427 428 if Unknown_RM_Size (E) then 429 Set_RM_Size (E, RM_Size (PAT)); 430 end if; 431 432 if Unknown_Alignment (E) then 433 Set_Alignment (E, Alignment (PAT)); 434 end if; 435 end; 436 end if; 437 438 -- If Esize is set, and RM_Size is not, RM_Size is copied from Esize. 439 -- At least for now this seems reasonable, and is in any case needed 440 -- for compatibility with old versions of gigi. 441 442 if Known_Esize (E) and then Unknown_RM_Size (E) then 443 Set_RM_Size (E, Esize (E)); 444 end if; 445 446 -- For array base types, set component size if object size of the 447 -- component type is known and is a small power of 2 (8, 16, 32, 64), 448 -- since this is what will always be used. 449 450 if Ekind (E) = E_Array_Type and then Unknown_Component_Size (E) then 451 declare 452 CT : constant Entity_Id := Component_Type (E); 453 454 begin 455 -- For some reason, access types can cause trouble, So let's 456 -- just do this for scalar types ??? 457 458 if Present (CT) 459 and then Is_Scalar_Type (CT) 460 and then Known_Static_Esize (CT) 461 then 462 declare 463 S : constant Uint := Esize (CT); 464 begin 465 if Addressable (S) then 466 Set_Component_Size (E, S); 467 end if; 468 end; 469 end if; 470 end; 471 end if; 472 end if; 473 474 -- Even if the backend performs the layout, we still do a little in 475 -- the front end 476 477 -- Processing for record types 478 479 if Is_Record_Type (E) then 480 481 -- Special remaining processing for record types with a known 482 -- size of 16, 32, or 64 bits whose alignment is not yet set. 483 -- For these types, we set a corresponding alignment matching 484 -- the size if possible, or as large as possible if not. 485 486 if Convention (E) = Convention_Ada and then not Debug_Flag_Q then 487 Set_Composite_Alignment (E); 488 end if; 489 490 -- Processing for array types 491 492 elsif Is_Array_Type (E) then 493 494 -- For arrays that are required to be atomic/VFA, we do the same 495 -- processing as described above for short records, since we 496 -- really need to have the alignment set for the whole array. 497 498 if Is_Atomic_Or_VFA (E) and then not Debug_Flag_Q then 499 Set_Composite_Alignment (E); 500 end if; 501 502 -- For unpacked array types, set an alignment of 1 if we know 503 -- that the component alignment is not greater than 1. The reason 504 -- we do this is to avoid unnecessary copying of slices of such 505 -- arrays when passed to subprogram parameters (see special test 506 -- in Exp_Ch6.Expand_Actuals). 507 508 if not Is_Packed (E) and then Unknown_Alignment (E) then 509 if Known_Static_Component_Size (E) 510 and then Component_Size (E) = 1 511 then 512 Set_Alignment (E, Uint_1); 513 end if; 514 end if; 515 516 -- We need to know whether the size depends on the value of one 517 -- or more discriminants to select the return mechanism. Skip if 518 -- errors are present, to prevent cascaded messages. 519 520 if Serious_Errors_Detected = 0 then 521 Compute_Size_Depends_On_Discriminant (E); 522 end if; 523 end if; 524 525 -- Final step is to check that Esize and RM_Size are compatible 526 527 if Known_Static_Esize (E) and then Known_Static_RM_Size (E) then 528 if Esize (E) < RM_Size (E) then 529 530 -- Esize is less than RM_Size. That's not good. First we test 531 -- whether this was set deliberately with an Object_Size clause 532 -- and if so, object to the clause. 533 534 if Has_Object_Size_Clause (E) then 535 Error_Msg_Uint_1 := RM_Size (E); 536 Error_Msg_F 537 ("object size is too small, minimum allowed is ^", 538 Expression (Get_Attribute_Definition_Clause 539 (E, Attribute_Object_Size))); 540 end if; 541 542 -- Adjust Esize up to RM_Size value 543 544 declare 545 Size : constant Uint := RM_Size (E); 546 547 begin 548 Set_Esize (E, RM_Size (E)); 549 550 -- For scalar types, increase Object_Size to power of 2, but 551 -- not less than a storage unit in any case (i.e., normally 552 -- this means it will be storage-unit addressable). 553 554 if Is_Scalar_Type (E) then 555 if Size <= SSU then 556 Init_Esize (E, SSU); 557 elsif Size <= 16 then 558 Init_Esize (E, 16); 559 elsif Size <= 32 then 560 Init_Esize (E, 32); 561 else 562 Set_Esize (E, (Size + 63) / 64 * 64); 563 end if; 564 565 -- Finally, make sure that alignment is consistent with 566 -- the newly assigned size. 567 568 while Alignment (E) * SSU < Esize (E) 569 and then Alignment (E) < Maximum_Alignment 570 loop 571 Set_Alignment (E, 2 * Alignment (E)); 572 end loop; 573 end if; 574 end; 575 end if; 576 end if; 577 end Layout_Type; 578 579 ----------------------------- 580 -- Set_Composite_Alignment -- 581 ----------------------------- 582 583 procedure Set_Composite_Alignment (E : Entity_Id) is 584 Siz : Uint; 585 Align : Nat; 586 587 begin 588 -- If alignment is already set, then nothing to do 589 590 if Known_Alignment (E) then 591 return; 592 end if; 593 594 -- Alignment is not known, see if we can set it, taking into account 595 -- the setting of the Optimize_Alignment mode. 596 597 -- If Optimize_Alignment is set to Space, then we try to give packed 598 -- records an aligmment of 1, unless there is some reason we can't. 599 600 if Optimize_Alignment_Space (E) 601 and then Is_Record_Type (E) 602 and then Is_Packed (E) 603 then 604 -- No effect for record with atomic/VFA components 605 606 if Is_Atomic_Or_VFA (E) then 607 Error_Msg_N ("Optimize_Alignment has no effect for &??", E); 608 609 if Is_Atomic (E) then 610 Error_Msg_N 611 ("\pragma ignored for atomic record??", E); 612 else 613 Error_Msg_N 614 ("\pragma ignored for bolatile full access record??", E); 615 end if; 616 617 return; 618 end if; 619 620 -- No effect if independent components 621 622 if Has_Independent_Components (E) then 623 Error_Msg_N ("Optimize_Alignment has no effect for &??", E); 624 Error_Msg_N 625 ("\pragma ignored for record with independent components??", E); 626 return; 627 end if; 628 629 -- No effect if any component is atomic/VFA or is a by-reference type 630 631 declare 632 Ent : Entity_Id; 633 634 begin 635 Ent := First_Component_Or_Discriminant (E); 636 while Present (Ent) loop 637 if Is_By_Reference_Type (Etype (Ent)) 638 or else Is_Atomic_Or_VFA (Etype (Ent)) 639 or else Is_Atomic_Or_VFA (Ent) 640 then 641 Error_Msg_N ("Optimize_Alignment has no effect for &??", E); 642 643 if Is_Atomic (Etype (Ent)) or else Is_Atomic (Ent) then 644 Error_Msg_N 645 ("\pragma is ignored if atomic " 646 & "components present??", E); 647 else 648 Error_Msg_N 649 ("\pragma is ignored if bolatile full access " 650 & "components present??", E); 651 end if; 652 653 return; 654 else 655 Next_Component_Or_Discriminant (Ent); 656 end if; 657 end loop; 658 end; 659 660 -- Optimize_Alignment has no effect on variable length record 661 662 if not Size_Known_At_Compile_Time (E) then 663 Error_Msg_N ("Optimize_Alignment has no effect for &??", E); 664 Error_Msg_N ("\pragma is ignored for variable length record??", E); 665 return; 666 end if; 667 668 -- All tests passed, we can set alignment to 1 669 670 Align := 1; 671 672 -- Not a record, or not packed 673 674 else 675 -- The only other cases we worry about here are where the size is 676 -- statically known at compile time. 677 678 if Known_Static_Esize (E) then 679 Siz := Esize (E); 680 elsif Unknown_Esize (E) and then Known_Static_RM_Size (E) then 681 Siz := RM_Size (E); 682 else 683 return; 684 end if; 685 686 -- Size is known, alignment is not set 687 688 -- Reset alignment to match size if the known size is exactly 2, 4, 689 -- or 8 storage units. 690 691 if Siz = 2 * SSU then 692 Align := 2; 693 elsif Siz = 4 * SSU then 694 Align := 4; 695 elsif Siz = 8 * SSU then 696 Align := 8; 697 698 -- If Optimize_Alignment is set to Space, then make sure the 699 -- alignment matches the size, for example, if the size is 17 700 -- bytes then we want an alignment of 1 for the type. 701 702 elsif Optimize_Alignment_Space (E) then 703 if Siz mod (8 * SSU) = 0 then 704 Align := 8; 705 elsif Siz mod (4 * SSU) = 0 then 706 Align := 4; 707 elsif Siz mod (2 * SSU) = 0 then 708 Align := 2; 709 else 710 Align := 1; 711 end if; 712 713 -- If Optimize_Alignment is set to Time, then we reset for odd 714 -- "in between sizes", for example a 17 bit record is given an 715 -- alignment of 4. 716 717 elsif Optimize_Alignment_Time (E) 718 and then Siz > SSU 719 and then Siz <= 8 * SSU 720 then 721 if Siz <= 2 * SSU then 722 Align := 2; 723 elsif Siz <= 4 * SSU then 724 Align := 4; 725 else -- Siz <= 8 * SSU then 726 Align := 8; 727 end if; 728 729 -- No special alignment fiddling needed 730 731 else 732 return; 733 end if; 734 end if; 735 736 -- Here we have Set Align to the proposed improved value. Make sure the 737 -- value set does not exceed Maximum_Alignment for the target. 738 739 if Align > Maximum_Alignment then 740 Align := Maximum_Alignment; 741 end if; 742 743 -- Further processing for record types only to reduce the alignment 744 -- set by the above processing in some specific cases. We do not 745 -- do this for atomic/VFA records, since we need max alignment there, 746 747 if Is_Record_Type (E) and then not Is_Atomic_Or_VFA (E) then 748 749 -- For records, there is generally no point in setting alignment 750 -- higher than word size since we cannot do better than move by 751 -- words in any case. Omit this if we are optimizing for time, 752 -- since conceivably we may be able to do better. 753 754 if Align > System_Word_Size / SSU 755 and then not Optimize_Alignment_Time (E) 756 then 757 Align := System_Word_Size / SSU; 758 end if; 759 760 -- Check components. If any component requires a higher alignment, 761 -- then we set that higher alignment in any case. Don't do this if 762 -- we have Optimize_Alignment set to Space. Note that that covers 763 -- the case of packed records, where we already set alignment to 1. 764 765 if not Optimize_Alignment_Space (E) then 766 declare 767 Comp : Entity_Id; 768 769 begin 770 Comp := First_Component (E); 771 while Present (Comp) loop 772 if Known_Alignment (Etype (Comp)) then 773 declare 774 Calign : constant Uint := Alignment (Etype (Comp)); 775 776 begin 777 -- The cases to process are when the alignment of the 778 -- component type is larger than the alignment we have 779 -- so far, and either there is no component clause for 780 -- the component, or the length set by the component 781 -- clause matches the length of the component type. 782 783 if Calign > Align 784 and then 785 (Unknown_Esize (Comp) 786 or else (Known_Static_Esize (Comp) 787 and then 788 Esize (Comp) = Calign * SSU)) 789 then 790 Align := UI_To_Int (Calign); 791 end if; 792 end; 793 end if; 794 795 Next_Component (Comp); 796 end loop; 797 end; 798 end if; 799 end if; 800 801 -- Set chosen alignment, and increase Esize if necessary to match the 802 -- chosen alignment. 803 804 Set_Alignment (E, UI_From_Int (Align)); 805 806 if Known_Static_Esize (E) 807 and then Esize (E) < Align * SSU 808 then 809 Set_Esize (E, UI_From_Int (Align * SSU)); 810 end if; 811 end Set_Composite_Alignment; 812 813 -------------------------- 814 -- Set_Discrete_RM_Size -- 815 -------------------------- 816 817 procedure Set_Discrete_RM_Size (Def_Id : Entity_Id) is 818 FST : constant Entity_Id := First_Subtype (Def_Id); 819 820 begin 821 -- All discrete types except for the base types in standard are 822 -- constrained, so indicate this by setting Is_Constrained. 823 824 Set_Is_Constrained (Def_Id); 825 826 -- Set generic types to have an unknown size, since the representation 827 -- of a generic type is irrelevant, in view of the fact that they have 828 -- nothing to do with code. 829 830 if Is_Generic_Type (Root_Type (FST)) then 831 Set_RM_Size (Def_Id, Uint_0); 832 833 -- If the subtype statically matches the first subtype, then it is 834 -- required to have exactly the same layout. This is required by 835 -- aliasing considerations. 836 837 elsif Def_Id /= FST and then 838 Subtypes_Statically_Match (Def_Id, FST) 839 then 840 Set_RM_Size (Def_Id, RM_Size (FST)); 841 Set_Size_Info (Def_Id, FST); 842 843 -- In all other cases the RM_Size is set to the minimum size. Note that 844 -- this routine is never called for subtypes for which the RM_Size is 845 -- set explicitly by an attribute clause. 846 847 else 848 Set_RM_Size (Def_Id, UI_From_Int (Minimum_Size (Def_Id))); 849 end if; 850 end Set_Discrete_RM_Size; 851 852 ------------------------ 853 -- Set_Elem_Alignment -- 854 ------------------------ 855 856 procedure Set_Elem_Alignment (E : Entity_Id; Align : Nat := 0) is 857 begin 858 -- Do not set alignment for packed array types, this is handled in the 859 -- backend. 860 861 if Is_Packed_Array_Impl_Type (E) then 862 return; 863 864 -- If there is an alignment clause, then we respect it 865 866 elsif Has_Alignment_Clause (E) then 867 return; 868 869 -- If the size is not set, then don't attempt to set the alignment. This 870 -- happens in the backend layout case for access-to-subprogram types. 871 872 elsif not Known_Static_Esize (E) then 873 return; 874 875 -- For access types, do not set the alignment if the size is less than 876 -- the allowed minimum size. This avoids cascaded error messages. 877 878 elsif Is_Access_Type (E) and then Esize (E) < System_Address_Size then 879 return; 880 end if; 881 882 -- We attempt to set the alignment in all the other cases 883 884 declare 885 S : Int; 886 A : Nat; 887 M : Nat; 888 889 begin 890 -- The given Esize may be larger that int'last because of a previous 891 -- error, and the call to UI_To_Int will fail, so use default. 892 893 if Esize (E) / SSU > Ttypes.Maximum_Alignment then 894 S := Ttypes.Maximum_Alignment; 895 896 -- If this is an access type and the target doesn't have strict 897 -- alignment, then cap the alignment to that of a regular access 898 -- type. This will avoid giving fat pointers twice the usual 899 -- alignment for no practical benefit since the misalignment doesn't 900 -- really matter. 901 902 elsif Is_Access_Type (E) 903 and then not Target_Strict_Alignment 904 then 905 S := System_Address_Size / SSU; 906 907 else 908 S := UI_To_Int (Esize (E)) / SSU; 909 end if; 910 911 -- If the default alignment of "double" floating-point types is 912 -- specifically capped, enforce the cap. 913 914 if Ttypes.Target_Double_Float_Alignment > 0 915 and then S = 8 916 and then Is_Floating_Point_Type (E) 917 then 918 M := Ttypes.Target_Double_Float_Alignment; 919 920 -- If the default alignment of "double" or larger scalar types is 921 -- specifically capped, enforce the cap. 922 923 elsif Ttypes.Target_Double_Scalar_Alignment > 0 924 and then S >= 8 925 and then Is_Scalar_Type (E) 926 then 927 M := Ttypes.Target_Double_Scalar_Alignment; 928 929 -- Otherwise enforce the overall alignment cap 930 931 else 932 M := Ttypes.Maximum_Alignment; 933 end if; 934 935 -- We calculate the alignment as the largest power-of-two multiple 936 -- of System.Storage_Unit that does not exceed the object size of 937 -- the type and the maximum allowed alignment, if none was specified. 938 -- Otherwise we only cap it to the maximum allowed alignment. 939 940 if Align = 0 then 941 A := 1; 942 while 2 * A <= S and then 2 * A <= M loop 943 A := 2 * A; 944 end loop; 945 else 946 A := Nat'Min (Align, M); 947 end if; 948 949 -- If alignment is currently not set, then we can safely set it to 950 -- this new calculated value. 951 952 if Unknown_Alignment (E) then 953 Init_Alignment (E, A); 954 955 -- Cases where we have inherited an alignment 956 957 -- For constructed types, always reset the alignment, these are 958 -- generally invisible to the user anyway, and that way we are 959 -- sure that no constructed types have weird alignments. 960 961 elsif not Comes_From_Source (E) then 962 Init_Alignment (E, A); 963 964 -- If this inherited alignment is the same as the one we computed, 965 -- then obviously everything is fine, and we do not need to reset it. 966 967 elsif Alignment (E) = A then 968 null; 969 970 else 971 -- Now we come to the difficult cases of subtypes for which we 972 -- have inherited an alignment different from the computed one. 973 -- We resort to the presence of alignment and size clauses to 974 -- guide our choices. Note that they can generally be present 975 -- only on the first subtype (except for Object_Size) and that 976 -- we need to look at the Rep_Item chain to correctly handle 977 -- derived types. 978 979 declare 980 FST : constant Entity_Id := First_Subtype (E); 981 982 function Has_Attribute_Clause 983 (E : Entity_Id; 984 Id : Attribute_Id) return Boolean; 985 -- Wrapper around Get_Attribute_Definition_Clause which tests 986 -- for the presence of the specified attribute clause. 987 988 -------------------------- 989 -- Has_Attribute_Clause -- 990 -------------------------- 991 992 function Has_Attribute_Clause 993 (E : Entity_Id; 994 Id : Attribute_Id) return Boolean is 995 begin 996 return Present (Get_Attribute_Definition_Clause (E, Id)); 997 end Has_Attribute_Clause; 998 999 begin 1000 -- If the alignment comes from a clause, then we respect it. 1001 -- Consider for example: 1002 1003 -- type R is new Character; 1004 -- for R'Alignment use 1; 1005 -- for R'Size use 16; 1006 -- subtype S is R; 1007 1008 -- Here R has a specified size of 16 and a specified alignment 1009 -- of 1, and it seems right for S to inherit both values. 1010 1011 if Has_Attribute_Clause (FST, Attribute_Alignment) then 1012 null; 1013 1014 -- Now we come to the cases where we have inherited alignment 1015 -- and size, and overridden the size but not the alignment. 1016 1017 elsif Has_Attribute_Clause (FST, Attribute_Size) 1018 or else Has_Attribute_Clause (FST, Attribute_Object_Size) 1019 or else Has_Attribute_Clause (E, Attribute_Object_Size) 1020 then 1021 -- This is tricky, it might be thought that we should try to 1022 -- inherit the alignment, since that's what the RM implies, 1023 -- but that leads to complex rules and oddities. Consider 1024 -- for example: 1025 1026 -- type R is new Character; 1027 -- for R'Size use 16; 1028 1029 -- It seems quite bogus in this case to inherit an alignment 1030 -- of 1 from the parent type Character. Furthermore, if that 1031 -- is what the programmer really wanted for some odd reason, 1032 -- then he could specify the alignment directly. 1033 1034 -- Moreover we really don't want to inherit the alignment in 1035 -- the case of a specified Object_Size for a subtype, since 1036 -- there would be no way of overriding to give a reasonable 1037 -- value (as we don't have an Object_Alignment attribute). 1038 -- Consider for example: 1039 1040 -- subtype R is Character; 1041 -- for R'Object_Size use 16; 1042 1043 -- If we inherit the alignment of 1, then it will be very 1044 -- inefficient for the subtype and this cannot be fixed. 1045 1046 -- So we make the decision that if Size (or Object_Size) is 1047 -- given and the alignment is not specified with a clause, 1048 -- we reset the alignment to the appropriate value for the 1049 -- specified size. This is a nice simple rule to implement 1050 -- and document. 1051 1052 -- There is a theoretical glitch, which is that a confirming 1053 -- size clause could now change the alignment, which, if we 1054 -- really think that confirming rep clauses should have no 1055 -- effect, could be seen as a no-no. However that's already 1056 -- implemented by Alignment_Check_For_Size_Change so we do 1057 -- not change the philosophy here. 1058 1059 -- Historical note: in versions prior to Nov 6th, 2011, an 1060 -- odd distinction was made between inherited alignments 1061 -- larger than the computed alignment (where the larger 1062 -- alignment was inherited) and inherited alignments smaller 1063 -- than the computed alignment (where the smaller alignment 1064 -- was overridden). This was a dubious fix to get around an 1065 -- ACATS problem which seems to have disappeared anyway, and 1066 -- in any case, this peculiarity was never documented. 1067 1068 Init_Alignment (E, A); 1069 1070 -- If no Size (or Object_Size) was specified, then we have 1071 -- inherited the object size, so we should also inherit the 1072 -- alignment and not modify it. 1073 1074 else 1075 null; 1076 end if; 1077 end; 1078 end if; 1079 end; 1080 end Set_Elem_Alignment; 1081 1082end Layout; 1083