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 -- For array base types, set the component size if object size of the 439 -- component type is known and is a small power of 2 (8, 16, 32, 64), 440 -- since this is what will always be used, except if a very large 441 -- alignment was specified and so Adjust_Esize_For_Alignment gave up 442 -- because, in this case, the object size is not a multiple of the 443 -- alignment and, therefore, cannot be the component size. 444 445 if Ekind (E) = E_Array_Type and then Unknown_Component_Size (E) then 446 declare 447 CT : constant Entity_Id := Component_Type (E); 448 449 begin 450 -- For some reason, access types can cause trouble, So let's 451 -- just do this for scalar types ??? 452 453 if Present (CT) 454 and then Is_Scalar_Type (CT) 455 and then Known_Static_Esize (CT) 456 and then not (Known_Alignment (CT) 457 and then Alignment_In_Bits (CT) > 458 Standard_Long_Long_Integer_Size) 459 then 460 declare 461 S : constant Uint := Esize (CT); 462 begin 463 if Addressable (S) then 464 Set_Component_Size (E, S); 465 end if; 466 end; 467 end if; 468 end; 469 end if; 470 end if; 471 472 -- Even if the backend performs the layout, we still do a little in 473 -- the front end 474 475 -- Processing for record types 476 477 if Is_Record_Type (E) then 478 479 -- Special remaining processing for record types with a known 480 -- size of 16, 32, or 64 bits whose alignment is not yet set. 481 -- For these types, we set a corresponding alignment matching 482 -- the size if possible, or as large as possible if not. 483 484 if Convention (E) = Convention_Ada and then not Debug_Flag_Q then 485 Set_Composite_Alignment (E); 486 end if; 487 488 -- Processing for array types 489 490 elsif Is_Array_Type (E) then 491 492 -- For arrays that are required to be atomic/VFA, we do the same 493 -- processing as described above for short records, since we 494 -- really need to have the alignment set for the whole array. 495 496 if Is_Atomic_Or_VFA (E) and then not Debug_Flag_Q then 497 Set_Composite_Alignment (E); 498 end if; 499 500 -- For unpacked array types, set an alignment of 1 if we know 501 -- that the component alignment is not greater than 1. The reason 502 -- we do this is to avoid unnecessary copying of slices of such 503 -- arrays when passed to subprogram parameters (see special test 504 -- in Exp_Ch6.Expand_Actuals). 505 506 if not Is_Packed (E) and then Unknown_Alignment (E) then 507 if Known_Static_Component_Size (E) 508 and then Component_Size (E) = 1 509 then 510 Set_Alignment (E, Uint_1); 511 end if; 512 end if; 513 514 -- We need to know whether the size depends on the value of one 515 -- or more discriminants to select the return mechanism. Skip if 516 -- errors are present, to prevent cascaded messages. 517 518 if Serious_Errors_Detected = 0 then 519 Compute_Size_Depends_On_Discriminant (E); 520 end if; 521 end if; 522 523 -- Final step is to check that Esize and RM_Size are compatible 524 525 if Known_Static_Esize (E) and then Known_Static_RM_Size (E) then 526 if Esize (E) < RM_Size (E) then 527 528 -- Esize is less than RM_Size. That's not good. First we test 529 -- whether this was set deliberately with an Object_Size clause 530 -- and if so, object to the clause. 531 532 if Has_Object_Size_Clause (E) then 533 Error_Msg_Uint_1 := RM_Size (E); 534 Error_Msg_F 535 ("object size is too small, minimum allowed is ^", 536 Expression (Get_Attribute_Definition_Clause 537 (E, Attribute_Object_Size))); 538 end if; 539 540 -- Adjust Esize up to RM_Size value 541 542 declare 543 Size : constant Uint := RM_Size (E); 544 545 begin 546 Set_Esize (E, RM_Size (E)); 547 548 -- For scalar types, increase Object_Size to power of 2, but 549 -- not less than a storage unit in any case (i.e., normally 550 -- this means it will be storage-unit addressable). 551 552 if Is_Scalar_Type (E) then 553 if Size <= SSU then 554 Init_Esize (E, SSU); 555 elsif Size <= 16 then 556 Init_Esize (E, 16); 557 elsif Size <= 32 then 558 Init_Esize (E, 32); 559 else 560 Set_Esize (E, (Size + 63) / 64 * 64); 561 end if; 562 563 -- Finally, make sure that alignment is consistent with 564 -- the newly assigned size. 565 566 while Alignment (E) * SSU < Esize (E) 567 and then Alignment (E) < Maximum_Alignment 568 loop 569 Set_Alignment (E, 2 * Alignment (E)); 570 end loop; 571 end if; 572 end; 573 end if; 574 end if; 575 end Layout_Type; 576 577 ----------------------------- 578 -- Set_Composite_Alignment -- 579 ----------------------------- 580 581 procedure Set_Composite_Alignment (E : Entity_Id) is 582 Siz : Uint; 583 Align : Nat; 584 585 begin 586 -- If alignment is already set, then nothing to do 587 588 if Known_Alignment (E) then 589 return; 590 end if; 591 592 -- Alignment is not known, see if we can set it, taking into account 593 -- the setting of the Optimize_Alignment mode. 594 595 -- If Optimize_Alignment is set to Space, then we try to give packed 596 -- records an aligmment of 1, unless there is some reason we can't. 597 598 if Optimize_Alignment_Space (E) 599 and then Is_Record_Type (E) 600 and then Is_Packed (E) 601 then 602 -- No effect for record with atomic/VFA components 603 604 if Is_Atomic_Or_VFA (E) then 605 Error_Msg_N ("Optimize_Alignment has no effect for &??", E); 606 607 if Is_Atomic (E) then 608 Error_Msg_N 609 ("\pragma ignored for atomic record??", E); 610 else 611 Error_Msg_N 612 ("\pragma ignored for bolatile full access record??", E); 613 end if; 614 615 return; 616 end if; 617 618 -- No effect if independent components 619 620 if Has_Independent_Components (E) then 621 Error_Msg_N ("Optimize_Alignment has no effect for &??", E); 622 Error_Msg_N 623 ("\pragma ignored for record with independent components??", E); 624 return; 625 end if; 626 627 -- No effect if any component is atomic/VFA or is a by-reference type 628 629 declare 630 Ent : Entity_Id; 631 632 begin 633 Ent := First_Component_Or_Discriminant (E); 634 while Present (Ent) loop 635 if Is_By_Reference_Type (Etype (Ent)) 636 or else Is_Atomic_Or_VFA (Etype (Ent)) 637 or else Is_Atomic_Or_VFA (Ent) 638 then 639 Error_Msg_N ("Optimize_Alignment has no effect for &??", E); 640 641 if Is_Atomic (Etype (Ent)) or else Is_Atomic (Ent) then 642 Error_Msg_N 643 ("\pragma is ignored if atomic " 644 & "components present??", E); 645 else 646 Error_Msg_N 647 ("\pragma is ignored if bolatile full access " 648 & "components present??", E); 649 end if; 650 651 return; 652 else 653 Next_Component_Or_Discriminant (Ent); 654 end if; 655 end loop; 656 end; 657 658 -- Optimize_Alignment has no effect on variable length record 659 660 if not Size_Known_At_Compile_Time (E) then 661 Error_Msg_N ("Optimize_Alignment has no effect for &??", E); 662 Error_Msg_N ("\pragma is ignored for variable length record??", E); 663 return; 664 end if; 665 666 -- All tests passed, we can set alignment to 1 667 668 Align := 1; 669 670 -- Not a record, or not packed 671 672 else 673 -- The only other cases we worry about here are where the size is 674 -- statically known at compile time. 675 676 if Known_Static_Esize (E) then 677 Siz := Esize (E); 678 elsif Unknown_Esize (E) and then Known_Static_RM_Size (E) then 679 Siz := RM_Size (E); 680 else 681 return; 682 end if; 683 684 -- Size is known, alignment is not set 685 686 -- Reset alignment to match size if the known size is exactly 2, 4, 687 -- or 8 storage units. 688 689 if Siz = 2 * SSU then 690 Align := 2; 691 elsif Siz = 4 * SSU then 692 Align := 4; 693 elsif Siz = 8 * SSU then 694 Align := 8; 695 696 -- If Optimize_Alignment is set to Space, then make sure the 697 -- alignment matches the size, for example, if the size is 17 698 -- bytes then we want an alignment of 1 for the type. 699 700 elsif Optimize_Alignment_Space (E) then 701 if Siz mod (8 * SSU) = 0 then 702 Align := 8; 703 elsif Siz mod (4 * SSU) = 0 then 704 Align := 4; 705 elsif Siz mod (2 * SSU) = 0 then 706 Align := 2; 707 else 708 Align := 1; 709 end if; 710 711 -- If Optimize_Alignment is set to Time, then we reset for odd 712 -- "in between sizes", for example a 17 bit record is given an 713 -- alignment of 4. 714 715 elsif Optimize_Alignment_Time (E) 716 and then Siz > SSU 717 and then Siz <= 8 * SSU 718 then 719 if Siz <= 2 * SSU then 720 Align := 2; 721 elsif Siz <= 4 * SSU then 722 Align := 4; 723 else -- Siz <= 8 * SSU then 724 Align := 8; 725 end if; 726 727 -- No special alignment fiddling needed 728 729 else 730 return; 731 end if; 732 end if; 733 734 -- Here we have Set Align to the proposed improved value. Make sure the 735 -- value set does not exceed Maximum_Alignment for the target. 736 737 if Align > Maximum_Alignment then 738 Align := Maximum_Alignment; 739 end if; 740 741 -- Further processing for record types only to reduce the alignment 742 -- set by the above processing in some specific cases. We do not 743 -- do this for atomic/VFA records, since we need max alignment there, 744 745 if Is_Record_Type (E) and then not Is_Atomic_Or_VFA (E) then 746 747 -- For records, there is generally no point in setting alignment 748 -- higher than word size since we cannot do better than move by 749 -- words in any case. Omit this if we are optimizing for time, 750 -- since conceivably we may be able to do better. 751 752 if Align > System_Word_Size / SSU 753 and then not Optimize_Alignment_Time (E) 754 then 755 Align := System_Word_Size / SSU; 756 end if; 757 758 -- Check components. If any component requires a higher alignment, 759 -- then we set that higher alignment in any case. Don't do this if we 760 -- have Optimize_Alignment set to Space. Note that covers the case of 761 -- packed records, where we already set alignment to 1. 762 763 if not Optimize_Alignment_Space (E) then 764 declare 765 Comp : Entity_Id; 766 767 begin 768 Comp := First_Component (E); 769 while Present (Comp) loop 770 if Known_Alignment (Etype (Comp)) then 771 declare 772 Calign : constant Uint := Alignment (Etype (Comp)); 773 774 begin 775 -- The cases to process are when the alignment of the 776 -- component type is larger than the alignment we have 777 -- so far, and either there is no component clause for 778 -- the component, or the length set by the component 779 -- clause matches the length of the component type. 780 781 if Calign > Align 782 and then 783 (Unknown_Esize (Comp) 784 or else (Known_Static_Esize (Comp) 785 and then 786 Esize (Comp) = Calign * SSU)) 787 then 788 Align := UI_To_Int (Calign); 789 end if; 790 end; 791 end if; 792 793 Next_Component (Comp); 794 end loop; 795 end; 796 end if; 797 end if; 798 799 -- Set chosen alignment, and increase Esize if necessary to match the 800 -- chosen alignment. 801 802 Set_Alignment (E, UI_From_Int (Align)); 803 804 if Known_Static_Esize (E) 805 and then Esize (E) < Align * SSU 806 then 807 Set_Esize (E, UI_From_Int (Align * SSU)); 808 end if; 809 end Set_Composite_Alignment; 810 811 -------------------------- 812 -- Set_Discrete_RM_Size -- 813 -------------------------- 814 815 procedure Set_Discrete_RM_Size (Def_Id : Entity_Id) is 816 FST : constant Entity_Id := First_Subtype (Def_Id); 817 818 begin 819 -- All discrete types except for the base types in standard are 820 -- constrained, so indicate this by setting Is_Constrained. 821 822 Set_Is_Constrained (Def_Id); 823 824 -- Set generic types to have an unknown size, since the representation 825 -- of a generic type is irrelevant, in view of the fact that they have 826 -- nothing to do with code. 827 828 if Is_Generic_Type (Root_Type (FST)) then 829 Set_RM_Size (Def_Id, Uint_0); 830 831 -- If the subtype statically matches the first subtype, then it is 832 -- required to have exactly the same layout. This is required by 833 -- aliasing considerations. 834 835 elsif Def_Id /= FST and then 836 Subtypes_Statically_Match (Def_Id, FST) 837 then 838 Set_RM_Size (Def_Id, RM_Size (FST)); 839 Set_Size_Info (Def_Id, FST); 840 841 -- In all other cases the RM_Size is set to the minimum size. Note that 842 -- this routine is never called for subtypes for which the RM_Size is 843 -- set explicitly by an attribute clause. 844 845 else 846 Set_RM_Size (Def_Id, UI_From_Int (Minimum_Size (Def_Id))); 847 end if; 848 end Set_Discrete_RM_Size; 849 850 ------------------------ 851 -- Set_Elem_Alignment -- 852 ------------------------ 853 854 procedure Set_Elem_Alignment (E : Entity_Id; Align : Nat := 0) is 855 begin 856 -- Do not set alignment for packed array types, this is handled in the 857 -- backend. 858 859 if Is_Packed_Array_Impl_Type (E) then 860 return; 861 862 -- If there is an alignment clause, then we respect it 863 864 elsif Has_Alignment_Clause (E) then 865 return; 866 867 -- If the size is not set, then don't attempt to set the alignment. This 868 -- happens in the backend layout case for access-to-subprogram types. 869 870 elsif not Known_Static_Esize (E) then 871 return; 872 873 -- For access types, do not set the alignment if the size is less than 874 -- the allowed minimum size. This avoids cascaded error messages. 875 876 elsif Is_Access_Type (E) and then Esize (E) < System_Address_Size then 877 return; 878 end if; 879 880 -- We attempt to set the alignment in all the other cases 881 882 declare 883 S : Int; 884 A : Nat; 885 M : Nat; 886 887 begin 888 -- The given Esize may be larger that int'last because of a previous 889 -- error, and the call to UI_To_Int will fail, so use default. 890 891 if Esize (E) / SSU > Ttypes.Maximum_Alignment then 892 S := Ttypes.Maximum_Alignment; 893 894 -- If this is an access type and the target doesn't have strict 895 -- alignment, then cap the alignment to that of a regular access 896 -- type. This will avoid giving fat pointers twice the usual 897 -- alignment for no practical benefit since the misalignment doesn't 898 -- really matter. 899 900 elsif Is_Access_Type (E) 901 and then not Target_Strict_Alignment 902 then 903 S := System_Address_Size / SSU; 904 905 else 906 S := UI_To_Int (Esize (E)) / SSU; 907 end if; 908 909 -- If the default alignment of "double" floating-point types is 910 -- specifically capped, enforce the cap. 911 912 if Ttypes.Target_Double_Float_Alignment > 0 913 and then S = 8 914 and then Is_Floating_Point_Type (E) 915 then 916 M := Ttypes.Target_Double_Float_Alignment; 917 918 -- If the default alignment of "double" or larger scalar types is 919 -- specifically capped, enforce the cap. 920 921 elsif Ttypes.Target_Double_Scalar_Alignment > 0 922 and then S >= 8 923 and then Is_Scalar_Type (E) 924 then 925 M := Ttypes.Target_Double_Scalar_Alignment; 926 927 -- Otherwise enforce the overall alignment cap 928 929 else 930 M := Ttypes.Maximum_Alignment; 931 end if; 932 933 -- We calculate the alignment as the largest power-of-two multiple 934 -- of System.Storage_Unit that does not exceed the object size of 935 -- the type and the maximum allowed alignment, if none was specified. 936 -- Otherwise we only cap it to the maximum allowed alignment. 937 938 if Align = 0 then 939 A := 1; 940 while 2 * A <= S and then 2 * A <= M loop 941 A := 2 * A; 942 end loop; 943 else 944 A := Nat'Min (Align, M); 945 end if; 946 947 -- If alignment is currently not set, then we can safely set it to 948 -- this new calculated value. 949 950 if Unknown_Alignment (E) then 951 Init_Alignment (E, A); 952 953 -- Cases where we have inherited an alignment 954 955 -- For constructed types, always reset the alignment, these are 956 -- generally invisible to the user anyway, and that way we are 957 -- sure that no constructed types have weird alignments. 958 959 elsif not Comes_From_Source (E) then 960 Init_Alignment (E, A); 961 962 -- If this inherited alignment is the same as the one we computed, 963 -- then obviously everything is fine, and we do not need to reset it. 964 965 elsif Alignment (E) = A then 966 null; 967 968 else 969 -- Now we come to the difficult cases of subtypes for which we 970 -- have inherited an alignment different from the computed one. 971 -- We resort to the presence of alignment and size clauses to 972 -- guide our choices. Note that they can generally be present 973 -- only on the first subtype (except for Object_Size) and that 974 -- we need to look at the Rep_Item chain to correctly handle 975 -- derived types. 976 977 declare 978 FST : constant Entity_Id := First_Subtype (E); 979 980 function Has_Attribute_Clause 981 (E : Entity_Id; 982 Id : Attribute_Id) return Boolean; 983 -- Wrapper around Get_Attribute_Definition_Clause which tests 984 -- for the presence of the specified attribute clause. 985 986 -------------------------- 987 -- Has_Attribute_Clause -- 988 -------------------------- 989 990 function Has_Attribute_Clause 991 (E : Entity_Id; 992 Id : Attribute_Id) return Boolean is 993 begin 994 return Present (Get_Attribute_Definition_Clause (E, Id)); 995 end Has_Attribute_Clause; 996 997 begin 998 -- If the alignment comes from a clause, then we respect it. 999 -- Consider for example: 1000 1001 -- type R is new Character; 1002 -- for R'Alignment use 1; 1003 -- for R'Size use 16; 1004 -- subtype S is R; 1005 1006 -- Here R has a specified size of 16 and a specified alignment 1007 -- of 1, and it seems right for S to inherit both values. 1008 1009 if Has_Attribute_Clause (FST, Attribute_Alignment) then 1010 null; 1011 1012 -- Now we come to the cases where we have inherited alignment 1013 -- and size, and overridden the size but not the alignment. 1014 1015 elsif Has_Attribute_Clause (FST, Attribute_Size) 1016 or else Has_Attribute_Clause (FST, Attribute_Object_Size) 1017 or else Has_Attribute_Clause (E, Attribute_Object_Size) 1018 then 1019 -- This is tricky, it might be thought that we should try to 1020 -- inherit the alignment, since that's what the RM implies, 1021 -- but that leads to complex rules and oddities. Consider 1022 -- for example: 1023 1024 -- type R is new Character; 1025 -- for R'Size use 16; 1026 1027 -- It seems quite bogus in this case to inherit an alignment 1028 -- of 1 from the parent type Character. Furthermore, if that 1029 -- is what the programmer really wanted for some odd reason, 1030 -- then he could specify the alignment directly. 1031 1032 -- Moreover we really don't want to inherit the alignment in 1033 -- the case of a specified Object_Size for a subtype, since 1034 -- there would be no way of overriding to give a reasonable 1035 -- value (as we don't have an Object_Alignment attribute). 1036 -- Consider for example: 1037 1038 -- subtype R is Character; 1039 -- for R'Object_Size use 16; 1040 1041 -- If we inherit the alignment of 1, then it will be very 1042 -- inefficient for the subtype and this cannot be fixed. 1043 1044 -- So we make the decision that if Size (or Object_Size) is 1045 -- given and the alignment is not specified with a clause, 1046 -- we reset the alignment to the appropriate value for the 1047 -- specified size. This is a nice simple rule to implement 1048 -- and document. 1049 1050 -- There is a theoretical glitch, which is that a confirming 1051 -- size clause could now change the alignment, which, if we 1052 -- really think that confirming rep clauses should have no 1053 -- effect, could be seen as a no-no. However that's already 1054 -- implemented by Alignment_Check_For_Size_Change so we do 1055 -- not change the philosophy here. 1056 1057 -- Historical note: in versions prior to Nov 6th, 2011, an 1058 -- odd distinction was made between inherited alignments 1059 -- larger than the computed alignment (where the larger 1060 -- alignment was inherited) and inherited alignments smaller 1061 -- than the computed alignment (where the smaller alignment 1062 -- was overridden). This was a dubious fix to get around an 1063 -- ACATS problem which seems to have disappeared anyway, and 1064 -- in any case, this peculiarity was never documented. 1065 1066 Init_Alignment (E, A); 1067 1068 -- If no Size (or Object_Size) was specified, then we have 1069 -- inherited the object size, so we should also inherit the 1070 -- alignment and not modify it. 1071 1072 else 1073 null; 1074 end if; 1075 end; 1076 end if; 1077 end; 1078 end Set_Elem_Alignment; 1079 1080end Layout; 1081