1------------------------------------------------------------------------------ 2-- -- 3-- GNAT COMPILER COMPONENTS -- 4-- -- 5-- E X P _ C H 1 3 -- 6-- -- 7-- B o d y -- 8-- -- 9-- Copyright (C) 1992-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 Checks; use Checks; 28with Einfo; use Einfo; 29with Exp_Ch3; use Exp_Ch3; 30with Exp_Ch6; 31with Exp_Imgv; use Exp_Imgv; 32with Exp_Tss; use Exp_Tss; 33with Exp_Util; use Exp_Util; 34with Freeze; use Freeze; 35with Namet; use Namet; 36with Nlists; use Nlists; 37with Nmake; use Nmake; 38with Opt; use Opt; 39with Restrict; use Restrict; 40with Rident; use Rident; 41with Rtsfind; use Rtsfind; 42with Sem; use Sem; 43with Sem_Aux; use Sem_Aux; 44with Sem_Ch7; use Sem_Ch7; 45with Sem_Ch8; use Sem_Ch8; 46with Sem_Eval; use Sem_Eval; 47with Sem_Util; use Sem_Util; 48with Sinfo; use Sinfo; 49with Snames; use Snames; 50with Tbuild; use Tbuild; 51with Uintp; use Uintp; 52with Validsw; use Validsw; 53 54package body Exp_Ch13 is 55 56 ------------------------------------------ 57 -- Expand_N_Attribute_Definition_Clause -- 58 ------------------------------------------ 59 60 -- Expansion action depends on attribute involved 61 62 procedure Expand_N_Attribute_Definition_Clause (N : Node_Id) is 63 Loc : constant Source_Ptr := Sloc (N); 64 Exp : constant Node_Id := Expression (N); 65 Ent : Entity_Id; 66 V : Node_Id; 67 68 begin 69 Ent := Entity (Name (N)); 70 71 if Is_Type (Ent) then 72 Ent := Underlying_Type (Ent); 73 end if; 74 75 case Get_Attribute_Id (Chars (N)) is 76 77 ------------- 78 -- Address -- 79 ------------- 80 81 when Attribute_Address => 82 83 -- If there is an initialization which did not come from the 84 -- source program, then it is an artifact of our expansion, and we 85 -- suppress it. The case we are most concerned about here is the 86 -- initialization of a packed array to all false, which seems 87 -- inappropriate for variable to which an address clause is 88 -- applied. The expression may itself have been rewritten if the 89 -- type is packed array, so we need to examine whether the 90 -- original node is in the source. An exception though is the case 91 -- of an access variable which is default initialized to null, and 92 -- such initialization is retained. 93 94 -- Furthermore, if the initialization is the equivalent aggregate 95 -- of the type initialization procedure, it replaces an implicit 96 -- call to the init proc, and must be respected. Note that for 97 -- packed types we do not build equivalent aggregates. 98 99 -- Also, if Init_Or_Norm_Scalars applies, then we need to retain 100 -- any default initialization for objects of scalar types and 101 -- types with scalar components. Normally a composite type will 102 -- have an init_proc in the presence of Init_Or_Norm_Scalars, 103 -- so when that flag is set we have just have to do a test for 104 -- scalar and string types (the predefined string types such as 105 -- String and Wide_String don't have an init_proc). 106 107 declare 108 Decl : constant Node_Id := Declaration_Node (Ent); 109 Typ : constant Entity_Id := Etype (Ent); 110 111 begin 112 if Nkind (Decl) = N_Object_Declaration 113 and then Present (Expression (Decl)) 114 and then Nkind (Expression (Decl)) /= N_Null 115 and then 116 not Comes_From_Source (Original_Node (Expression (Decl))) 117 then 118 if Present (Base_Init_Proc (Typ)) 119 and then 120 Present (Static_Initialization (Base_Init_Proc (Typ))) 121 then 122 null; 123 124 elsif Init_Or_Norm_Scalars 125 and then (Is_Scalar_Type (Typ) 126 or else Is_String_Type (Typ)) 127 then 128 null; 129 130 else 131 Set_Expression (Decl, Empty); 132 end if; 133 134 -- An object declaration to which an address clause applies 135 -- has a delayed freeze, but the address expression itself 136 -- must be elaborated at the point it appears. If the object 137 -- is controlled, additional checks apply elsewhere. 138 -- If the attribute comes from an aspect specification it 139 -- is being elaborated at the freeze point and side effects 140 -- need not be removed (and shouldn't, if the expression 141 -- depends on other entities that have delayed freeze). 142 -- This is another consequence of the delayed analysis of 143 -- aspects, and a real semantic difference. 144 145 elsif Nkind (Decl) = N_Object_Declaration 146 and then not Needs_Constant_Address (Decl, Typ) 147 and then not From_Aspect_Specification (N) 148 then 149 Remove_Side_Effects (Exp); 150 end if; 151 end; 152 153 --------------- 154 -- Alignment -- 155 --------------- 156 157 when Attribute_Alignment => 158 159 -- As required by Gigi, we guarantee that the operand is an 160 -- integer literal (this simplifies things in Gigi). 161 162 if Nkind (Exp) /= N_Integer_Literal then 163 Rewrite (Exp, Make_Integer_Literal (Loc, Expr_Value (Exp))); 164 end if; 165 166 -- A complex case arises if the alignment clause applies to an 167 -- unconstrained object initialized with a function call. The 168 -- result of the call is placed on the secondary stack, and the 169 -- declaration is rewritten as a renaming of a dereference, which 170 -- fails expansion. We must introduce a temporary and assign its 171 -- value to the existing entity. 172 173 if Nkind (Parent (Ent)) = N_Object_Renaming_Declaration 174 and then not Is_Entity_Name (Renamed_Object (Ent)) 175 then 176 declare 177 Decl : constant Node_Id := Parent (Ent); 178 Loc : constant Source_Ptr := Sloc (N); 179 Temp : constant Entity_Id := Make_Temporary (Loc, 'T'); 180 181 New_Decl : Node_Id; 182 183 begin 184 -- Replace entity with temporary and reanalyze 185 186 Set_Defining_Identifier (Decl, Temp); 187 Set_Analyzed (Decl, False); 188 Analyze (Decl); 189 190 -- Introduce new declaration for entity but do not reanalyze 191 -- because entity is already in scope. Type and expression 192 -- are already resolved. 193 194 New_Decl := 195 Make_Object_Declaration (Loc, 196 Defining_Identifier => Ent, 197 Object_Definition => 198 New_Occurrence_Of (Etype (Ent), Loc), 199 Expression => New_Occurrence_Of (Temp, Loc)); 200 201 Set_Renamed_Object (Ent, Empty); 202 Insert_After (Decl, New_Decl); 203 Set_Analyzed (Decl); 204 end; 205 end if; 206 207 ------------------ 208 -- Storage_Size -- 209 ------------------ 210 211 when Attribute_Storage_Size => 212 213 -- If the type is a task type, then assign the value of the 214 -- storage size to the Size variable associated with the task. 215 -- Insert the assignment right after the declaration of the Size 216 -- variable. 217 218 -- Generate: 219 220 -- task_typeZ := expression 221 222 if Ekind (Ent) = E_Task_Type then 223 224 declare 225 Assign : Node_Id; 226 begin 227 Assign := 228 Make_Assignment_Statement (Loc, 229 Name => 230 New_Occurrence_Of (Storage_Size_Variable (Ent), Loc), 231 Expression => 232 Convert_To (RTE (RE_Size_Type), Expression (N))); 233 234 -- If the clause is not generated by an aspect, insert 235 -- the assignment here. Freezing rules ensure that this 236 -- is safe, or clause will have been rejected already. 237 238 if Is_List_Member (N) then 239 Insert_After (N, Assign); 240 241 -- Otherwise, insert assignment after task declaration. 242 243 else 244 Insert_After 245 (Parent (Storage_Size_Variable (Entity (N))), Assign); 246 end if; 247 248 Analyze (Assign); 249 end; 250 251 -- For Storage_Size for an access type, create a variable to hold 252 -- the value of the specified size with name typeV and expand an 253 -- assignment statement to initialize this value. 254 255 elsif Is_Access_Type (Ent) then 256 257 -- We don't need the variable for a storage size of zero 258 259 if not No_Pool_Assigned (Ent) then 260 V := 261 Make_Defining_Identifier (Loc, 262 Chars => New_External_Name (Chars (Ent), 'V')); 263 264 -- Insert the declaration of the object. If the expression 265 -- is not static it may depend on some other type that is 266 -- not frozen yet, so attach the declaration that captures 267 -- the value of the expression to the actions of the freeze 268 -- node of the current type. 269 270 declare 271 Decl : constant Node_Id := 272 Make_Object_Declaration (Loc, 273 Defining_Identifier => V, 274 Object_Definition => 275 New_Occurrence_Of (RTE (RE_Storage_Offset), Loc), 276 Expression => 277 Convert_To 278 (RTE (RE_Storage_Offset), Expression (N))); 279 begin 280 if not Is_OK_Static_Expression (Expression (N)) 281 and then Present (Freeze_Node (Ent)) 282 then 283 if No (Actions (Freeze_Node (Ent))) then 284 Set_Actions (Freeze_Node (Ent), New_List (Decl)); 285 else 286 Append (Decl, Actions (Freeze_Node (Ent))); 287 end if; 288 289 else 290 Insert_Action (N, Decl); 291 end if; 292 end; 293 294 Set_Storage_Size_Variable (Ent, Entity_Id (V)); 295 end if; 296 end if; 297 298 -- Other attributes require no expansion 299 300 when others => 301 null; 302 end case; 303 end Expand_N_Attribute_Definition_Clause; 304 305 ----------------------------- 306 -- Expand_N_Free_Statement -- 307 ----------------------------- 308 309 procedure Expand_N_Free_Statement (N : Node_Id) is 310 Expr : constant Node_Id := Expression (N); 311 Typ : Entity_Id; 312 313 begin 314 -- Certain run-time configurations and targets do not provide support 315 -- for controlled types. 316 317 if Restriction_Active (No_Finalization) then 318 return; 319 end if; 320 321 -- Use the base type to perform the check for finalization master 322 323 Typ := Etype (Expr); 324 325 if Ekind (Typ) = E_Access_Subtype then 326 Typ := Etype (Typ); 327 end if; 328 329 -- Handle private access types 330 331 if Is_Private_Type (Typ) 332 and then Present (Full_View (Typ)) 333 then 334 Typ := Full_View (Typ); 335 end if; 336 337 -- Do not create a custom Deallocate when freeing an object with 338 -- suppressed finalization. In such cases the object is never attached 339 -- to a master, so it does not need to be detached. Use a regular free 340 -- statement instead. 341 342 if No (Finalization_Master (Typ)) then 343 return; 344 end if; 345 346 -- Use a temporary to store the result of a complex expression. Perform 347 -- the following transformation: 348 -- 349 -- Free (Complex_Expression); 350 -- 351 -- Temp : constant Type_Of_Expression := Complex_Expression; 352 -- Free (Temp); 353 354 if Nkind (Expr) /= N_Identifier then 355 declare 356 Expr_Typ : constant Entity_Id := Etype (Expr); 357 Loc : constant Source_Ptr := Sloc (N); 358 New_Expr : Node_Id; 359 Temp_Id : Entity_Id; 360 361 begin 362 Temp_Id := Make_Temporary (Loc, 'T'); 363 Insert_Action (N, 364 Make_Object_Declaration (Loc, 365 Defining_Identifier => Temp_Id, 366 Object_Definition => New_Occurrence_Of (Expr_Typ, Loc), 367 Expression => Relocate_Node (Expr))); 368 369 New_Expr := New_Occurrence_Of (Temp_Id, Loc); 370 Set_Etype (New_Expr, Expr_Typ); 371 372 Set_Expression (N, New_Expr); 373 end; 374 end if; 375 376 -- Create a custom Deallocate for a controlled object. This routine 377 -- ensures that the hidden list header will be deallocated along with 378 -- the actual object. 379 380 Build_Allocate_Deallocate_Proc (N, Is_Allocate => False); 381 end Expand_N_Free_Statement; 382 383 ---------------------------- 384 -- Expand_N_Freeze_Entity -- 385 ---------------------------- 386 387 procedure Expand_N_Freeze_Entity (N : Node_Id) is 388 E : constant Entity_Id := Entity (N); 389 390 Decl : Node_Id; 391 Delete : Boolean := False; 392 E_Scope : Entity_Id; 393 In_Other_Scope : Boolean; 394 In_Outer_Scope : Boolean; 395 396 begin 397 -- If there are delayed aspect specifications, we insert them just 398 -- before the freeze node. They are already analyzed so we don't need 399 -- to reanalyze them (they were analyzed before the type was frozen), 400 -- but we want them in the tree for the back end, and so that the 401 -- listing from sprint is clearer on where these occur logically. 402 403 if Has_Delayed_Aspects (E) then 404 declare 405 Aitem : Node_Id; 406 Ritem : Node_Id; 407 408 begin 409 -- Look for aspect specs for this entity 410 411 Ritem := First_Rep_Item (E); 412 while Present (Ritem) loop 413 if Nkind (Ritem) = N_Aspect_Specification 414 and then Entity (Ritem) = E 415 then 416 Aitem := Aspect_Rep_Item (Ritem); 417 418 -- Skip this for aspects (e.g. Current_Value) for which 419 -- there is no corresponding pragma or attribute. 420 421 if Present (Aitem) 422 423 -- Also skip if we have a null statement rather than a 424 -- delayed aspect (this happens when we are ignoring rep 425 -- items from use of the -gnatI switch). 426 427 and then Nkind (Aitem) /= N_Null_Statement 428 then 429 pragma Assert (Is_Delayed_Aspect (Aitem)); 430 Insert_Before (N, Aitem); 431 end if; 432 end if; 433 434 Next_Rep_Item (Ritem); 435 end loop; 436 end; 437 end if; 438 439 -- Processing for objects 440 441 if Is_Object (E) then 442 if Present (Address_Clause (E)) then 443 Apply_Address_Clause_Check (E, N); 444 end if; 445 446 -- Analyze actions in freeze node, if any 447 448 if Present (Actions (N)) then 449 declare 450 Act : Node_Id; 451 begin 452 Act := First (Actions (N)); 453 while Present (Act) loop 454 Analyze (Act); 455 Next (Act); 456 end loop; 457 end; 458 end if; 459 460 -- If initialization statements have been captured in a compound 461 -- statement, insert them back into the tree now. 462 463 Explode_Initialization_Compound_Statement (E); 464 return; 465 466 -- Only other items requiring any front end action are types and 467 -- subprograms. 468 469 elsif not Is_Type (E) and then not Is_Subprogram (E) then 470 return; 471 end if; 472 473 -- Here E is a type or a subprogram 474 475 E_Scope := Scope (E); 476 477 -- This is an error protection against previous errors 478 479 if No (E_Scope) then 480 Check_Error_Detected; 481 return; 482 end if; 483 484 -- The entity may be a subtype declared for a constrained record 485 -- component, in which case the relevant scope is the scope of 486 -- the record. This happens for class-wide subtypes created for 487 -- a constrained type extension with inherited discriminants. 488 489 if Is_Type (E_Scope) 490 and then Ekind (E_Scope) not in Concurrent_Kind 491 then 492 E_Scope := Scope (E_Scope); 493 494 -- The entity may be a subtype declared for an iterator 495 496 elsif Ekind (E_Scope) = E_Loop then 497 E_Scope := Scope (E_Scope); 498 end if; 499 500 -- Remember that we are processing a freezing entity and its freezing 501 -- nodes. This flag (non-zero = set) is used to avoid the need of 502 -- climbing through the tree while processing the freezing actions (ie. 503 -- to avoid generating spurious warnings or to avoid killing constant 504 -- indications while processing the code associated with freezing 505 -- actions). We use a counter to deal with nesting. 506 507 Inside_Freezing_Actions := Inside_Freezing_Actions + 1; 508 509 -- If we are freezing entities defined in protected types, they belong 510 -- in the enclosing scope, given that the original type has been 511 -- expanded away. The same is true for entities in task types, in 512 -- particular the parameter records of entries (Entities in bodies are 513 -- all frozen within the body). If we are in the task body, this is a 514 -- proper scope. If we are within a subprogram body, the proper scope 515 -- is the corresponding spec. This may happen for itypes generated in 516 -- the bodies of protected operations. 517 518 if Ekind (E_Scope) = E_Protected_Type 519 or else (Ekind (E_Scope) = E_Task_Type 520 and then not Has_Completion (E_Scope)) 521 then 522 E_Scope := Scope (E_Scope); 523 524 elsif Ekind (E_Scope) = E_Subprogram_Body then 525 E_Scope := Corresponding_Spec (Unit_Declaration_Node (E_Scope)); 526 end if; 527 528 -- If the scope of the entity is in open scopes, it is the current one 529 -- or an enclosing one, including a loop, a block, or a subprogram. 530 531 if In_Open_Scopes (E_Scope) then 532 In_Other_Scope := False; 533 In_Outer_Scope := E_Scope /= Current_Scope; 534 535 -- Otherwise it is a local package or a different compilation unit 536 537 else 538 In_Other_Scope := True; 539 In_Outer_Scope := False; 540 end if; 541 542 -- If the entity being frozen is defined in a scope that is not 543 -- currently on the scope stack, we must establish the proper 544 -- visibility before freezing the entity and related subprograms. 545 546 if In_Other_Scope then 547 Push_Scope (E_Scope); 548 549 -- Finalizers are little odd in terms of freezing. The spec of the 550 -- procedure appears in the declarations while the body appears in 551 -- the statement part of a single construct. Since the finalizer must 552 -- be called by the At_End handler of the construct, the spec is 553 -- manually frozen right after its declaration. The only side effect 554 -- of this action appears in contexts where the construct is not in 555 -- its final resting place. These contexts are: 556 557 -- * Entry bodies - The declarations and statements are moved to 558 -- the procedure equivalen of the entry. 559 -- * Protected subprograms - The declarations and statements are 560 -- moved to the non-protected version of the subprogram. 561 -- * Task bodies - The declarations and statements are moved to the 562 -- task body procedure. 563 -- * Blocks that will be rewritten as subprograms when unnesting 564 -- is in effect. 565 566 -- Visible declarations do not need to be installed in these three 567 -- cases since it does not make semantic sense to do so. All entities 568 -- referenced by a finalizer are visible and already resolved, plus 569 -- the enclosing scope may not have visible declarations at all. 570 571 if Ekind (E) = E_Procedure 572 and then Is_Finalizer (E) 573 and then 574 (Is_Entry (E_Scope) 575 or else (Is_Subprogram (E_Scope) 576 and then Is_Protected_Type (Scope (E_Scope))) 577 or else Is_Task_Type (E_Scope) 578 or else Ekind (E_Scope) = E_Block) 579 then 580 null; 581 else 582 Install_Visible_Declarations (E_Scope); 583 end if; 584 585 if Is_Package_Or_Generic_Package (E_Scope) or else 586 Is_Protected_Type (E_Scope) or else 587 Is_Task_Type (E_Scope) 588 then 589 Install_Private_Declarations (E_Scope); 590 end if; 591 592 -- If the entity is in an outer scope, then that scope needs to 593 -- temporarily become the current scope so that operations created 594 -- during type freezing will be declared in the right scope and 595 -- can properly override any corresponding inherited operations. 596 597 elsif In_Outer_Scope then 598 Push_Scope (E_Scope); 599 end if; 600 601 -- If type, freeze the type 602 603 if Is_Type (E) then 604 Delete := Freeze_Type (N); 605 606 -- And for enumeration type, build the enumeration tables 607 608 if Is_Enumeration_Type (E) then 609 Build_Enumeration_Image_Tables (E, N); 610 end if; 611 612 -- If subprogram, freeze the subprogram 613 614 elsif Is_Subprogram (E) then 615 Exp_Ch6.Freeze_Subprogram (N); 616 617 -- Ada 2005 (AI-251): Remove the freezing node associated with the 618 -- entities internally used by the frontend to register primitives 619 -- covering abstract interfaces. The call to Freeze_Subprogram has 620 -- already expanded the code that fills the corresponding entry in 621 -- its secondary dispatch table and therefore the code generator 622 -- has nothing else to do with this freezing node. 623 624 Delete := Present (Interface_Alias (E)); 625 end if; 626 627 -- Analyze actions generated by freezing. The init_proc contains source 628 -- expressions that may raise Constraint_Error, and the assignment 629 -- procedure for complex types needs checks on individual component 630 -- assignments, but all other freezing actions should be compiled with 631 -- all checks off. 632 633 if Present (Actions (N)) then 634 Decl := First (Actions (N)); 635 while Present (Decl) loop 636 if Nkind (Decl) = N_Subprogram_Body 637 and then (Is_Init_Proc (Defining_Entity (Decl)) 638 or else 639 Chars (Defining_Entity (Decl)) = Name_uAssign) 640 then 641 Analyze (Decl); 642 643 -- A subprogram body created for a renaming_as_body completes 644 -- a previous declaration, which may be in a different scope. 645 -- Establish the proper scope before analysis. 646 647 elsif Nkind (Decl) = N_Subprogram_Body 648 and then Present (Corresponding_Spec (Decl)) 649 and then Scope (Corresponding_Spec (Decl)) /= Current_Scope 650 then 651 Push_Scope (Scope (Corresponding_Spec (Decl))); 652 Analyze (Decl, Suppress => All_Checks); 653 Pop_Scope; 654 655 -- We treat generated equality specially, if validity checks are 656 -- enabled, in order to detect components default-initialized 657 -- with invalid values. 658 659 elsif Nkind (Decl) = N_Subprogram_Body 660 and then Chars (Defining_Entity (Decl)) = Name_Op_Eq 661 and then Validity_Checks_On 662 and then Initialize_Scalars 663 then 664 declare 665 Save_Force : constant Boolean := Force_Validity_Checks; 666 begin 667 Force_Validity_Checks := True; 668 Analyze (Decl); 669 Force_Validity_Checks := Save_Force; 670 end; 671 672 -- All other freezing actions 673 674 else 675 Analyze (Decl, Suppress => All_Checks); 676 end if; 677 678 Next (Decl); 679 end loop; 680 end if; 681 682 -- If we are to delete this N_Freeze_Entity, do so by rewriting so that 683 -- a loop on all nodes being inserted will work propertly. 684 685 if Delete then 686 Rewrite (N, Make_Null_Statement (Sloc (N))); 687 end if; 688 689 -- Pop scope if we installed one for the analysis 690 691 if In_Other_Scope then 692 if Ekind (Current_Scope) = E_Package then 693 End_Package_Scope (E_Scope); 694 else 695 End_Scope; 696 end if; 697 698 elsif In_Outer_Scope then 699 Pop_Scope; 700 end if; 701 702 -- Restore previous value of the nesting-level counter that records 703 -- whether we are inside a (possibly nested) call to this procedure. 704 705 Inside_Freezing_Actions := Inside_Freezing_Actions - 1; 706 end Expand_N_Freeze_Entity; 707 708 ------------------------------------------- 709 -- Expand_N_Record_Representation_Clause -- 710 ------------------------------------------- 711 712 -- The only expansion required is for the case of a mod clause present, 713 -- which is removed, and translated into an alignment representation 714 -- clause inserted immediately after the record rep clause with any 715 -- initial pragmas inserted at the start of the component clause list. 716 717 procedure Expand_N_Record_Representation_Clause (N : Node_Id) is 718 Loc : constant Source_Ptr := Sloc (N); 719 Rectype : constant Entity_Id := Entity (Identifier (N)); 720 Mod_Val : Uint; 721 Citems : List_Id; 722 Repitem : Node_Id; 723 AtM_Nod : Node_Id; 724 725 begin 726 if Present (Mod_Clause (N)) and then not Ignore_Rep_Clauses then 727 Mod_Val := Expr_Value (Expression (Mod_Clause (N))); 728 Citems := Pragmas_Before (Mod_Clause (N)); 729 730 if Present (Citems) then 731 Append_List_To (Citems, Component_Clauses (N)); 732 Set_Component_Clauses (N, Citems); 733 end if; 734 735 AtM_Nod := 736 Make_Attribute_Definition_Clause (Loc, 737 Name => New_Occurrence_Of (Base_Type (Rectype), Loc), 738 Chars => Name_Alignment, 739 Expression => Make_Integer_Literal (Loc, Mod_Val)); 740 741 Set_From_At_Mod (AtM_Nod); 742 Insert_After (N, AtM_Nod); 743 Set_Mod_Clause (N, Empty); 744 end if; 745 746 -- If the record representation clause has no components, then 747 -- completely remove it. Note that we also have to remove 748 -- ourself from the Rep Item list. 749 750 if Is_Empty_List (Component_Clauses (N)) then 751 if First_Rep_Item (Rectype) = N then 752 Set_First_Rep_Item (Rectype, Next_Rep_Item (N)); 753 else 754 Repitem := First_Rep_Item (Rectype); 755 while Present (Next_Rep_Item (Repitem)) loop 756 if Next_Rep_Item (Repitem) = N then 757 Set_Next_Rep_Item (Repitem, Next_Rep_Item (N)); 758 exit; 759 end if; 760 761 Next_Rep_Item (Repitem); 762 end loop; 763 end if; 764 765 Rewrite (N, 766 Make_Null_Statement (Loc)); 767 end if; 768 end Expand_N_Record_Representation_Clause; 769 770end Exp_Ch13; 771