gcc/ada/sem.adb

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