gcc/ada/sem.adb

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