New Language: Ada

git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@45959 138bc75d-0d04-0410-961f-82ee72b054a4

1 files changed, 1184 insertions, 0 deletions

diff --git a/gcc/ada/sem.adb b/gcc/ada/sem.adb
new file mode 100644
index 00000000000..1eb315d481e
--- /dev/null
+++ b/gcc/ada/sem.adb
@@ -0,0 +1,1184 @@
+------------------------------------------------------------------------------
+--                                                                          --
+--                         GNAT COMPILER COMPONENTS                         --
+--                                                                          --
+--                                  S E M                                   --
+--                                                                          --
+--                                 B o d y                                  --
+--                                                                          --
+--                            $Revision: 1.290 $
+--                                                                          --
+--          Copyright (C) 1992-2001, Free Software Foundation, Inc.         --
+--                                                                          --
+-- GNAT is free software;  you can  redistribute it  and/or modify it under --
+-- terms of the  GNU General Public License as published  by the Free Soft- --
+-- ware  Foundation;  either version 2,  or (at your option) any later ver- --
+-- sion.  GNAT is distributed in the hope that it will be useful, but WITH- --
+-- OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY --
+-- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
+-- for  more details.  You should have  received  a copy of the GNU General --
+-- Public License  distributed with GNAT;  see file COPYING.  If not, write --
+-- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
+-- MA 02111-1307, USA.                                                      --
+--                                                                          --
+-- GNAT was originally developed  by the GNAT team at  New York University. --
+-- It is now maintained by Ada Core Technologies Inc (http://www.gnat.com). --
+--                                                                          --
+------------------------------------------------------------------------------
+
+with Atree;    use Atree;
+with Debug;    use Debug;
+with Debug_A;  use Debug_A;
+with Einfo;    use Einfo;
+with Errout;   use Errout;
+with Expander; use Expander;
+with Fname;    use Fname;
+with HLO;      use HLO;
+with Lib;      use Lib;
+with Lib.Load; use Lib.Load;
+with Nlists;   use Nlists;
+with Opt;      use Opt;
+with Sem_Attr; use Sem_Attr;
+with Sem_Ch2;  use Sem_Ch2;
+with Sem_Ch3;  use Sem_Ch3;
+with Sem_Ch4;  use Sem_Ch4;
+with Sem_Ch5;  use Sem_Ch5;
+with Sem_Ch6;  use Sem_Ch6;
+with Sem_Ch7;  use Sem_Ch7;
+with Sem_Ch8;  use Sem_Ch8;
+with Sem_Ch9;  use Sem_Ch9;
+with Sem_Ch10; use Sem_Ch10;
+with Sem_Ch11; use Sem_Ch11;
+with Sem_Ch12; use Sem_Ch12;
+with Sem_Ch13; use Sem_Ch13;
+with Sem_Prag; use Sem_Prag;
+with Sem_Util; use Sem_Util;
+with Sinfo;    use Sinfo;
+with Stand;    use Stand;
+with Uintp;    use Uintp;
+
+pragma Warnings (Off, Sem_Util);
+--  Suppress warnings of unused with for Sem_Util (used only in asserts)
+
+package body Sem is
+
+   Outer_Generic_Scope : Entity_Id := Empty;
+   --  Global reference to the outer scope that is generic. In a non
+   --  generic context, it is empty. At the moment, it is only used
+   --  for avoiding freezing of external references in generics.
+
+   -------------
+   -- Analyze --
+   -------------
+
+   procedure Analyze (N : Node_Id) is
+   begin
+      Debug_A_Entry ("analyzing  ", N);
+
+      --  Immediate return if already analyzed
+
+      if Analyzed (N) then
+         Debug_A_Exit ("analyzing  ", N, "  (done, analyzed already)");
+         return;
+      end if;
+
+      Current_Error_Node := N;
+
+      --  Otherwise processing depends on the node kind
+
+      case Nkind (N) is
+
+         when N_Abort_Statement =>
+            Analyze_Abort_Statement (N);
+
+         when N_Abstract_Subprogram_Declaration =>
+            Analyze_Abstract_Subprogram_Declaration (N);
+
+         when N_Accept_Alternative =>
+            Analyze_Accept_Alternative (N);
+
+         when N_Accept_Statement =>
+            Analyze_Accept_Statement (N);
+
+         when N_Aggregate =>
+            Analyze_Aggregate (N);
+
+         when N_Allocator =>
+            Analyze_Allocator (N);
+
+         when N_And_Then =>
+            Analyze_Short_Circuit (N);
+
+         when N_Assignment_Statement =>
+            Analyze_Assignment (N);
+
+         when N_Asynchronous_Select =>
+            Analyze_Asynchronous_Select (N);
+
+         when N_At_Clause =>
+            Analyze_At_Clause (N);
+
+         when N_Attribute_Reference =>
+            Analyze_Attribute (N);
+
+         when N_Attribute_Definition_Clause   =>
+            Analyze_Attribute_Definition_Clause (N);
+
+         when N_Block_Statement =>
+            Analyze_Block_Statement (N);
+
+         when N_Case_Statement =>
+            Analyze_Case_Statement (N);
+
+         when N_Character_Literal =>
+            Analyze_Character_Literal (N);
+
+         when N_Code_Statement =>
+            Analyze_Code_Statement (N);
+
+         when N_Compilation_Unit =>
+            Analyze_Compilation_Unit (N);
+
+         when N_Component_Declaration =>
+            Analyze_Component_Declaration (N);
+
+         when N_Conditional_Expression =>
+            Analyze_Conditional_Expression (N);
+
+         when N_Conditional_Entry_Call =>
+            Analyze_Conditional_Entry_Call (N);
+
+         when N_Delay_Alternative =>
+            Analyze_Delay_Alternative (N);
+
+         when N_Delay_Relative_Statement =>
+            Analyze_Delay_Relative (N);
+
+         when N_Delay_Until_Statement =>
+            Analyze_Delay_Until (N);
+
+         when N_Entry_Body =>
+            Analyze_Entry_Body (N);
+
+         when N_Entry_Body_Formal_Part =>
+            Analyze_Entry_Body_Formal_Part (N);
+
+         when N_Entry_Call_Alternative =>
+            Analyze_Entry_Call_Alternative (N);
+
+         when N_Entry_Declaration =>
+            Analyze_Entry_Declaration (N);
+
+         when N_Entry_Index_Specification     =>
+            Analyze_Entry_Index_Specification (N);
+
+         when N_Enumeration_Representation_Clause =>
+            Analyze_Enumeration_Representation_Clause (N);
+
+         when N_Exception_Declaration =>
+            Analyze_Exception_Declaration (N);
+
+         when N_Exception_Renaming_Declaration =>
+            Analyze_Exception_Renaming (N);
+
+         when N_Exit_Statement =>
+            Analyze_Exit_Statement (N);
+
+         when N_Expanded_Name =>
+            Analyze_Expanded_Name (N);
+
+         when N_Explicit_Dereference =>
+            Analyze_Explicit_Dereference (N);
+
+         when N_Extension_Aggregate =>
+            Analyze_Aggregate (N);
+
+         when N_Formal_Object_Declaration =>
+            Analyze_Formal_Object_Declaration (N);
+
+         when N_Formal_Package_Declaration =>
+            Analyze_Formal_Package (N);
+
+         when N_Formal_Subprogram_Declaration =>
+            Analyze_Formal_Subprogram (N);
+
+         when N_Formal_Type_Declaration =>
+            Analyze_Formal_Type_Declaration (N);
+
+         when N_Free_Statement =>
+            Analyze_Free_Statement (N);
+
+         when N_Freeze_Entity =>
+            null;  -- no semantic processing required
+
+         when N_Full_Type_Declaration =>
+            Analyze_Type_Declaration (N);
+
+         when N_Function_Call =>
+            Analyze_Function_Call (N);
+
+         when N_Function_Instantiation =>
+            Analyze_Function_Instantiation (N);
+
+         when N_Generic_Function_Renaming_Declaration =>
+            Analyze_Generic_Function_Renaming (N);
+
+         when N_Generic_Package_Declaration =>
+            Analyze_Generic_Package_Declaration (N);
+
+         when N_Generic_Package_Renaming_Declaration =>
+            Analyze_Generic_Package_Renaming (N);
+
+         when N_Generic_Procedure_Renaming_Declaration =>
+            Analyze_Generic_Procedure_Renaming (N);
+
+         when N_Generic_Subprogram_Declaration =>
+            Analyze_Generic_Subprogram_Declaration (N);
+
+         when N_Goto_Statement =>
+            Analyze_Goto_Statement (N);
+
+         when N_Handled_Sequence_Of_Statements =>
+            Analyze_Handled_Statements (N);
+
+         when N_Identifier =>
+            Analyze_Identifier (N);
+
+         when N_If_Statement =>
+            Analyze_If_Statement (N);
+
+         when N_Implicit_Label_Declaration =>
+            Analyze_Implicit_Label_Declaration (N);
+
+         when N_In =>
+            Analyze_Membership_Op (N);
+
+         when N_Incomplete_Type_Declaration =>
+            Analyze_Incomplete_Type_Decl (N);
+
+         when N_Indexed_Component =>
+            Analyze_Indexed_Component_Form (N);
+
+         when N_Integer_Literal =>
+            Analyze_Integer_Literal (N);
+
+         when N_Itype_Reference =>
+            Analyze_Itype_Reference (N);
+
+         when N_Label =>
+            Analyze_Label (N);
+
+         when N_Loop_Statement =>
+            Analyze_Loop_Statement (N);
+
+         when N_Not_In =>
+            Analyze_Membership_Op (N);
+
+         when N_Null =>
+            Analyze_Null (N);
+
+         when N_Null_Statement =>
+            Analyze_Null_Statement (N);
+
+         when N_Number_Declaration =>
+            Analyze_Number_Declaration (N);
+
+         when N_Object_Declaration =>
+            Analyze_Object_Declaration (N);
+
+         when N_Object_Renaming_Declaration  =>
+            Analyze_Object_Renaming (N);
+
+         when N_Operator_Symbol =>
+            Analyze_Operator_Symbol (N);
+
+         when N_Op_Abs =>
+            Analyze_Unary_Op (N);
+
+         when N_Op_Add =>
+            Analyze_Arithmetic_Op (N);
+
+         when N_Op_And =>
+            Analyze_Logical_Op (N);
+
+         when N_Op_Concat =>
+            Analyze_Concatenation (N);
+
+         when N_Op_Divide =>
+            Analyze_Arithmetic_Op (N);
+
+         when N_Op_Eq =>
+            Analyze_Equality_Op (N);
+
+         when N_Op_Expon =>
+            Analyze_Arithmetic_Op (N);
+
+         when N_Op_Ge =>
+            Analyze_Comparison_Op (N);
+
+         when N_Op_Gt =>
+            Analyze_Comparison_Op (N);
+
+         when N_Op_Le =>
+            Analyze_Comparison_Op (N);
+
+         when N_Op_Lt =>
+            Analyze_Comparison_Op (N);
+
+         when N_Op_Minus =>
+            Analyze_Unary_Op (N);
+
+         when N_Op_Mod =>
+            Analyze_Arithmetic_Op (N);
+
+         when N_Op_Multiply =>
+            Analyze_Arithmetic_Op (N);
+
+         when N_Op_Ne =>
+            Analyze_Equality_Op (N);
+
+         when N_Op_Not =>
+            Analyze_Negation (N);
+
+         when N_Op_Or =>
+            Analyze_Logical_Op (N);
+
+         when N_Op_Plus =>
+            Analyze_Unary_Op (N);
+
+         when N_Op_Rem =>
+            Analyze_Arithmetic_Op (N);
+
+         when N_Op_Rotate_Left =>
+            Analyze_Arithmetic_Op (N);
+
+         when N_Op_Rotate_Right =>
+            Analyze_Arithmetic_Op (N);
+
+         when N_Op_Shift_Left =>
+            Analyze_Arithmetic_Op (N);
+
+         when N_Op_Shift_Right =>
+            Analyze_Arithmetic_Op (N);
+
+         when N_Op_Shift_Right_Arithmetic =>
+            Analyze_Arithmetic_Op (N);
+
+         when N_Op_Subtract =>
+            Analyze_Arithmetic_Op (N);
+
+         when N_Op_Xor =>
+            Analyze_Logical_Op (N);
+
+         when N_Or_Else =>
+            Analyze_Short_Circuit (N);
+
+         when N_Others_Choice =>
+            Analyze_Others_Choice (N);
+
+         when N_Package_Body =>
+            Analyze_Package_Body (N);
+
+         when N_Package_Body_Stub =>
+            Analyze_Package_Body_Stub (N);
+
+         when N_Package_Declaration =>
+            Analyze_Package_Declaration (N);
+
+         when N_Package_Instantiation =>
+            Analyze_Package_Instantiation (N);
+
+         when N_Package_Renaming_Declaration =>
+            Analyze_Package_Renaming (N);
+
+         when N_Package_Specification =>
+            Analyze_Package_Specification (N);
+
+         when N_Parameter_Association =>
+            Analyze_Parameter_Association (N);
+
+         when N_Pragma =>
+            Analyze_Pragma (N);
+
+         when N_Private_Extension_Declaration =>
+            Analyze_Private_Extension_Declaration (N);
+
+         when N_Private_Type_Declaration =>
+            Analyze_Private_Type_Declaration (N);
+
+         when N_Procedure_Call_Statement =>
+            Analyze_Procedure_Call (N);
+
+         when N_Procedure_Instantiation =>
+            Analyze_Procedure_Instantiation (N);
+
+         when N_Protected_Body =>
+            Analyze_Protected_Body (N);
+
+         when N_Protected_Body_Stub =>
+            Analyze_Protected_Body_Stub (N);
+
+         when N_Protected_Definition =>
+            Analyze_Protected_Definition (N);
+
+         when N_Protected_Type_Declaration =>
+            Analyze_Protected_Type (N);
+
+         when N_Qualified_Expression =>
+            Analyze_Qualified_Expression (N);
+
+         when N_Raise_Statement =>
+            Analyze_Raise_Statement (N);
+
+         when N_Raise_xxx_Error =>
+            Analyze_Raise_xxx_Error (N);
+
+         when N_Range =>
+            Analyze_Range (N);
+
+         when N_Range_Constraint =>
+            Analyze_Range (Range_Expression (N));
+
+         when N_Real_Literal =>
+            Analyze_Real_Literal (N);
+
+         when N_Record_Representation_Clause =>
+            Analyze_Record_Representation_Clause (N);
+
+         when N_Reference =>
+            Analyze_Reference (N);
+
+         when N_Requeue_Statement =>
+            Analyze_Requeue (N);
+
+         when N_Return_Statement =>
+            Analyze_Return_Statement (N);
+
+         when N_Selected_Component =>
+            Find_Selected_Component (N);
+            --  ??? why not Analyze_Selected_Component, needs comments
+
+         when N_Selective_Accept =>
+            Analyze_Selective_Accept (N);
+
+         when N_Single_Protected_Declaration =>
+            Analyze_Single_Protected (N);
+
+         when N_Single_Task_Declaration =>
+            Analyze_Single_Task (N);
+
+         when N_Slice =>
+            Analyze_Slice (N);
+
+         when N_String_Literal =>
+            Analyze_String_Literal (N);
+
+         when N_Subprogram_Body =>
+            Analyze_Subprogram_Body (N);
+
+         when N_Subprogram_Body_Stub =>
+            Analyze_Subprogram_Body_Stub (N);
+
+         when N_Subprogram_Declaration =>
+            Analyze_Subprogram_Declaration (N);
+
+         when N_Subprogram_Info =>
+            Analyze_Subprogram_Info (N);
+
+         when N_Subprogram_Renaming_Declaration =>
+            Analyze_Subprogram_Renaming (N);
+
+         when N_Subtype_Declaration =>
+            Analyze_Subtype_Declaration (N);
+
+         when N_Subtype_Indication =>
+            Analyze_Subtype_Indication (N);
+
+         when N_Subunit =>
+            Analyze_Subunit (N);
+
+         when N_Task_Body =>
+            Analyze_Task_Body (N);
+
+         when N_Task_Body_Stub =>
+            Analyze_Task_Body_Stub (N);
+
+         when N_Task_Definition =>
+            Analyze_Task_Definition (N);
+
+         when N_Task_Type_Declaration =>
+            Analyze_Task_Type (N);
+
+         when N_Terminate_Alternative =>
+            Analyze_Terminate_Alternative (N);
+
+         when N_Timed_Entry_Call =>
+            Analyze_Timed_Entry_Call (N);
+
+         when N_Triggering_Alternative =>
+            Analyze_Triggering_Alternative (N);
+
+         when N_Type_Conversion =>
+            Analyze_Type_Conversion (N);
+
+         when N_Unchecked_Expression =>
+            Analyze_Unchecked_Expression (N);
+
+         when N_Unchecked_Type_Conversion =>
+            Analyze_Unchecked_Type_Conversion (N);
+
+         when N_Use_Package_Clause =>
+            Analyze_Use_Package (N);
+
+         when N_Use_Type_Clause =>
+            Analyze_Use_Type (N);
+
+         when N_Validate_Unchecked_Conversion =>
+            null;
+
+         when N_Variant_Part =>
+            Analyze_Variant_Part (N);
+
+         when N_With_Clause =>
+            Analyze_With_Clause (N);
+
+         when N_With_Type_Clause =>
+            Analyze_With_Type_Clause (N);
+
+         --  A call to analyze the Empty node is an error, but most likely
+         --  it is an error caused by an attempt to analyze a malformed
+         --  piece of tree caused by some other error, so if there have
+         --  been any other errors, we just ignore it, otherwise it is
+         --  a real internal error which we complain about.
+
+         when N_Empty =>
+            pragma Assert (Errors_Detected /= 0);
+            null;
+
+         --  A call to analyze the error node is simply ignored, to avoid
+         --  causing cascaded errors (happens of course only in error cases)
+
+         when N_Error =>
+            null;
+
+         --  For the remaining node types, we generate compiler abort, because
+         --  these nodes are always analyzed within the Sem_Chn routines and
+         --  there should never be a case of making a call to the main Analyze
+         --  routine for these node kinds. For example, an N_Access_Definition
+         --  node appears only in the context of a type declaration, and is
+         --  processed by the analyze routine for type declarations.
+
+         when
+           N_Abortable_Part                         |
+           N_Access_Definition                      |
+           N_Access_Function_Definition             |
+           N_Access_Procedure_Definition            |
+           N_Access_To_Object_Definition            |
+           N_Case_Statement_Alternative             |
+           N_Compilation_Unit_Aux                   |
+           N_Component_Association                  |
+           N_Component_Clause                       |
+           N_Component_List                         |
+           N_Constrained_Array_Definition           |
+           N_Decimal_Fixed_Point_Definition         |
+           N_Defining_Character_Literal             |
+           N_Defining_Identifier                    |
+           N_Defining_Operator_Symbol               |
+           N_Defining_Program_Unit_Name             |
+           N_Delta_Constraint                       |
+           N_Derived_Type_Definition                |
+           N_Designator                             |
+           N_Digits_Constraint                      |
+           N_Discriminant_Association               |
+           N_Discriminant_Specification             |
+           N_Elsif_Part                             |
+           N_Entry_Call_Statement                   |
+           N_Enumeration_Type_Definition            |
+           N_Exception_Handler                      |
+           N_Floating_Point_Definition              |
+           N_Formal_Decimal_Fixed_Point_Definition  |
+           N_Formal_Derived_Type_Definition         |
+           N_Formal_Discrete_Type_Definition        |
+           N_Formal_Floating_Point_Definition       |
+           N_Formal_Modular_Type_Definition         |
+           N_Formal_Ordinary_Fixed_Point_Definition |
+           N_Formal_Private_Type_Definition         |
+           N_Formal_Signed_Integer_Type_Definition  |
+           N_Function_Specification                 |
+           N_Generic_Association                    |
+           N_Index_Or_Discriminant_Constraint       |
+           N_Iteration_Scheme                       |
+           N_Loop_Parameter_Specification           |
+           N_Mod_Clause                             |
+           N_Modular_Type_Definition                |
+           N_Ordinary_Fixed_Point_Definition        |
+           N_Parameter_Specification                |
+           N_Pragma_Argument_Association            |
+           N_Procedure_Specification                |
+           N_Real_Range_Specification               |
+           N_Record_Definition                      |
+           N_Signed_Integer_Type_Definition         |
+           N_Unconstrained_Array_Definition         |
+           N_Unused_At_Start                        |
+           N_Unused_At_End                          |
+           N_Variant                                =>
+
+            raise Program_Error;
+      end case;
+
+      Debug_A_Exit ("analyzing  ", N, "  (done)");
+
+      --  Now that we have analyzed the node, we call the expander to
+      --  perform possible expansion. This is done only for nodes that
+      --  are not subexpressions, because in the case of subexpressions,
+      --  we don't have the type yet, and the expander will need to know
+      --  the type before it can do its job. For subexpression nodes, the
+      --  call to the expander happens in the Sem_Res.Resolve.
+
+      --  The Analyzed flag is also set at this point for non-subexpression
+      --  nodes (in the case of subexpression nodes, we can't set the flag
+      --  yet, since resolution and expansion have not yet been completed)
+
+      if Nkind (N) not in N_Subexpr then
+         Expand (N);
+      end if;
+
+   end Analyze;
+
+   --  Version with check(s) suppressed
+
+   procedure Analyze (N : Node_Id; Suppress : Check_Id) is
+   begin
+      if Suppress = All_Checks then
+         declare
+            Svg : constant Suppress_Record := Scope_Suppress;
+
+         begin
+            Scope_Suppress := (others => True);
+            Analyze (N);
+            Scope_Suppress := Svg;
+         end;
+
+      else
+         declare
+            Svg : constant Boolean := Get_Scope_Suppress (Suppress);
+
+         begin
+            Set_Scope_Suppress (Suppress, True);
+            Analyze (N);
+            Set_Scope_Suppress (Suppress, Svg);
+         end;
+      end if;
+   end Analyze;
+
+   ------------------
+   -- Analyze_List --
+   ------------------
+
+   procedure Analyze_List (L : List_Id) is
+      Node : Node_Id;
+
+   begin
+      Node := First (L);
+      while Present (Node) loop
+         Analyze (Node);
+         Next (Node);
+      end loop;
+   end Analyze_List;
+
+   --  Version with check(s) suppressed
+
+   procedure Analyze_List (L : List_Id; Suppress : Check_Id) is
+   begin
+      if Suppress = All_Checks then
+         declare
+            Svg : constant Suppress_Record := Scope_Suppress;
+
+         begin
+            Scope_Suppress := (others => True);
+            Analyze_List (L);
+            Scope_Suppress := Svg;
+         end;
+
+      else
+         declare
+            Svg : constant Boolean := Get_Scope_Suppress (Suppress);
+
+         begin
+            Set_Scope_Suppress (Suppress, True);
+            Analyze_List (L);
+            Set_Scope_Suppress (Suppress, Svg);
+         end;
+      end if;
+   end Analyze_List;
+
+   -------------------------
+   -- Enter_Generic_Scope --
+   -------------------------
+
+   procedure Enter_Generic_Scope (S : Entity_Id) is
+   begin
+      if No (Outer_Generic_Scope) then
+         Outer_Generic_Scope := S;
+      end if;
+   end Enter_Generic_Scope;
+
+   ------------------------
+   -- Exit_Generic_Scope --
+   ------------------------
+
+   procedure Exit_Generic_Scope  (S : Entity_Id) is
+   begin
+      if S = Outer_Generic_Scope then
+         Outer_Generic_Scope := Empty;
+      end if;
+   end  Exit_Generic_Scope;
+
+   -----------------------------
+   -- External_Ref_In_Generic --
+   -----------------------------
+
+   function External_Ref_In_Generic (E : Entity_Id) return Boolean is
+   begin
+
+      --  Entity is global if defined outside of current outer_generic_scope:
+      --  Either the entity has a smaller depth that the outer generic, or it
+      --  is in a different compilation unit.
+
+      return Present (Outer_Generic_Scope)
+        and then (Scope_Depth (Scope (E)) < Scope_Depth (Outer_Generic_Scope)
+                   or else not In_Same_Source_Unit (E, Outer_Generic_Scope));
+   end External_Ref_In_Generic;
+
+   ------------------------
+   -- Get_Scope_Suppress --
+   ------------------------
+
+   function Get_Scope_Suppress (C : Check_Id) return Boolean is
+      S : Suppress_Record renames Scope_Suppress;
+
+   begin
+      case C is
+         when Access_Check        => return S.Access_Checks;
+         when Accessibility_Check => return S.Accessibility_Checks;
+         when Discriminant_Check  => return S.Discriminant_Checks;
+         when Division_Check      => return S.Division_Checks;
+         when Elaboration_Check   => return S.Discriminant_Checks;
+         when Index_Check         => return S.Elaboration_Checks;
+         when Length_Check        => return S.Discriminant_Checks;
+         when Overflow_Check      => return S.Overflow_Checks;
+         when Range_Check         => return S.Range_Checks;
+         when Storage_Check       => return S.Storage_Checks;
+         when Tag_Check           => return S.Tag_Checks;
+         when All_Checks =>
+            raise Program_Error;
+      end case;
+   end Get_Scope_Suppress;
+
+   ----------------
+   -- Initialize --
+   ----------------
+
+   procedure Initialize is
+   begin
+      Entity_Suppress.Init;
+      Scope_Stack.Init;
+      Unloaded_Subunits := False;
+   end Initialize;
+
+   ------------------------------
+   -- Insert_After_And_Analyze --
+   ------------------------------
+
+   procedure Insert_After_And_Analyze (N : Node_Id; M : Node_Id) is
+      Node : Node_Id;
+
+   begin
+      if Present (M) then
+
+         --  If we are not at the end of the list, then the easiest
+         --  coding is simply to insert before our successor
+
+         if Present (Next (N)) then
+            Insert_Before_And_Analyze (Next (N), M);
+
+         --  Case of inserting at the end of the list
+
+         else
+            --  Capture the Node_Id of the node to be inserted. This Node_Id
+            --  will still be the same after the insert operation.
+
+            Node := M;
+            Insert_After (N, M);
+
+            --  Now just analyze from the inserted node to the end of
+            --  the new list (note that this properly handles the case
+            --  where any of the analyze calls result in the insertion of
+            --  nodes after the analyzed node, expecting analysis).
+
+            while Present (Node) loop
+               Analyze (Node);
+               Mark_Rewrite_Insertion (Node);
+               Next (Node);
+            end loop;
+         end if;
+      end if;
+
+   end Insert_After_And_Analyze;
+
+   --  Version with check(s) suppressed
+
+   procedure Insert_After_And_Analyze
+     (N : Node_Id; M : Node_Id; Suppress : Check_Id)
+   is
+   begin
+      if Suppress = All_Checks then
+         declare
+            Svg : constant Suppress_Record := Scope_Suppress;
+
+         begin
+            Scope_Suppress := (others => True);
+            Insert_After_And_Analyze (N, M);
+            Scope_Suppress := Svg;
+         end;
+
+      else
+         declare
+            Svg : constant Boolean := Get_Scope_Suppress (Suppress);
+
+         begin
+            Set_Scope_Suppress (Suppress, True);
+            Insert_After_And_Analyze (N, M);
+            Set_Scope_Suppress (Suppress, Svg);
+         end;
+      end if;
+   end Insert_After_And_Analyze;
+
+   -------------------------------
+   -- Insert_Before_And_Analyze --
+   -------------------------------
+
+   procedure Insert_Before_And_Analyze (N : Node_Id; M : Node_Id) is
+      Node : Node_Id;
+
+   begin
+      if Present (M) then
+
+         --  Capture the Node_Id of the first list node to be inserted.
+         --  This will still be the first node after the insert operation,
+         --  since Insert_List_After does not modify the Node_Id values.
+
+         Node := M;
+         Insert_Before (N, M);
+
+         --  The insertion does not change the Id's of any of the nodes in
+         --  the list, and they are still linked, so we can simply loop from
+         --  the original first node until we meet the node before which the
+         --  insertion is occurring. Note that this properly handles the case
+         --  where any of the analyzed nodes insert nodes after themselves,
+         --  expecting them to get analyzed.
+
+         while Node /= N loop
+            Analyze (Node);
+            Mark_Rewrite_Insertion (Node);
+            Next (Node);
+         end loop;
+      end if;
+
+   end Insert_Before_And_Analyze;
+
+   --  Version with check(s) suppressed
+
+   procedure Insert_Before_And_Analyze
+     (N : Node_Id; M : Node_Id; Suppress : Check_Id)
+   is
+   begin
+      if Suppress = All_Checks then
+         declare
+            Svg : constant Suppress_Record := Scope_Suppress;
+
+         begin
+            Scope_Suppress := (others => True);
+            Insert_Before_And_Analyze (N, M);
+            Scope_Suppress := Svg;
+         end;
+
+      else
+         declare
+            Svg : constant Boolean := Get_Scope_Suppress (Suppress);
+
+         begin
+            Set_Scope_Suppress (Suppress, True);
+            Insert_Before_And_Analyze (N, M);
+            Set_Scope_Suppress (Suppress, Svg);
+         end;
+      end if;
+   end Insert_Before_And_Analyze;
+
+   -----------------------------------
+   -- Insert_List_After_And_Analyze --
+   -----------------------------------
+
+   procedure Insert_List_After_And_Analyze (N : Node_Id; L : List_Id) is
+      After : constant Node_Id := Next (N);
+      Node  : Node_Id;
+
+   begin
+      if Is_Non_Empty_List (L) then
+
+         --  Capture the Node_Id of the first list node to be inserted.
+         --  This will still be the first node after the insert operation,
+         --  since Insert_List_After does not modify the Node_Id values.
+
+         Node := First (L);
+         Insert_List_After (N, L);
+
+         --  Now just analyze from the original first node until we get to
+         --  the successor of the original insertion point (which may be
+         --  Empty if the insertion point was at the end of the list). Note
+         --  that this properly handles the case where any of the analyze
+         --  calls result in the insertion of nodes after the analyzed
+         --  node (possibly calling this routine recursively).
+
+         while Node /= After loop
+            Analyze (Node);
+            Mark_Rewrite_Insertion (Node);
+            Next (Node);
+         end loop;
+      end if;
+
+   end Insert_List_After_And_Analyze;
+
+   --  Version with check(s) suppressed
+
+   procedure Insert_List_After_And_Analyze
+     (N : Node_Id; L : List_Id; Suppress : Check_Id)
+   is
+   begin
+      if Suppress = All_Checks then
+         declare
+            Svg : constant Suppress_Record := Scope_Suppress;
+
+         begin
+            Scope_Suppress := (others => True);
+            Insert_List_After_And_Analyze (N, L);
+            Scope_Suppress := Svg;
+         end;
+
+      else
+         declare
+            Svg : constant Boolean := Get_Scope_Suppress (Suppress);
+
+         begin
+            Set_Scope_Suppress (Suppress, True);
+            Insert_List_After_And_Analyze (N, L);
+            Set_Scope_Suppress (Suppress, Svg);
+         end;
+      end if;
+   end Insert_List_After_And_Analyze;
+
+   ------------------------------------
+   -- Insert_List_Before_And_Analyze --
+   ------------------------------------
+
+   procedure Insert_List_Before_And_Analyze (N : Node_Id; L : List_Id) is
+      Node : Node_Id;
+
+   begin
+      if Is_Non_Empty_List (L) then
+
+         --  Capture the Node_Id of the first list node to be inserted.
+         --  This will still be the first node after the insert operation,
+         --  since Insert_List_After does not modify the Node_Id values.
+
+         Node := First (L);
+         Insert_List_Before (N, L);
+
+         --  The insertion does not change the Id's of any of the nodes in
+         --  the list, and they are still linked, so we can simply loop from
+         --  the original first node until we meet the node before which the
+         --  insertion is occurring. Note that this properly handles the case
+         --  where any of the analyzed nodes insert nodes after themselves,
+         --  expecting them to get analyzed.
+
+         while Node /= N loop
+            Analyze (Node);
+            Mark_Rewrite_Insertion (Node);
+            Next (Node);
+         end loop;
+      end if;
+
+   end Insert_List_Before_And_Analyze;
+
+   --  Version with check(s) suppressed
+
+   procedure Insert_List_Before_And_Analyze
+     (N : Node_Id; L : List_Id; Suppress : Check_Id)
+   is
+   begin
+      if Suppress = All_Checks then
+         declare
+            Svg : constant Suppress_Record := Scope_Suppress;
+
+         begin
+            Scope_Suppress := (others => True);
+            Insert_List_Before_And_Analyze (N, L);
+            Scope_Suppress := Svg;
+         end;
+
+      else
+         declare
+            Svg : constant Boolean := Get_Scope_Suppress (Suppress);
+
+         begin
+            Set_Scope_Suppress (Suppress, True);
+            Insert_List_Before_And_Analyze (N, L);
+            Set_Scope_Suppress (Suppress, Svg);
+         end;
+      end if;
+   end Insert_List_Before_And_Analyze;
+
+   ----------
+   -- Lock --
+   ----------
+
+   procedure Lock is
+   begin
+      Entity_Suppress.Locked := True;
+      Scope_Stack.Locked := True;
+      Entity_Suppress.Release;
+      Scope_Stack.Release;
+   end Lock;
+
+   ---------------
+   -- Semantics --
+   ---------------
+
+   procedure Semantics (Comp_Unit : Node_Id) is
+
+      --  The following locations save the corresponding global flags and
+      --  variables so that they can be restored on completion. This is
+      --  needed so that calls to Rtsfind start with the proper default
+      --  values for these variables, and also that such calls do not
+      --  disturb the settings for units being analyzed at a higher level.
+
+      S_Full_Analysis    : constant Boolean          := Full_Analysis;
+      S_In_Default_Expr  : constant Boolean          := In_Default_Expression;
+      S_Inside_A_Generic : constant Boolean          := Inside_A_Generic;
+      S_New_Nodes_OK     : constant Int              := New_Nodes_OK;
+      S_Outer_Gen_Scope  : constant Entity_Id        := Outer_Generic_Scope;
+      S_Sem_Unit         : constant Unit_Number_Type := Current_Sem_Unit;
+
+      Save_Config_Switches : Config_Switches_Type;
+      --  Variable used to save values of config switches while we analyze
+      --  the new unit, to be restored on exit for proper recursive behavior.
+
+      procedure Do_Analyze;
+      --  Procedure to analyze the compilation unit. This is called more
+      --  than once when the high level optimizer is activated.
+
+      procedure Do_Analyze is
+      begin
+         Save_Scope_Stack;
+         New_Scope (Standard_Standard);
+         Scope_Suppress := Suppress_Options;
+         Scope_Stack.Table
+           (Scope_Stack.Last).Component_Alignment_Default := Calign_Default;
+         Scope_Stack.Table
+           (Scope_Stack.Last).Is_Active_Stack_Base := True;
+         Outer_Generic_Scope := Empty;
+
+         --  Now analyze the top level compilation unit node
+
+         Analyze (Comp_Unit);
+
+         --  Check for scope mismatch on exit from compilation
+
+         pragma Assert (Current_Scope = Standard_Standard
+                          or else Comp_Unit = Cunit (Main_Unit));
+
+         --  Then pop entry for Standard, and pop implicit types
+
+         Pop_Scope;
+         Restore_Scope_Stack;
+      end Do_Analyze;
+
+   --  Start of processing for Sem
+
+   begin
+      Compiler_State        := Analyzing;
+      Current_Sem_Unit      := Get_Cunit_Unit_Number (Comp_Unit);
+
+      Expander_Mode_Save_And_Set
+        (Operating_Mode = Generate_Code or Debug_Flag_X);
+
+      Full_Analysis         := True;
+      Inside_A_Generic      := False;
+      In_Default_Expression := False;
+
+      Set_Comes_From_Source_Default (False);
+      Save_Opt_Config_Switches (Save_Config_Switches);
+      Set_Opt_Config_Switches
+        (Is_Internal_File_Name (Unit_File_Name (Current_Sem_Unit)));
+
+      --  Only do analysis of unit that has not already been analyzed
+
+      if not Analyzed (Comp_Unit) then
+         Initialize_Version (Current_Sem_Unit);
+         if HLO_Active then
+            Expander_Mode_Save_And_Set (False);
+            New_Nodes_OK := 1;
+            Do_Analyze;
+            Reset_Analyzed_Flags (Comp_Unit);
+            Expander_Mode_Restore;
+            High_Level_Optimize (Comp_Unit);
+            New_Nodes_OK := 0;
+         end if;
+
+         Do_Analyze;
+      end if;
+
+      --  Save indication of dynamic elaboration checks for ALI file
+
+      Set_Dynamic_Elab (Current_Sem_Unit, Dynamic_Elaboration_Checks);
+
+      --  Restore settings of saved switches to entry values
+
+      Current_Sem_Unit       := S_Sem_Unit;
+      Full_Analysis          := S_Full_Analysis;
+      In_Default_Expression  := S_In_Default_Expr;
+      Inside_A_Generic       := S_Inside_A_Generic;
+      New_Nodes_OK           := S_New_Nodes_OK;
+      Outer_Generic_Scope    := S_Outer_Gen_Scope;
+
+      Restore_Opt_Config_Switches (Save_Config_Switches);
+      Expander_Mode_Restore;
+
+   end Semantics;
+
+   ------------------------
+   -- Set_Scope_Suppress --
+   ------------------------
+
+   procedure Set_Scope_Suppress (C : Check_Id; B : Boolean) is
+      S : Suppress_Record renames Scope_Suppress;
+
+   begin
+      case C is
+         when Access_Check        => S.Access_Checks        := B;
+         when Accessibility_Check => S.Accessibility_Checks := B;
+         when Discriminant_Check  => S.Discriminant_Checks  := B;
+         when Division_Check      => S.Division_Checks      := B;
+         when Elaboration_Check   => S.Discriminant_Checks  := B;
+         when Index_Check         => S.Elaboration_Checks   := B;
+         when Length_Check        => S.Discriminant_Checks  := B;
+         when Overflow_Check      => S.Overflow_Checks      := B;
+         when Range_Check         => S.Range_Checks         := B;
+         when Storage_Check       => S.Storage_Checks       := B;
+         when Tag_Check           => S.Tag_Checks           := B;
+         when All_Checks =>
+            raise Program_Error;
+      end case;
+   end Set_Scope_Suppress;
+
+end Sem;