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