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