gcc/ada/sem.adb

   1 ------------------------------------------------------------------------------
   2 --                                                                          --
   3 --                         GNAT COMPILER COMPONENTS                         --
   4 --                                                                          --
   5 --                                  S E M                                   --
   6 --                                                                          --
   7 --                                 B o d y                                  --
   8 --                                                                          --
   9 --          Copyright (C) 1992-2003, 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 2,  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 COPYING.  If not, write --
  19 -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
  20 -- MA 02111-1307, USA.                                                      --
  21 --                                                                          --
  22 -- GNAT was originally developed  by the GNAT team at  New York University. --
  23 -- Extensive contributions were provided by Ada Core Technologies Inc.      --
  24 --                                                                          --
  25 ------------------------------------------------------------------------------
  26
  27 with Atree;    use Atree;
  28 with Debug;    use Debug;
  29 with Debug_A;  use Debug_A;
  30 with Einfo;    use Einfo;
  31 with Errout;   use Errout;
  32 with Expander; use Expander;
  33 with Fname;    use Fname;
  34 with HLO;      use HLO;
  35 with Lib;      use Lib;
  36 with Lib.Load; use Lib.Load;
  37 with Nlists;   use Nlists;
  38 with Opt;      use Opt;
  39 with Sem_Attr; use Sem_Attr;
  40 with Sem_Ch2;  use Sem_Ch2;
  41 with Sem_Ch3;  use Sem_Ch3;
  42 with Sem_Ch4;  use Sem_Ch4;
  43 with Sem_Ch5;  use Sem_Ch5;
  44 with Sem_Ch6;  use Sem_Ch6;
  45 with Sem_Ch7;  use Sem_Ch7;
  46 with Sem_Ch8;  use Sem_Ch8;
  47 with Sem_Ch9;  use Sem_Ch9;
  48 with Sem_Ch10; use Sem_Ch10;
  49 with Sem_Ch11; use Sem_Ch11;
  50 with Sem_Ch12; use Sem_Ch12;
  51 with Sem_Ch13; use Sem_Ch13;
  52 with Sem_Prag; use Sem_Prag;
  53 with Sem_Util; use Sem_Util;
  54 with Sinfo;    use Sinfo;
  55 with Stand;    use Stand;
  56 with Uintp;    use Uintp;
  57
  58 pragma Warnings (Off, Sem_Util);
  59 --  Suppress warnings of unused with for Sem_Util (used only in asserts)
  60
  61 package body Sem is
  62
  63    Outer_Generic_Scope : Entity_Id := Empty;
  64    --  Global reference to the outer scope that is generic. In a non
  65    --  generic context, it is empty. At the moment, it is only used
  66    --  for avoiding freezing of external references in generics.
  67
  68    -------------
  69    -- Analyze --
  70    -------------
  71
  72    procedure Analyze (N : Node_Id) is
  73    begin
  74       Debug_A_Entry ("analyzing  ", N);
  75
  76       --  Immediate return if already analyzed
  77
  78       if Analyzed (N) then
  79          Debug_A_Exit ("analyzing  ", N, "  (done, analyzed already)");
  80          return;
  81       end if;
  82
  83       --  Otherwise processing depends on the node kind
  84
  85       case Nkind (N) is
  86
  87          when N_Abort_Statement =>
  88             Analyze_Abort_Statement (N);
  89
  90          when N_Abstract_Subprogram_Declaration =>
  91             Analyze_Abstract_Subprogram_Declaration (N);
  92
  93          when N_Accept_Alternative =>
  94             Analyze_Accept_Alternative (N);
  95
  96          when N_Accept_Statement =>
  97             Analyze_Accept_Statement (N);
  98
  99          when N_Aggregate =>
 100             Analyze_Aggregate (N);
 101
 102          when N_Allocator =>
 103             Analyze_Allocator (N);
 104
 105          when N_And_Then =>
 106             Analyze_Short_Circuit (N);
 107
 108          when N_Assignment_Statement =>
 109             Analyze_Assignment (N);
 110
 111          when N_Asynchronous_Select =>
 112             Analyze_Asynchronous_Select (N);
 113
 114          when N_At_Clause =>
 115             Analyze_At_Clause (N);
 116
 117          when N_Attribute_Reference =>
 118             Analyze_Attribute (N);
 119
 120          when N_Attribute_Definition_Clause   =>
 121             Analyze_Attribute_Definition_Clause (N);
 122
 123          when N_Block_Statement =>
 124             Analyze_Block_Statement (N);
 125
 126          when N_Case_Statement =>
 127             Analyze_Case_Statement (N);
 128
 129          when N_Character_Literal =>
 130             Analyze_Character_Literal (N);
 131
 132          when N_Code_Statement =>
 133             Analyze_Code_Statement (N);
 134
 135          when N_Compilation_Unit =>
 136             Analyze_Compilation_Unit (N);
 137
 138          when N_Component_Declaration =>
 139             Analyze_Component_Declaration (N);
 140
 141          when N_Conditional_Expression =>
 142             Analyze_Conditional_Expression (N);
 143
 144          when N_Conditional_Entry_Call =>
 145             Analyze_Conditional_Entry_Call (N);
 146
 147          when N_Delay_Alternative =>
 148             Analyze_Delay_Alternative (N);
 149
 150          when N_Delay_Relative_Statement =>
 151             Analyze_Delay_Relative (N);
 152
 153          when N_Delay_Until_Statement =>
 154             Analyze_Delay_Until (N);
 155
 156          when N_Entry_Body =>
 157             Analyze_Entry_Body (N);
 158
 159          when N_Entry_Body_Formal_Part =>
 160             Analyze_Entry_Body_Formal_Part (N);
 161
 162          when N_Entry_Call_Alternative =>
 163             Analyze_Entry_Call_Alternative (N);
 164
 165          when N_Entry_Declaration =>
 166             Analyze_Entry_Declaration (N);
 167
 168          when N_Entry_Index_Specification     =>
 169             Analyze_Entry_Index_Specification (N);
 170
 171          when N_Enumeration_Representation_Clause =>
 172             Analyze_Enumeration_Representation_Clause (N);
 173
 174          when N_Exception_Declaration =>
 175             Analyze_Exception_Declaration (N);
 176
 177          when N_Exception_Renaming_Declaration =>
 178             Analyze_Exception_Renaming (N);
 179
 180          when N_Exit_Statement =>
 181             Analyze_Exit_Statement (N);
 182
 183          when N_Expanded_Name =>
 184             Analyze_Expanded_Name (N);
 185
 186          when N_Explicit_Dereference =>
 187             Analyze_Explicit_Dereference (N);
 188
 189          when N_Extension_Aggregate =>
 190             Analyze_Aggregate (N);
 191
 192          when N_Formal_Object_Declaration =>
 193             Analyze_Formal_Object_Declaration (N);
 194
 195          when N_Formal_Package_Declaration =>
 196             Analyze_Formal_Package (N);
 197
 198          when N_Formal_Subprogram_Declaration =>
 199             Analyze_Formal_Subprogram (N);
 200
 201          when N_Formal_Type_Declaration =>
 202             Analyze_Formal_Type_Declaration (N);
 203
 204          when N_Free_Statement =>
 205             Analyze_Free_Statement (N);
 206
 207          when N_Freeze_Entity =>
 208             null;  -- no semantic processing required
 209
 210          when N_Full_Type_Declaration =>
 211             Analyze_Type_Declaration (N);
 212
 213          when N_Function_Call =>
 214             Analyze_Function_Call (N);
 215
 216          when N_Function_Instantiation =>
 217             Analyze_Function_Instantiation (N);
 218
 219          when N_Generic_Function_Renaming_Declaration =>
 220             Analyze_Generic_Function_Renaming (N);
 221
 222          when N_Generic_Package_Declaration =>
 223             Analyze_Generic_Package_Declaration (N);
 224
 225          when N_Generic_Package_Renaming_Declaration =>
 226             Analyze_Generic_Package_Renaming (N);
 227
 228          when N_Generic_Procedure_Renaming_Declaration =>
 229             Analyze_Generic_Procedure_Renaming (N);
 230
 231          when N_Generic_Subprogram_Declaration =>
 232             Analyze_Generic_Subprogram_Declaration (N);
 233
 234          when N_Goto_Statement =>
 235             Analyze_Goto_Statement (N);
 236
 237          when N_Handled_Sequence_Of_Statements =>
 238             Analyze_Handled_Statements (N);
 239
 240          when N_Identifier =>
 241             Analyze_Identifier (N);
 242
 243          when N_If_Statement =>
 244             Analyze_If_Statement (N);
 245
 246          when N_Implicit_Label_Declaration =>
 247             Analyze_Implicit_Label_Declaration (N);
 248
 249          when N_In =>
 250             Analyze_Membership_Op (N);
 251
 252          when N_Incomplete_Type_Declaration =>
 253             Analyze_Incomplete_Type_Decl (N);
 254
 255          when N_Indexed_Component =>
 256             Analyze_Indexed_Component_Form (N);
 257
 258          when N_Integer_Literal =>
 259             Analyze_Integer_Literal (N);
 260
 261          when N_Itype_Reference =>
 262             Analyze_Itype_Reference (N);
 263
 264          when N_Label =>
 265             Analyze_Label (N);
 266
 267          when N_Loop_Statement =>
 268             Analyze_Loop_Statement (N);
 269
 270          when N_Not_In =>
 271             Analyze_Membership_Op (N);
 272
 273          when N_Null =>
 274             Analyze_Null (N);
 275
 276          when N_Null_Statement =>
 277             Analyze_Null_Statement (N);
 278
 279          when N_Number_Declaration =>
 280             Analyze_Number_Declaration (N);
 281
 282          when N_Object_Declaration =>
 283             Analyze_Object_Declaration (N);
 284
 285          when N_Object_Renaming_Declaration  =>
 286             Analyze_Object_Renaming (N);
 287
 288          when N_Operator_Symbol =>
 289             Analyze_Operator_Symbol (N);
 290
 291          when N_Op_Abs =>
 292             Analyze_Unary_Op (N);
 293
 294          when N_Op_Add =>
 295             Analyze_Arithmetic_Op (N);
 296
 297          when N_Op_And =>
 298             Analyze_Logical_Op (N);
 299
 300          when N_Op_Concat =>
 301             Analyze_Concatenation (N);
 302
 303          when N_Op_Divide =>
 304             Analyze_Arithmetic_Op (N);
 305
 306          when N_Op_Eq =>
 307             Analyze_Equality_Op (N);
 308
 309          when N_Op_Expon =>
 310             Analyze_Arithmetic_Op (N);
 311
 312          when N_Op_Ge =>
 313             Analyze_Comparison_Op (N);
 314
 315          when N_Op_Gt =>
 316             Analyze_Comparison_Op (N);
 317
 318          when N_Op_Le =>
 319             Analyze_Comparison_Op (N);
 320
 321          when N_Op_Lt =>
 322             Analyze_Comparison_Op (N);
 323
 324          when N_Op_Minus =>
 325             Analyze_Unary_Op (N);
 326
 327          when N_Op_Mod =>
 328             Analyze_Arithmetic_Op (N);
 329
 330          when N_Op_Multiply =>
 331             Analyze_Arithmetic_Op (N);
 332
 333          when N_Op_Ne =>
 334             Analyze_Equality_Op (N);
 335
 336          when N_Op_Not =>
 337             Analyze_Negation (N);
 338
 339          when N_Op_Or =>
 340             Analyze_Logical_Op (N);
 341
 342          when N_Op_Plus =>
 343             Analyze_Unary_Op (N);
 344
 345          when N_Op_Rem =>
 346             Analyze_Arithmetic_Op (N);
 347
 348          when N_Op_Rotate_Left =>
 349             Analyze_Arithmetic_Op (N);
 350
 351          when N_Op_Rotate_Right =>
 352             Analyze_Arithmetic_Op (N);
 353
 354          when N_Op_Shift_Left =>
 355             Analyze_Arithmetic_Op (N);
 356
 357          when N_Op_Shift_Right =>
 358             Analyze_Arithmetic_Op (N);
 359
 360          when N_Op_Shift_Right_Arithmetic =>
 361             Analyze_Arithmetic_Op (N);
 362
 363          when N_Op_Subtract =>
 364             Analyze_Arithmetic_Op (N);
 365
 366          when N_Op_Xor =>
 367             Analyze_Logical_Op (N);
 368
 369          when N_Or_Else =>
 370             Analyze_Short_Circuit (N);
 371
 372          when N_Others_Choice =>
 373             Analyze_Others_Choice (N);
 374
 375          when N_Package_Body =>
 376             Analyze_Package_Body (N);
 377
 378          when N_Package_Body_Stub =>
 379             Analyze_Package_Body_Stub (N);
 380
 381          when N_Package_Declaration =>
 382             Analyze_Package_Declaration (N);
 383
 384          when N_Package_Instantiation =>
 385             Analyze_Package_Instantiation (N);
 386
 387          when N_Package_Renaming_Declaration =>
 388             Analyze_Package_Renaming (N);
 389
 390          when N_Package_Specification =>
 391             Analyze_Package_Specification (N);
 392
 393          when N_Parameter_Association =>
 394             Analyze_Parameter_Association (N);
 395
 396          when N_Pragma =>
 397             Analyze_Pragma (N);
 398
 399          when N_Private_Extension_Declaration =>
 400             Analyze_Private_Extension_Declaration (N);
 401
 402          when N_Private_Type_Declaration =>
 403             Analyze_Private_Type_Declaration (N);
 404
 405          when N_Procedure_Call_Statement =>
 406             Analyze_Procedure_Call (N);
 407
 408          when N_Procedure_Instantiation =>
 409             Analyze_Procedure_Instantiation (N);
 410
 411          when N_Protected_Body =>
 412             Analyze_Protected_Body (N);
 413
 414          when N_Protected_Body_Stub =>
 415             Analyze_Protected_Body_Stub (N);
 416
 417          when N_Protected_Definition =>
 418             Analyze_Protected_Definition (N);
 419
 420          when N_Protected_Type_Declaration =>
 421             Analyze_Protected_Type (N);
 422
 423          when N_Qualified_Expression =>
 424             Analyze_Qualified_Expression (N);
 425
 426          when N_Raise_Statement =>
 427             Analyze_Raise_Statement (N);
 428
 429          when N_Raise_xxx_Error =>
 430             Analyze_Raise_xxx_Error (N);
 431
 432          when N_Range =>
 433             Analyze_Range (N);
 434
 435          when N_Range_Constraint =>
 436             Analyze_Range (Range_Expression (N));
 437
 438          when N_Real_Literal =>
 439             Analyze_Real_Literal (N);
 440
 441          when N_Record_Representation_Clause =>
 442             Analyze_Record_Representation_Clause (N);
 443
 444          when N_Reference =>
 445             Analyze_Reference (N);
 446
 447          when N_Requeue_Statement =>
 448             Analyze_Requeue (N);
 449
 450          when N_Return_Statement =>
 451             Analyze_Return_Statement (N);
 452
 453          when N_Selected_Component =>
 454             Find_Selected_Component (N);
 455             --  ??? why not Analyze_Selected_Component, needs comments
 456
 457          when N_Selective_Accept =>
 458             Analyze_Selective_Accept (N);
 459
 460          when N_Single_Protected_Declaration =>
 461             Analyze_Single_Protected (N);
 462
 463          when N_Single_Task_Declaration =>
 464             Analyze_Single_Task (N);
 465
 466          when N_Slice =>
 467             Analyze_Slice (N);
 468
 469          when N_String_Literal =>
 470             Analyze_String_Literal (N);
 471
 472          when N_Subprogram_Body =>
 473             Analyze_Subprogram_Body (N);
 474
 475          when N_Subprogram_Body_Stub =>
 476             Analyze_Subprogram_Body_Stub (N);
 477
 478          when N_Subprogram_Declaration =>
 479             Analyze_Subprogram_Declaration (N);
 480
 481          when N_Subprogram_Info =>
 482             Analyze_Subprogram_Info (N);
 483
 484          when N_Subprogram_Renaming_Declaration =>
 485             Analyze_Subprogram_Renaming (N);
 486
 487          when N_Subtype_Declaration =>
 488             Analyze_Subtype_Declaration (N);
 489
 490          when N_Subtype_Indication =>
 491             Analyze_Subtype_Indication (N);
 492
 493          when N_Subunit =>
 494             Analyze_Subunit (N);
 495
 496          when N_Task_Body =>
 497             Analyze_Task_Body (N);
 498
 499          when N_Task_Body_Stub =>
 500             Analyze_Task_Body_Stub (N);
 501
 502          when N_Task_Definition =>
 503             Analyze_Task_Definition (N);
 504
 505          when N_Task_Type_Declaration =>
 506             Analyze_Task_Type (N);
 507
 508          when N_Terminate_Alternative =>
 509             Analyze_Terminate_Alternative (N);
 510
 511          when N_Timed_Entry_Call =>
 512             Analyze_Timed_Entry_Call (N);
 513
 514          when N_Triggering_Alternative =>
 515             Analyze_Triggering_Alternative (N);
 516
 517          when N_Type_Conversion =>
 518             Analyze_Type_Conversion (N);
 519
 520          when N_Unchecked_Expression =>
 521             Analyze_Unchecked_Expression (N);
 522
 523          when N_Unchecked_Type_Conversion =>
 524             Analyze_Unchecked_Type_Conversion (N);
 525
 526          when N_Use_Package_Clause =>
 527             Analyze_Use_Package (N);
 528
 529          when N_Use_Type_Clause =>
 530             Analyze_Use_Type (N);
 531
 532          when N_Validate_Unchecked_Conversion =>
 533             null;
 534
 535          when N_Variant_Part =>
 536             Analyze_Variant_Part (N);
 537
 538          when N_With_Clause =>
 539             Analyze_With_Clause (N);
 540
 541          when N_With_Type_Clause =>
 542             Analyze_With_Type_Clause (N);
 543
 544          --  A call to analyze the Empty node is an error, but most likely
 545          --  it is an error caused by an attempt to analyze a malformed
 546          --  piece of tree caused by some other error, so if there have
 547          --  been any other errors, we just ignore it, otherwise it is
 548          --  a real internal error which we complain about.
 549
 550          when N_Empty =>
 551             pragma Assert (Serious_Errors_Detected /= 0);
 552             null;
 553
 554          --  A call to analyze the error node is simply ignored, to avoid
 555          --  causing cascaded errors (happens of course only in error cases)
 556
 557          when N_Error =>
 558             null;
 559
 560          --  For the remaining node types, we generate compiler abort, because
 561          --  these nodes are always analyzed within the Sem_Chn routines and
 562          --  there should never be a case of making a call to the main Analyze
 563          --  routine for these node kinds. For example, an N_Access_Definition
 564          --  node appears only in the context of a type declaration, and is
 565          --  processed by the analyze routine for type declarations.
 566
 567          when
 568            N_Abortable_Part                         |
 569            N_Access_Definition                      |
 570            N_Access_Function_Definition             |
 571            N_Access_Procedure_Definition            |
 572            N_Access_To_Object_Definition            |
 573            N_Case_Statement_Alternative             |
 574            N_Compilation_Unit_Aux                   |
 575            N_Component_Association                  |
 576            N_Component_Clause                       |
 577            N_Component_List                         |
 578            N_Constrained_Array_Definition           |
 579            N_Decimal_Fixed_Point_Definition         |
 580            N_Defining_Character_Literal             |
 581            N_Defining_Identifier                    |
 582            N_Defining_Operator_Symbol               |
 583            N_Defining_Program_Unit_Name             |
 584            N_Delta_Constraint                       |
 585            N_Derived_Type_Definition                |
 586            N_Designator                             |
 587            N_Digits_Constraint                      |
 588            N_Discriminant_Association               |
 589            N_Discriminant_Specification             |
 590            N_Elsif_Part                             |
 591            N_Entry_Call_Statement                   |
 592            N_Enumeration_Type_Definition            |
 593            N_Exception_Handler                      |
 594            N_Floating_Point_Definition              |
 595            N_Formal_Decimal_Fixed_Point_Definition  |
 596            N_Formal_Derived_Type_Definition         |
 597            N_Formal_Discrete_Type_Definition        |
 598            N_Formal_Floating_Point_Definition       |
 599            N_Formal_Modular_Type_Definition         |
 600            N_Formal_Ordinary_Fixed_Point_Definition |
 601            N_Formal_Private_Type_Definition         |
 602            N_Formal_Signed_Integer_Type_Definition  |
 603            N_Function_Specification                 |
 604            N_Generic_Association                    |
 605            N_Index_Or_Discriminant_Constraint       |
 606            N_Iteration_Scheme                       |
 607            N_Loop_Parameter_Specification           |
 608            N_Mod_Clause                             |
 609            N_Modular_Type_Definition                |
 610            N_Ordinary_Fixed_Point_Definition        |
 611            N_Parameter_Specification                |
 612            N_Pragma_Argument_Association            |
 613            N_Procedure_Specification                |
 614            N_Real_Range_Specification               |
 615            N_Record_Definition                      |
 616            N_Signed_Integer_Type_Definition         |
 617            N_Unconstrained_Array_Definition         |
 618            N_Unused_At_Start                        |
 619            N_Unused_At_End                          |
 620            N_Variant                                =>
 621
 622             raise Program_Error;
 623       end case;
 624
 625       Debug_A_Exit ("analyzing  ", N, "  (done)");
 626
 627       --  Now that we have analyzed the node, we call the expander to
 628       --  perform possible expansion. This is done only for nodes that
 629       --  are not subexpressions, because in the case of subexpressions,
 630       --  we don't have the type yet, and the expander will need to know
 631       --  the type before it can do its job. For subexpression nodes, the
 632       --  call to the expander happens in the Sem_Res.Resolve.
 633
 634       --  The Analyzed flag is also set at this point for non-subexpression
 635       --  nodes (in the case of subexpression nodes, we can't set the flag
 636       --  yet, since resolution and expansion have not yet been completed)
 637
 638       if Nkind (N) not in N_Subexpr then
 639          Expand (N);
 640       end if;
 641    end Analyze;
 642
 643    --  Version with check(s) suppressed
 644
 645    procedure Analyze (N : Node_Id; Suppress : Check_Id) is
 646    begin
 647       if Suppress = All_Checks then
 648          declare
 649             Svg : constant Suppress_Array := Scope_Suppress;
 650
 651          begin
 652             Scope_Suppress := (others => True);
 653             Analyze (N);
 654             Scope_Suppress := Svg;
 655          end;
 656
 657       else
 658          declare
 659             Svg : constant Boolean := Scope_Suppress (Suppress);
 660
 661          begin
 662             Scope_Suppress (Suppress) := True;
 663             Analyze (N);
 664             Scope_Suppress (Suppress) := Svg;
 665          end;
 666       end if;
 667    end Analyze;
 668
 669    ------------------
 670    -- Analyze_List --
 671    ------------------
 672
 673    procedure Analyze_List (L : List_Id) is
 674       Node : Node_Id;
 675
 676    begin
 677       Node := First (L);
 678       while Present (Node) loop
 679          Analyze (Node);
 680          Next (Node);
 681       end loop;
 682    end Analyze_List;
 683
 684    --  Version with check(s) suppressed
 685
 686    procedure Analyze_List (L : List_Id; Suppress : Check_Id) is
 687    begin
 688       if Suppress = All_Checks then
 689          declare
 690             Svg : constant Suppress_Array := Scope_Suppress;
 691
 692          begin
 693             Scope_Suppress := (others => True);
 694             Analyze_List (L);
 695             Scope_Suppress := Svg;
 696          end;
 697
 698       else
 699          declare
 700             Svg : constant Boolean := Scope_Suppress (Suppress);
 701
 702          begin
 703             Scope_Suppress (Suppress) := True;
 704             Analyze_List (L);
 705             Scope_Suppress (Suppress) := Svg;
 706          end;
 707       end if;
 708    end Analyze_List;
 709
 710    --------------------------
 711    -- Copy_Suppress_Status --
 712    --------------------------
 713
 714    procedure Copy_Suppress_Status
 715      (C    : Check_Id;
 716       From : Entity_Id;
 717       To   : Entity_Id)
 718    is
 719    begin
 720       if not Checks_May_Be_Suppressed (From) then
 721          return;
 722       end if;
 723
 724       --  First search the local entity suppress table, we search this in
 725       --  reverse order so that we get the innermost entry that applies to
 726       --  this case if there are nested entries. Note that for the purpose
 727       --  of this procedure we are ONLY looking for entries corresponding
 728       --  to a two-argument Suppress, where the second argument matches From.
 729
 730       for J in
 731         reverse Local_Entity_Suppress.First .. Local_Entity_Suppress.Last
 732       loop
 733          declare
 734             R : Entity_Check_Suppress_Record
 735                   renames Local_Entity_Suppress.Table (J);
 736
 737          begin
 738             if R.Entity = From
 739               and then (R.Check = All_Checks or else R.Check = C)
 740             then
 741                if R.Suppress then
 742                   Set_Checks_May_Be_Suppressed (To, True);
 743                   Local_Entity_Suppress.Append
 744                     ((Entity   => To,
 745                       Check    => C,
 746                       Suppress => True));
 747                   return;
 748                end if;
 749             end if;
 750          end;
 751       end loop;
 752
 753       --  Now search the global entity suppress table for a matching entry
 754       --  We also search this in reverse order so that if there are multiple
 755       --  pragmas for the same entity, the last one applies.
 756
 757       for J in
 758         reverse Global_Entity_Suppress.First .. Global_Entity_Suppress.Last
 759       loop
 760          declare
 761             R : Entity_Check_Suppress_Record
 762                  renames Global_Entity_Suppress.Table (J);
 763
 764          begin
 765             if R.Entity = From
 766               and then (R.Check = All_Checks or else R.Check = C)
 767             then
 768                if R.Suppress then
 769                   Set_Checks_May_Be_Suppressed (To, True);
 770                   Local_Entity_Suppress.Append
 771                     ((Entity   => To,
 772                       Check    => C,
 773                       Suppress => True));
 774                end if;
 775             end if;
 776          end;
 777       end loop;
 778    end Copy_Suppress_Status;
 779
 780    -------------------------
 781    -- Enter_Generic_Scope --
 782    -------------------------
 783
 784    procedure Enter_Generic_Scope (S : Entity_Id) is
 785    begin
 786       if No (Outer_Generic_Scope) then
 787          Outer_Generic_Scope := S;
 788       end if;
 789    end Enter_Generic_Scope;
 790
 791    ------------------------
 792    -- Exit_Generic_Scope --
 793    ------------------------
 794
 795    procedure Exit_Generic_Scope  (S : Entity_Id) is
 796    begin
 797       if S = Outer_Generic_Scope then
 798          Outer_Generic_Scope := Empty;
 799       end if;
 800    end Exit_Generic_Scope;
 801
 802    -----------------------
 803    -- Explicit_Suppress --
 804    -----------------------
 805
 806    function Explicit_Suppress (E : Entity_Id; C : Check_Id) return Boolean is
 807    begin
 808       if not Checks_May_Be_Suppressed (E) then
 809          return False;
 810
 811       else
 812          for J in
 813            reverse Global_Entity_Suppress.First .. Global_Entity_Suppress.Last
 814          loop
 815             declare
 816                R : Entity_Check_Suppress_Record
 817                      renames Global_Entity_Suppress.Table (J);
 818
 819             begin
 820                if R.Entity = E
 821                  and then (R.Check = All_Checks or else R.Check = C)
 822                then
 823                   return R.Suppress;
 824                end if;
 825             end;
 826          end loop;
 827
 828          return False;
 829       end if;
 830    end Explicit_Suppress;
 831
 832    -----------------------------
 833    -- External_Ref_In_Generic --
 834    -----------------------------
 835
 836    function External_Ref_In_Generic (E : Entity_Id) return Boolean is
 837       Scop : Entity_Id;
 838
 839    begin
 840       --  Entity is global if defined outside of current outer_generic_scope:
 841       --  Either the entity has a smaller depth that the outer generic, or it
 842       --  is in a different compilation unit, or it is defined within a unit
 843       --  in the same compilation, that is not within the outer_generic.
 844
 845       if No (Outer_Generic_Scope) then
 846          return False;
 847
 848       elsif Scope_Depth (Scope (E)) < Scope_Depth (Outer_Generic_Scope)
 849         or else not In_Same_Source_Unit (E, Outer_Generic_Scope)
 850       then
 851          return True;
 852
 853       else
 854          Scop := Scope (E);
 855
 856          while Present (Scop) loop
 857             if Scop = Outer_Generic_Scope then
 858                return False;
 859             elsif Scope_Depth (Scop) < Scope_Depth (Outer_Generic_Scope) then
 860                return True;
 861             else
 862                Scop := Scope (Scop);
 863             end if;
 864          end loop;
 865
 866          return True;
 867       end if;
 868    end External_Ref_In_Generic;
 869
 870    ----------------
 871    -- Initialize --
 872    ----------------
 873
 874    procedure Initialize is
 875    begin
 876       Local_Entity_Suppress.Init;
 877       Global_Entity_Suppress.Init;
 878       Scope_Stack.Init;
 879       Unloaded_Subunits := False;
 880    end Initialize;
 881
 882    ------------------------------
 883    -- Insert_After_And_Analyze --
 884    ------------------------------
 885
 886    procedure Insert_After_And_Analyze (N : Node_Id; M : Node_Id) is
 887       Node : Node_Id;
 888
 889    begin
 890       if Present (M) then
 891
 892          --  If we are not at the end of the list, then the easiest
 893          --  coding is simply to insert before our successor
 894
 895          if Present (Next (N)) then
 896             Insert_Before_And_Analyze (Next (N), M);
 897
 898          --  Case of inserting at the end of the list
 899
 900          else
 901             --  Capture the Node_Id of the node to be inserted. This Node_Id
 902             --  will still be the same after the insert operation.
 903
 904             Node := M;
 905             Insert_After (N, M);
 906
 907             --  Now just analyze from the inserted node to the end of
 908             --  the new list (note that this properly handles the case
 909             --  where any of the analyze calls result in the insertion of
 910             --  nodes after the analyzed node, expecting analysis).
 911
 912             while Present (Node) loop
 913                Analyze (Node);
 914                Mark_Rewrite_Insertion (Node);
 915                Next (Node);
 916             end loop;
 917          end if;
 918       end if;
 919    end Insert_After_And_Analyze;
 920
 921    --  Version with check(s) suppressed
 922
 923    procedure Insert_After_And_Analyze
 924      (N        : Node_Id;
 925       M        : Node_Id;
 926       Suppress : Check_Id)
 927    is
 928    begin
 929       if Suppress = All_Checks then
 930          declare
 931             Svg : constant Suppress_Array := Scope_Suppress;
 932
 933          begin
 934             Scope_Suppress := (others => True);
 935             Insert_After_And_Analyze (N, M);
 936             Scope_Suppress := Svg;
 937          end;
 938
 939       else
 940          declare
 941             Svg : constant Boolean := Scope_Suppress (Suppress);
 942
 943          begin
 944             Scope_Suppress (Suppress) := True;
 945             Insert_After_And_Analyze (N, M);
 946             Scope_Suppress (Suppress) := Svg;
 947          end;
 948       end if;
 949    end Insert_After_And_Analyze;
 950
 951    -------------------------------
 952    -- Insert_Before_And_Analyze --
 953    -------------------------------
 954
 955    procedure Insert_Before_And_Analyze (N : Node_Id; M : Node_Id) is
 956       Node : Node_Id;
 957
 958    begin
 959       if Present (M) then
 960
 961          --  Capture the Node_Id of the first list node to be inserted.
 962          --  This will still be the first node after the insert operation,
 963          --  since Insert_List_After does not modify the Node_Id values.
 964
 965          Node := M;
 966          Insert_Before (N, M);
 967
 968          --  The insertion does not change the Id's of any of the nodes in
 969          --  the list, and they are still linked, so we can simply loop from
 970          --  the original first node until we meet the node before which the
 971          --  insertion is occurring. Note that this properly handles the case
 972          --  where any of the analyzed nodes insert nodes after themselves,
 973          --  expecting them to get analyzed.
 974
 975          while Node /= N loop
 976             Analyze (Node);
 977             Mark_Rewrite_Insertion (Node);
 978             Next (Node);
 979          end loop;
 980       end if;
 981    end Insert_Before_And_Analyze;
 982
 983    --  Version with check(s) suppressed
 984
 985    procedure Insert_Before_And_Analyze
 986      (N        : Node_Id;
 987       M        : Node_Id;
 988       Suppress : Check_Id)
 989    is
 990    begin
 991       if Suppress = All_Checks then
 992          declare
 993             Svg : constant Suppress_Array := Scope_Suppress;
 994
 995          begin
 996             Scope_Suppress := (others => True);
 997             Insert_Before_And_Analyze (N, M);
 998             Scope_Suppress := Svg;
 999          end;
1000
1001       else
1002          declare
1003             Svg : constant Boolean := Scope_Suppress (Suppress);
1004
1005          begin
1006             Scope_Suppress (Suppress) := True;
1007             Insert_Before_And_Analyze (N, M);
1008             Scope_Suppress (Suppress) := Svg;
1009          end;
1010       end if;
1011    end Insert_Before_And_Analyze;
1012
1013    -----------------------------------
1014    -- Insert_List_After_And_Analyze --
1015    -----------------------------------
1016
1017    procedure Insert_List_After_And_Analyze (N : Node_Id; L : List_Id) is
1018       After : constant Node_Id := Next (N);
1019       Node  : Node_Id;
1020
1021    begin
1022       if Is_Non_Empty_List (L) then
1023
1024          --  Capture the Node_Id of the first list node to be inserted.
1025          --  This will still be the first node after the insert operation,
1026          --  since Insert_List_After does not modify the Node_Id values.
1027
1028          Node := First (L);
1029          Insert_List_After (N, L);
1030
1031          --  Now just analyze from the original first node until we get to
1032          --  the successor of the original insertion point (which may be
1033          --  Empty if the insertion point was at the end of the list). Note
1034          --  that this properly handles the case where any of the analyze
1035          --  calls result in the insertion of nodes after the analyzed
1036          --  node (possibly calling this routine recursively).
1037
1038          while Node /= After loop
1039             Analyze (Node);
1040             Mark_Rewrite_Insertion (Node);
1041             Next (Node);
1042          end loop;
1043       end if;
1044    end Insert_List_After_And_Analyze;
1045
1046    --  Version with check(s) suppressed
1047
1048    procedure Insert_List_After_And_Analyze
1049      (N : Node_Id; L : List_Id; Suppress : Check_Id)
1050    is
1051    begin
1052       if Suppress = All_Checks then
1053          declare
1054             Svg : constant Suppress_Array := Scope_Suppress;
1055
1056          begin
1057             Scope_Suppress := (others => True);
1058             Insert_List_After_And_Analyze (N, L);
1059             Scope_Suppress := Svg;
1060          end;
1061
1062       else
1063          declare
1064             Svg : constant Boolean := Scope_Suppress (Suppress);
1065
1066          begin
1067             Scope_Suppress (Suppress) := True;
1068             Insert_List_After_And_Analyze (N, L);
1069             Scope_Suppress (Suppress) := Svg;
1070          end;
1071       end if;
1072    end Insert_List_After_And_Analyze;
1073
1074    ------------------------------------
1075    -- Insert_List_Before_And_Analyze --
1076    ------------------------------------
1077
1078    procedure Insert_List_Before_And_Analyze (N : Node_Id; L : List_Id) is
1079       Node : Node_Id;
1080
1081    begin
1082       if Is_Non_Empty_List (L) then
1083
1084          --  Capture the Node_Id of the first list node to be inserted.
1085          --  This will still be the first node after the insert operation,
1086          --  since Insert_List_After does not modify the Node_Id values.
1087
1088          Node := First (L);
1089          Insert_List_Before (N, L);
1090
1091          --  The insertion does not change the Id's of any of the nodes in
1092          --  the list, and they are still linked, so we can simply loop from
1093          --  the original first node until we meet the node before which the
1094          --  insertion is occurring. Note that this properly handles the case
1095          --  where any of the analyzed nodes insert nodes after themselves,
1096          --  expecting them to get analyzed.
1097
1098          while Node /= N loop
1099             Analyze (Node);
1100             Mark_Rewrite_Insertion (Node);
1101             Next (Node);
1102          end loop;
1103       end if;
1104    end Insert_List_Before_And_Analyze;
1105
1106    --  Version with check(s) suppressed
1107
1108    procedure Insert_List_Before_And_Analyze
1109      (N : Node_Id; L : List_Id; Suppress : Check_Id)
1110    is
1111    begin
1112       if Suppress = All_Checks then
1113          declare
1114             Svg : constant Suppress_Array := Scope_Suppress;
1115
1116          begin
1117             Scope_Suppress := (others => True);
1118             Insert_List_Before_And_Analyze (N, L);
1119             Scope_Suppress := Svg;
1120          end;
1121
1122       else
1123          declare
1124             Svg : constant Boolean := Scope_Suppress (Suppress);
1125
1126          begin
1127             Scope_Suppress (Suppress) := True;
1128             Insert_List_Before_And_Analyze (N, L);
1129             Scope_Suppress (Suppress) := Svg;
1130          end;
1131       end if;
1132    end Insert_List_Before_And_Analyze;
1133
1134    -------------------------
1135    -- Is_Check_Suppressed --
1136    -------------------------
1137
1138    function Is_Check_Suppressed (E : Entity_Id; C : Check_Id) return Boolean is
1139    begin
1140       --  First search the local entity suppress table, we search this in
1141       --  reverse order so that we get the innermost entry that applies to
1142       --  this case if there are nested entries.
1143
1144       for J in
1145         reverse Local_Entity_Suppress.First .. Local_Entity_Suppress.Last
1146       loop
1147          declare
1148             R : Entity_Check_Suppress_Record
1149                   renames Local_Entity_Suppress.Table (J);
1150
1151          begin
1152             if (R.Entity = Empty or else R.Entity = E)
1153               and then (R.Check = All_Checks or else R.Check = C)
1154             then
1155                return R.Suppress;
1156             end if;
1157          end;
1158       end loop;
1159
1160       --  Now search the global entity suppress table for a matching entry
1161       --  We also search this in reverse order so that if there are multiple
1162       --  pragmas for the same entity, the last one applies (not clear what
1163       --  or whether the RM specifies this handling, but it seems reasonable).
1164
1165       for J in
1166         reverse Global_Entity_Suppress.First .. Global_Entity_Suppress.Last
1167       loop
1168          declare
1169             R : Entity_Check_Suppress_Record
1170                   renames Global_Entity_Suppress.Table (J);
1171
1172          begin
1173             if R.Entity = E
1174               and then (R.Check = All_Checks or else R.Check = C)
1175             then
1176                return R.Suppress;
1177             end if;
1178          end;
1179       end loop;
1180
1181       --  If we did not find a matching entry, then use the normal scope
1182       --  suppress value after all (actually this will be the global setting
1183       --  since it clearly was not overridden at any point)
1184
1185       return Scope_Suppress (C);
1186    end Is_Check_Suppressed;
1187
1188    ----------
1189    -- Lock --
1190    ----------
1191
1192    procedure Lock is
1193    begin
1194       Local_Entity_Suppress.Locked := True;
1195       Global_Entity_Suppress.Locked := True;
1196       Scope_Stack.Locked := True;
1197       Local_Entity_Suppress.Release;
1198       Global_Entity_Suppress.Release;
1199       Scope_Stack.Release;
1200    end Lock;
1201
1202    ---------------
1203    -- Semantics --
1204    ---------------
1205
1206    procedure Semantics (Comp_Unit : Node_Id) is
1207
1208       --  The following locations save the corresponding global flags and
1209       --  variables so that they can be restored on completion. This is
1210       --  needed so that calls to Rtsfind start with the proper default
1211       --  values for these variables, and also that such calls do not
1212       --  disturb the settings for units being analyzed at a higher level.
1213
1214       S_Full_Analysis    : constant Boolean          := Full_Analysis;
1215       S_In_Default_Expr  : constant Boolean          := In_Default_Expression;
1216       S_Inside_A_Generic : constant Boolean          := Inside_A_Generic;
1217       S_New_Nodes_OK     : constant Int              := New_Nodes_OK;
1218       S_Outer_Gen_Scope  : constant Entity_Id        := Outer_Generic_Scope;
1219       S_Sem_Unit         : constant Unit_Number_Type := Current_Sem_Unit;
1220
1221       Generic_Main       : constant Boolean :=
1222                              Nkind (Unit (Cunit (Main_Unit)))
1223                                in N_Generic_Declaration;
1224
1225       --  If the main unit is generic, every compiled unit, including its
1226       --  context, is compiled with expansion disabled.
1227
1228       Save_Config_Switches : Config_Switches_Type;
1229       --  Variable used to save values of config switches while we analyze
1230       --  the new unit, to be restored on exit for proper recursive behavior.
1231
1232       procedure Do_Analyze;
1233       --  Procedure to analyze the compilation unit. This is called more
1234       --  than once when the high level optimizer is activated.
1235
1236       ----------------
1237       -- Do_Analyze --
1238       ----------------
1239
1240       procedure Do_Analyze is
1241       begin
1242          Save_Scope_Stack;
1243          New_Scope (Standard_Standard);
1244          Scope_Suppress := Suppress_Options;
1245          Scope_Stack.Table
1246            (Scope_Stack.Last).Component_Alignment_Default := Calign_Default;
1247          Scope_Stack.Table
1248            (Scope_Stack.Last).Is_Active_Stack_Base := True;
1249          Outer_Generic_Scope := Empty;
1250
1251          --  Now analyze the top level compilation unit node
1252
1253          Analyze (Comp_Unit);
1254
1255          --  Check for scope mismatch on exit from compilation
1256
1257          pragma Assert (Current_Scope = Standard_Standard
1258                           or else Comp_Unit = Cunit (Main_Unit));
1259
1260          --  Then pop entry for Standard, and pop implicit types
1261
1262          Pop_Scope;
1263          Restore_Scope_Stack;
1264       end Do_Analyze;
1265
1266    --  Start of processing for Semantics
1267
1268    begin
1269       Compiler_State        := Analyzing;
1270       Current_Sem_Unit      := Get_Cunit_Unit_Number (Comp_Unit);
1271
1272       if Generic_Main then
1273          Expander_Mode_Save_And_Set (False);
1274       else
1275          Expander_Mode_Save_And_Set
1276            (Operating_Mode = Generate_Code or Debug_Flag_X);
1277       end if;
1278
1279       Full_Analysis         := True;
1280       Inside_A_Generic      := False;
1281       In_Default_Expression := False;
1282
1283       Set_Comes_From_Source_Default (False);
1284       Save_Opt_Config_Switches (Save_Config_Switches);
1285       Set_Opt_Config_Switches
1286         (Is_Internal_File_Name (Unit_File_Name (Current_Sem_Unit)));
1287
1288       --  Only do analysis of unit that has not already been analyzed
1289
1290       if not Analyzed (Comp_Unit) then
1291          Initialize_Version (Current_Sem_Unit);
1292          if HLO_Active then
1293             Expander_Mode_Save_And_Set (False);
1294             New_Nodes_OK := 1;
1295             Do_Analyze;
1296             Reset_Analyzed_Flags (Comp_Unit);
1297             Expander_Mode_Restore;
1298             High_Level_Optimize (Comp_Unit);
1299             New_Nodes_OK := 0;
1300          end if;
1301
1302          Do_Analyze;
1303       end if;
1304
1305       --  Save indication of dynamic elaboration checks for ALI file
1306
1307       Set_Dynamic_Elab (Current_Sem_Unit, Dynamic_Elaboration_Checks);
1308
1309       --  Restore settings of saved switches to entry values
1310
1311       Current_Sem_Unit       := S_Sem_Unit;
1312       Full_Analysis          := S_Full_Analysis;
1313       In_Default_Expression  := S_In_Default_Expr;
1314       Inside_A_Generic       := S_Inside_A_Generic;
1315       New_Nodes_OK           := S_New_Nodes_OK;
1316       Outer_Generic_Scope    := S_Outer_Gen_Scope;
1317
1318       Restore_Opt_Config_Switches (Save_Config_Switches);
1319       Expander_Mode_Restore;
1320
1321    end Semantics;
1322 end Sem;