------------------------------------------------------------------------------
--                                                                          --
--                          GNATCHECK COMPONENTS                            --
--                                                                          --
--               G N A T C H E C K . G L O B A L _ S T A T E                --
--                                                                          --
--                                 B o d y                                  --
--                                                                          --
--                     Copyright (C) 2005-2007, AdaCore                     --
--                                                                          --
-- GNATCHECK  is  free  software;  you can redistribute it and/or modify it --
-- under terms of the  GNU  General Public License as published by the Free --
-- Software Foundation;  either version 2, or ( at your option)  any  later --
-- version.  GNATCHECK  is  distributed in the hope that it will be useful, --
-- but  WITHOUT  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,  51 Franklin Street, Fifth --
-- Floor, Boston, MA 02110-1301, USA.                                       --
--                                                                          --
-- GNATCHECK is maintained by AdaCore (http://www.adacore.com).             --
--                                                                          --
------------------------------------------------------------------------------

pragma Ada_05;

with Ada.Characters.Conversions; use Ada.Characters.Conversions;
with Ada.Containers.Vectors;
--  with Ada.Containers.Indefinite_Vectors;
with Ada.Wide_Text_IO;

with GNAT.OS_Lib;                use GNAT.OS_Lib;

with Asis.Compilation_Units;     use Asis.Compilation_Units;
with Asis.Declarations;          use Asis.Declarations;
with Asis.Elements;              use Asis.Elements;
with Asis.Expressions;           use Asis.Expressions;
with Asis.Extensions;            use Asis.Extensions;
with Asis.Extensions.Flat_Kinds; use Asis.Extensions.Flat_Kinds;
with Asis.Statements;            use Asis.Statements;
with Asis.Text;                  use Asis.Text;

with ASIS_UL.Options;            use ASIS_UL.Options;
with ASIS_UL.Output;             use ASIS_UL.Output;

with Gnatcheck.ASIS_Utilities;   use Gnatcheck.ASIS_Utilities;
with Gnatcheck.Diagnoses;

package body Gnatcheck.Global_State is

   Ident_String : constant String := "   ";
   --  Used in the debug output of the global data structures

   -----------------------
   -- Local Subprograms --
   -----------------------

   function Is_Equal
     (GS_Node      : GS_Node_Id;
      El           : Asis.Element;
      Needed_Kind  : GS_Node_Kinds := Not_A_Node;
      Protected_Op : GS_Node_Id    := No_GS_Node)
      return         Boolean;
   --  Checks that GS_Node points to the call graph node corresponding to the
   --  given Element. Returns False if No (GS_Node). For the Protected_Op
   --  parameter, see the explanation in the documentation of Register_Entity.

   function Define_GS_Node_Kind (El : Asis.Element) return GS_Node_Kinds;
   --  Defines which node kind corresponds to the given Element

   function Register_Node
     (El         : Asis.Element;
      Node_Kind  : GS_Node_Kinds := Not_A_Node)
      return GS_Node_Id;
   --  Registers the node corresponding to the argument Element and returns its
   --  Id as a result. The caller is responsible for making sure that the
   --  corresponding Element has not been registered yet. Moreover, this
   --  function should be called only for the nodes that are used as the base
   --  for representing entities in the Global Structure, that is, to the
   --  results of Gnatcheck.ASIS_Utilities.Corresponding_Element.
   --  If set to non-null value, Encl_Scope is used to initialize the
   --  corresponding field of the allocated node
   --  If set, Node_Kind is used to set the kind of the new node, otherwise
   --  the kind is detected from the Element argument.
   --  This function can never return No_CG_Node.

   procedure Store_Needed_Source (El : Asis.Element);
   --  Tries to detect and to store in the Source Table the (full normalized)
   --  name of the source file that is needed to get the full information about
   --  the given element El. If the source cannot be located and stored,
   --  generates the corresponding error message.

   ------------------------------------------
   -- Representing Tasks in the Call Graph --
   ------------------------------------------

   --  We consider each task object as a callable entity that is called in
   --  the place where the task is created, either statically or dynamically.

   --  For a task entity, we consider that the corresponding task body in the
   --  same way as a subprogram body (to detect entities called by this task
   --  entity). This body is considered as being boind to the corresponding
   --  task definition (but not to task object or task type declaration - to
   --  avoid the difference between single tasks and task types)

   --  Any entry call we consider as a call to the whole task object. This is
   --  a rather big simplification, probably too rough for the tasks our
   --  Call Graph is supposed to be used for. Probably we should consider for
   --  each task entry a set of calls that may be generated by the
   --  corresponding accept statements for this call.

   --  At the implementation level, for task definitions, we store a
   --  (non-callable!) entity that represents the task (with all the calls
   --  issued from the task body) and for every task object we store the
   --  reference to this "task definition entity" (including the task objects
   --  declared by single task declarations)

   --  In case if we do not have a task definition, we create the corresponding
   --  A_Task_Definition node on the base of the corresponding task type
   --  declaration or single task declaration

   --  ??? Dynamically created tasks?
   --  ??? Tasks that are components of other data structures?
   --  ??? Tasks as parameters

   function Corresponding_Task_Node
     (El            : Asis.Element;
      Single_Task   : Boolean    := True;
      Task_Def_Node : GS_Node_Id := No_GS_Node)
      return          GS_Node_Id;
   --  Version of the Corresponding_Node function from above that takes into
   --  account the specifics of representing tasks. Two additional parameters
   --  are used if we have to allocate a new task node. The boolean Single_Task
   --  flag is used to make the difference between a task declared by a single
   --  task declaration (in this case it has its "own" definition and body) and
   --  a task declared by an object declaration or created by allocators (when
   --  the task type is used to define the task object). If Single_Task is set
   --  OFF, Task_Def_Node should be set to the corresponding task definition
   --  node, otherwise Task_Def_Node is ignored.

   procedure Set_Protected_Op (For_Obj : GS_Node_Id; Pr_Op : GS_Node_Id);
   --  Sets for the node representing a protected operation belonging to a
   --  specific protected object the reference to the node representing the
   --  executable body of the corresponding protected operation.

   procedure Set_Enclosing_Protected_Definition
     (For_PO : GS_Node_Id;
      P_Def  : GS_Node_Id);
   --  Sets the reference to enclosing protected definition for a node
   --  representing the protected operation body

   procedure Set_Priority_Defined (N : GS_Node_Id);
   --  Sets for N that for the corresponding entity the priority is already
   --  defined

   ----------------------------------------------------------------------------
   -- Representing Protected Types, Objects and Operations in the Call Graph --
   ----------------------------------------------------------------------------

   --  For each protected operation, we register it in the same way as a task
   --  type (as a non-callable entity for which we store a set of calls issued
   --  from the corresponding protected body, for this we use
   --  A_Protected_Procedure_Body, A_Protected_Function_Body and
   --  A_Protected_Entry_Body node kinds). For each protected object, we
   --  consider a separate "instances" of all the corresponding protected
   --  operations (and use for this A_Protected_Procedure,
   --  A_Protected_Function and A_Protected_Entry node kinds) sharing the same
   --  bodies (and, therefore, the same call chains)

   --  For each protected operation, the SLOC field points to the location of
   --  the declaration of a protected object the operation belongs to, and
   --  Node_Field_1 should be the link to the corresponding
   --  A_Protected_..._Body node.

   --  That is, if a protected type P_T has a protected operation P_Op, and
   --  if we have two different objects of the protected type P_T P_Obj1 and
   --  P_Obj2, then we consider P_Obj1.P_Op and P_Obj2.P_Op as two different
   --  callable entities

   --  As it is implemented now, if a given protected operation belonging to a
   --  given protected object is not called, it is not represented in the
   --  Call Graph.

   --  ??? The same questions as for tasks:
   --  ??? Dynamically created protected objects
   --  ??? Protected objects being components of other data structures
   --  ??? Protected objects as parameters

   -----------------------------------------
   -- Representing (subprogram) renamings --
   -----------------------------------------

   --  Renaming-as-body is treated as a body of a separate callable entity
   --  (that is, it itself is not considered as a callable entity). This entity
   --  has the same call chain as the renamed entity, but calls to this entity
   --  are not considered as calls to renamed entity.

   --  Renaming-as-declaration is treated as a separate callable entity. It
   --  has the same call chain as the renamed entity, and each call to a
   --  renaming entity is also treated as a call to the renamed entity. That
   --  is a set of all the calls to a renaming entity is a subset of the set of
   --  all the calls to the renamed entity.

   --  For a function renaming-as-declaration, in case if a renamed entity is
   --  an enumeration literal, we consider such a renaming as defining a new
   --  function, this function does not call anything but it may be called by
   --  any other node. The idea is to detect unused renamings.

   --  If the renamed entity cannot be statically determined, ???

   --  What happens if we cannot detect the renamed entity because of some
   --  reason???

   --------------------------------
   -- Hash table for Nodes Table --
   --------------------------------

   Hash_Num : constant Integer := 2**16;  --  ???
   --  Number of headers in the hash table. There is no special reason in this
   --  choice.

   Hash_Max : constant Integer := Hash_Num - 1;
   --  Indexes in the hash header table run from 0 to Hash_Num - 1

   subtype Hash_Index_Type is Integer range 0 .. Hash_Max;
   --  Range of hash index values

   Hash_Table : array (Hash_Index_Type) of GS_Node_Id;
   --  The hash table is used to locate existing entries in the nodes table.
   --  The entries point to the first nodes table entry whose hash value
   --  matches the hash code. Then subsequent nodes table entries with the
   --  same hash code value are linked through the Hash_Link fields.

   function Hash (El : Asis.Element) return Hash_Index_Type; --  ???
   --  Compute hash code for its argument. At the moment we are using rather
   --  primitive hash function, this should be revised at some point

   ------------------
   -- Iteratr data --
   ------------------

   Iterator_Node : Existing_GS_Node_Id;
   --  Node to iterate through the set of all calls/callers for.

   Iterating_Set : Call_Set_Kinds;
   --  Indicates which set - calls or callers - should be iterated through

   Current_Node : GS_Node_Id;
   --  Next node to be returned by the iterator

   Iterator_Done : Boolean;
   --  Indicates if the iterator is complete.

   procedure Advance_Iterator;
   --  If Iterator_Done, sets Current_Node to No_GS_Node. Otherwise
   --  advances Current_Node to set it to put to the next node that is a
   --  call/caller (depending on Iterating_Set) for Iterator_Node. (Note, that
   --  even if before calling Advance_Iterator Current_Node already is a
   --  call/caller node for Iterator_Node, this procedure first adds 1 to
   --  Current_Node and only after that looks for nearest call/caller node.
   --  If there is no call/caller node for Iterator_Node, sets Current_Node to
   --  No_GS_Node and sets Iterator_Done ON.

   -----------------
   -- Nodes table --
   -----------------

   package body GS_Nodes is

      package GS_Nodes_Container is new Ada.Containers.Vectors
--      package GS_Nodes_Container is new Ada.Containers.Indefinite_Vectors
        (Index_Type   => Existing_GS_Node_Id,
         Element_Type => GS_Node_Record);

      GS_Nodes_Table : GS_Nodes_Container.Vector;
      --  A set of nodes making up the global structure. (Mimics the Table
      --  variable from the instantiation of the GNAT Table package)

      ------------------------------------------------------------------------
      -- Node record update routines used in interface node update routines --
      ------------------------------------------------------------------------

      --  The following global variables are used to pass parameter into
      --  the node record update routines:

      Any_Priority_Tmp       : Any_Priority;
      Bool_Tmp               : Boolean;
      Call_Set_Kind_Tmp      : Call_Set_Kinds;
      GS_Node_Id_Tmp         : GS_Node_Id;
      Int_Tmp                : Integer;
      Renaming_Kind_Tmp      : Renaming_Kinds;
      Side_Effect_Status_Tmp : Side_Effect_Statuses;
      String_Loc_Tmp         : String_Loc;

      --  Procedures for node attribute updates:

      procedure Set_Body_Analyzed      (For_Node_Rec : in out GS_Node_Record);
      procedure Set_Call_To_Unknown_SE (For_Node_Rec : in out GS_Node_Record);

      procedure Set_Contains_Dispatching_Call
        (For_Node_Rec : in out GS_Node_Record);
      procedure Set_Contains_Dynamic_Call
        (For_Node_Rec : in out GS_Node_Record);

      procedure Set_Dynamic_Priority (For_Node_Rec : in out GS_Node_Record);

      procedure Set_Enclosing_Scope (For_Node_Rec : in out GS_Node_Record);

      procedure Set_GS_Node_Renaming_Kind
        (For_Node_Rec : in out GS_Node_Record);

      procedure Set_Hash_Link       (For_Node_Rec : in out GS_Node_Record);

      procedure Set_Is_Used  (For_Node_Rec : in out GS_Node_Record);
      procedure Set_Is_Scope (For_Node_Rec : in out GS_Node_Record);

      procedure Set_Local_Side_Effect_Level
        (For_Node_Rec : in out GS_Node_Record);

      procedure Set_Node_Field_1 (For_Node_Rec : in out GS_Node_Record);
      --  Is used in different update routines

      procedure Set_Priority            (For_Node_Rec : in out GS_Node_Record);
      procedure Set_Priority_Defined    (For_Node_Rec : in out GS_Node_Record);
      procedure Set_Scope_Level         (For_Node_Rec : in out GS_Node_Record);
      procedure Set_Side_Effect_Defined (For_Node_Rec : in out GS_Node_Record);
      procedure Set_Side_Effect_Status  (For_Node_Rec : in out GS_Node_Record);

      --  Procedures for node call set upades:
      procedure Add_Node_To_List (For_Node_Rec : in out GS_Node_Record);

      ------------
      -- Append --
      ------------

      procedure Append (New_Node : GS_Node_Record) is
      begin
         GS_Nodes_Container.Append (Container => GS_Nodes_Table,
                                    New_Item  => New_Node);
      end Append;

      ----------
      -- Last --
      ----------

      function Last return GS_Node_Id is
      begin
         return GS_Nodes_Container.Last_Index (GS_Nodes_Table);
      end Last;

      -----------
      -- Table --
      -----------

      function Table (N : GS_Node_Id) return GS_Node_Record_Access is
         Result : GS_Node_Record_Access;

         procedure Process (E : in out GS_Node_Record);

         procedure Process (E : in out GS_Node_Record) is
         begin
            Result := E'Unrestricted_Access;
         end Process;
      begin
         GS_Nodes_Container.Update_Element
           (Container => GS_Nodes_Table,
            Index     => N,
            Process   => Process'Access);

         return Result;
      end Table;

      --------------------------------------
      -- Node attribute update procedures --
      --------------------------------------

      ------------------------
      --  Set_Body_Analyzed --
      ------------------------

      procedure Set_Body_Analyzed (For_Node_Rec : in out GS_Node_Record) is
      begin
         For_Node_Rec.Body_Analyzed := Bool_Tmp;
      end Set_Body_Analyzed;

      procedure Set_Body_Analyzed (N : GS_Node_Id; Val : Boolean) is
      begin
         Bool_Tmp := Val;

         GS_Nodes_Container.Update_Element
           (Container => GS_Nodes_Table,
            Index     => N,
            Process   => Set_Body_Analyzed'Access);
      end Set_Body_Analyzed;

      -----------------------------
      --  Set_Call_To_Unknown_SE --
      -----------------------------

      procedure Set_Call_To_Unknown_SE
        (For_Node_Rec : in out GS_Node_Record)
      is
      begin
         For_Node_Rec.Call_To_Unknown_SE := Bool_Tmp;
      end Set_Call_To_Unknown_SE;

      procedure Set_Call_To_Unknown_SE (N : GS_Node_Id; Val : Boolean) is
      begin
         Bool_Tmp := Val;

         GS_Nodes_Container.Update_Element
           (Container => GS_Nodes_Table,
            Index     => N,
            Process   => Set_Call_To_Unknown_SE'Access);
      end Set_Call_To_Unknown_SE;

      -----------------------------------
      -- Set_Contains_Dispatching_Call --
      -----------------------------------

      procedure Set_Contains_Dispatching_Call
        (For_Node_Rec : in out GS_Node_Record)
      is
      begin
         For_Node_Rec.Contains_Dispatching_Call := True;
      end Set_Contains_Dispatching_Call;

      procedure Set_Contains_Dispatching_Call (N : GS_Node_Id) is
      begin
         GS_Nodes_Container.Update_Element
           (Container => GS_Nodes_Table,
            Index     => N,
            Process   => Set_Contains_Dispatching_Call'Access);
      end Set_Contains_Dispatching_Call;

      -------------------------------
      -- Set_Contains_Dynamic_Call --
      -------------------------------

      procedure Set_Contains_Dynamic_Call
        (For_Node_Rec : in out GS_Node_Record)
      is
      begin
         For_Node_Rec.Contains_Dynamic_Call := True;
      end Set_Contains_Dynamic_Call;

      procedure Set_Contains_Dynamic_Call (N : GS_Node_Id) is
      begin
         GS_Nodes_Container.Update_Element
           (Container => GS_Nodes_Table,
            Index     => N,
            Process   => Set_Contains_Dynamic_Call'Access);
      end Set_Contains_Dynamic_Call;

      -------------------------------
      -- Set_Dynamic_Priority --
      -------------------------------

      procedure Set_Dynamic_Priority (For_Node_Rec : in out GS_Node_Record) is
      begin
         For_Node_Rec.Has_Dynamic_Priority := True;
      end Set_Dynamic_Priority;

      procedure Set_Dynamic_Priority (N : GS_Node_Id) is
      begin
         GS_Nodes_Container.Update_Element
           (Container => GS_Nodes_Table,
            Index     => N,
            Process   => Set_Dynamic_Priority'Access);
      end Set_Dynamic_Priority;

      ----------------------------------------
      -- Set_Enclosing_Protected_Definition --
      ----------------------------------------

      procedure Set_Enclosing_Protected_Definition
        (N   : GS_Node_Id;
         Val : GS_Node_Id)
      is
      begin
         pragma Assert
           (GS_Node_Kind (N) in
             A_Protected_Procedure_Body .. A_Protected_Entry_Body);

         GS_Node_Id_Tmp := Val;

         GS_Nodes_Container.Update_Element
           (Container => GS_Nodes_Table,
            Index     => N,
            Process   => Set_Node_Field_1'Access);
      end Set_Enclosing_Protected_Definition;

      -------------------------
      -- Set_Enclosing_Scope --
      -------------------------

      procedure Set_Enclosing_Scope (For_Node_Rec : in out GS_Node_Record) is
      begin
         For_Node_Rec.Enclosing_Scope := GS_Node_Id_Tmp;
      end Set_Enclosing_Scope;

      procedure Set_Enclosing_Scope
        (N   : GS_Node_Id;
         Val : Scope_Id := Current_Scope)
      is
      begin
         GS_Node_Id_Tmp := Val;

         GS_Nodes_Container.Update_Element
           (Container => GS_Nodes_Table,
            Index     => N,
            Process   => Set_Enclosing_Scope'Access);
      end Set_Enclosing_Scope;

      ----------------------
      -- Set_Node_Field_1 --
      ----------------------

      procedure Set_Node_Field_1
        (For_Node_Rec : in out GS_Node_Record)
      is
      begin
         For_Node_Rec.Node_Field_1 := GS_Node_Id_Tmp;
      end Set_Node_Field_1;

      -------------------------------
      -- Set_GS_Node_Renaming_Kind --
      -------------------------------

      procedure Set_GS_Node_Renaming_Kind
        (For_Node_Rec : in out GS_Node_Record)
      is
      begin
         For_Node_Rec.Renaming_Kind := Renaming_Kind_Tmp;
      end Set_GS_Node_Renaming_Kind;

      procedure Set_GS_Node_Renaming_Kind
        (N   : GS_Node_Id;
         Val : Renaming_Kinds)
      is
      begin
         Renaming_Kind_Tmp := Val;

         GS_Nodes_Container.Update_Element
           (Container => GS_Nodes_Table,
            Index     => N,
            Process   => Set_GS_Node_Renaming_Kind'Access);
      end Set_GS_Node_Renaming_Kind;

      -------------------
      -- Set_Hash_Link --
      -------------------

      procedure Set_Hash_Link (For_Node_Rec : in out GS_Node_Record) is
      begin
         For_Node_Rec.Hash_Link := GS_Node_Id_Tmp;
      end Set_Hash_Link;

      procedure Set_Hash_Link (N : GS_Node_Id; Val : GS_Node_Id) is
      begin
         GS_Node_Id_Tmp := Val;

         GS_Nodes_Container.Update_Element
           (Container => GS_Nodes_Table,
            Index     => N,
            Process   => Set_Hash_Link'Access);
      end Set_Hash_Link;

      ------------------
      -- Set_Is_Used --
      ------------------

      procedure Set_Is_Used (For_Node_Rec : in out GS_Node_Record) is
      begin
         For_Node_Rec.Is_Used := True;
      end Set_Is_Used;

      procedure Set_Is_Used (N : GS_Node_Id) is
      begin

         GS_Nodes_Container.Update_Element
           (Container => GS_Nodes_Table,
            Index     => N,
            Process   => Set_Is_Used'Access);
      end Set_Is_Used;

      ------------------
      -- Set_Is_Scope --
      ------------------

      procedure Set_Is_Scope (For_Node_Rec : in out GS_Node_Record) is
      begin
         For_Node_Rec.Is_Scope := True;
      end Set_Is_Scope;

      procedure Set_Is_Scope (N : GS_Node_Id) is
      begin

         GS_Nodes_Container.Update_Element
           (Container => GS_Nodes_Table,
            Index     => N,
            Process   => Set_Is_Scope'Access);
      end Set_Is_Scope;

      ---------------------------------
      -- Set_Local_Side_Effect_Level --
      ---------------------------------

      procedure Set_Local_Side_Effect_Level
        (For_Node_Rec : in out GS_Node_Record)
      is
      begin
         For_Node_Rec.Local_Side_Effect_Level := Int_Tmp;
      end Set_Local_Side_Effect_Level;

      procedure Set_Local_Side_Effect_Level
        (N   : Scope_Id;
         Val : Scope_Levels)
      is
      begin
         Int_Tmp := Val;

         GS_Nodes_Container.Update_Element
           (Container => GS_Nodes_Table,
            Index     => N,
            Process   => Set_Local_Side_Effect_Level'Access);
      end Set_Local_Side_Effect_Level;

      ------------------
      -- Set_Priority --
      ------------------

      procedure Set_Priority (For_Node_Rec : in out GS_Node_Record) is
      begin
         For_Node_Rec.Node_Priority    := Any_Priority_Tmp;
         For_Node_Rec.Priority_Defined := True;
      end Set_Priority;

      procedure Set_Priority (N : GS_Node_Id; Val : Any_Priority) is
      begin
         Any_Priority_Tmp := Val;

         GS_Nodes_Container.Update_Element
           (Container => GS_Nodes_Table,
            Index     => N,
            Process   => Set_Priority'Access);

      end Set_Priority;

      --------------------------
      -- Set_Priority_Defined --
      --------------------------

      procedure Set_Priority_Defined (For_Node_Rec : in out GS_Node_Record) is
      begin
         For_Node_Rec.Priority_Defined := True;
      end Set_Priority_Defined;

      procedure Set_Priority_Defined (N : GS_Node_Id) is
      begin

         GS_Nodes_Container.Update_Element
           (Container => GS_Nodes_Table,
            Index     => N,
            Process   => Set_Priority_Defined'Access);
      end Set_Priority_Defined;

      ----------------------
      -- Set_Protected_Op --
      ----------------------

      procedure Set_Protected_Op (N : GS_Node_Id; Val : GS_Node_Id) is
      begin
         pragma Assert (GS_Node_Kind (N) in
                          A_Protected_Procedure .. A_Protected_Entry);
         GS_Node_Id_Tmp := Val;

         GS_Nodes_Container.Update_Element
           (Container => GS_Nodes_Table,
            Index     => N,
            Process   => Set_Node_Field_1'Access);
      end Set_Protected_Op;

      ------------------------
      -- Set_Renamed_Entity --
      ------------------------

      procedure Set_Renamed_Entity (N : GS_Node_Id; Val : GS_Node_Id) is
      begin
         GS_Node_Id_Tmp := Val;

         GS_Nodes_Container.Update_Element
           (Container => GS_Nodes_Table,
            Index     => N,
            Process   => Set_Node_Field_1'Access);
      end Set_Renamed_Entity;

      ---------------------
      -- Set_Scope_Level --
      ---------------------

      procedure Set_Scope_Level (For_Node_Rec : in out GS_Node_Record) is
      begin
         For_Node_Rec.Scope_Level := Int_Tmp;
      end Set_Scope_Level;

      procedure Set_Scope_Level (N : GS_Node_Id; Val : Scope_Levels) is
      begin
         Int_Tmp := Val;

         GS_Nodes_Container.Update_Element
           (Container => GS_Nodes_Table,
            Index     => N,
            Process   => Set_Scope_Level'Access);
      end Set_Scope_Level;

      ------------------------------
      --  Set_Side_Effect_Defined --
      ------------------------------

      procedure Set_Side_Effect_Defined
        (For_Node_Rec : in out GS_Node_Record)
      is
      begin
         For_Node_Rec.Side_Effect_Defined := Bool_Tmp;
      end Set_Side_Effect_Defined;

      procedure Set_Side_Effect_Defined
        (N   : Scope_Id;
         Val : Boolean := True)
      is
      begin
         Bool_Tmp := Val;

         GS_Nodes_Container.Update_Element
           (Container => GS_Nodes_Table,
            Index     => N,
            Process   => Set_Side_Effect_Defined'Access);
      end Set_Side_Effect_Defined;

      ------------------------------
      --  Set_Side_Effect_Status --
      ------------------------------

      procedure Set_Side_Effect_Status
        (For_Node_Rec : in out GS_Node_Record)
      is
      begin
         For_Node_Rec.SE_Status := Side_Effect_Status_Tmp;
         For_Node_Rec.SE_SLOC   := String_Loc_Tmp;
      end Set_Side_Effect_Status;

      procedure Set_Side_Effect_Status
        (Of_Scope : Scope_Id;
         To       : Side_Effect_Statuses;
         At_SLOC  : String_Loc := Nil_String_Loc)
      is
      begin
         Side_Effect_Status_Tmp := To;
         String_Loc_Tmp         := At_SLOC;

         GS_Nodes_Container.Update_Element
           (Container => GS_Nodes_Table,
            Index     => Of_Scope,
            Process   => Set_Side_Effect_Status'Access);
      end Set_Side_Effect_Status;

      --------------------------
      -- Set_Task_Definition --
      --------------------------

      procedure Set_Task_Definition (N : GS_Node_Id; Val : GS_Node_Id) is
      begin
         pragma Assert (GS_Node_Kind (N) = A_Task_Object);

         GS_Node_Id_Tmp := Val;

         GS_Nodes_Container.Update_Element
           (Container => GS_Nodes_Table,
            Index     => N,
            Process   => Set_Node_Field_1'Access);
      end Set_Task_Definition;

      -------------------------------------
      -- Node call set update procedures --
      -------------------------------------

      procedure Add_Call_Set
        (To_Node    : GS_Node_Id;
         Target_Set : Call_Set_Kinds;
         From_Node  : GS_Node_Id;
         Source_Set : Call_Set_Kinds)
      is
         procedure Add_Call_Set (For_Node_Rec : in out GS_Node_Record);
         --  Do the job for the corresponding node record;

         procedure Add_Call_Set (For_Node_Rec : in out GS_Node_Record) is
            Call_Set_To_Add : Call_Lists.Set;
         begin
            case Source_Set is
               when Calls =>
                  Call_Set_To_Add := GS_Nodes.Table (From_Node).Calls_Chain;
               when Callers =>
                  Call_Set_To_Add := GS_Nodes.Table (From_Node).Callers_Chain;
            end case;

            case Target_Set is
               when Calls =>
                  Call_Lists.Union
                    (Target => For_Node_Rec.Calls_Chain,
                     Source => Call_Set_To_Add);
               when Callers =>
                  Call_Lists.Union
                    (Target => For_Node_Rec.Callers_Chain,
                     Source => Call_Set_To_Add);
            end case;

         end Add_Call_Set;

      begin

         GS_Nodes_Container.Update_Element
           (Container => GS_Nodes_Table,
            Index     => To_Node,
            Process   => Add_Call_Set'Access);
      end Add_Call_Set;

      ----------------------
      -- Add_Node_To_List --
      ----------------------

      procedure Add_Node_To_List (For_Node_Rec : in out GS_Node_Record) is
         Position : Call_Lists.Cursor;
      begin

         case Call_Set_Kind_Tmp is

            when Calls =>
               Call_Lists.Insert
                (Container => For_Node_Rec.Calls_Chain,
                 New_Item  => GS_Node_Id_Tmp,
                 Position  => Position,
                 Inserted  => Bool_Tmp);

            when Callers =>
               Call_Lists.Insert
                (Container => For_Node_Rec.Callers_Chain,
                 New_Item  => GS_Node_Id_Tmp,
                 Position  => Position,
                 Inserted  => Bool_Tmp);

         end case;

      end Add_Node_To_List;

      procedure Add_Node_To_List
        (To_Node     :     GS_Node_Id;
         Node_To_Add :     GS_Node_Id;
         Set_To_Add  :     Call_Set_Kinds;
         Inserted    : out Boolean)
      is
      begin
         Call_Set_Kind_Tmp := Set_To_Add;
         GS_Node_Id_Tmp    := Node_To_Add;

         GS_Nodes_Container.Update_Element
           (Container => GS_Nodes_Table,
            Index     => To_Node,
            Process   => Add_Node_To_List'Access);

         Inserted := Bool_Tmp;
      end Add_Node_To_List;

   begin  --  GS_Nodes
      GS_Nodes_Container.Reserve_Capacity
        (Container => GS_Nodes_Table,
         Capacity  => 1_000);

   end GS_Nodes;

   ----------------------
   -- Advance_Iterator --
   ----------------------

   procedure Advance_Iterator is
      Found : Boolean := False;
   begin

      if Iterator_Done then
         Current_Node := No_GS_Node;
      else
         Current_Node := Current_Node + 1;

         if Iterating_Set = Calls then

            for J in Current_Node .. GS_Nodes.Last loop

               if Matrix (Iterator_Node, J) then
                  Current_Node := J;
                  Found        := True;
                  exit;
               end if;

            end loop;

         else

            for J in Current_Node .. GS_Nodes.Last loop
               if Matrix (J, Iterator_Node) then
                  Current_Node := J;
                  Found        := True;
                  exit;
               end if;
            end loop;

         end if;

         if not Found then
            Current_Node  := No_GS_Node;
            Iterator_Done := True;
         end if;

      end if;

   end Advance_Iterator;

   ---------------------------
   -- Build_Recursive_Chain --
   ---------------------------

   procedure Build_Recursive_Chain
     (For_Node      :     GS_Node_Id;
      Recursive_Set : out Call_Lists.Set)
   is
      Next_Called_Node : GS_Node_Id;
   begin

      Call_Lists.Clear (Recursive_Set);
      Call_Lists.Insert (Recursive_Set, For_Node);

      Reset_Itrerator (For_Node => For_Node, Call_Set => Calls);
      Next_Called_Node := Next_Node;

      while Present (Next_Called_Node) loop

         if Next_Called_Node /= For_Node
           and then
            Is_Recursive_Node (Next_Called_Node)
           and then
            Calls (Next_Called_Node, For_Node)
         then
            Call_Lists.Insert (Recursive_Set, Next_Called_Node);
         end if;

         Next_Called_Node := Next_Node;

      end loop;

   end Build_Recursive_Chain;

   -------------------
   -- Body_Analyzed --
   -------------------

   function Body_Analyzed (N : GS_Node_Id) return Boolean is
   begin
      return GS_Nodes.Table (N).Body_Analyzed;
   end Body_Analyzed;

   -----------
   -- Calls --
   -----------

   function Calls (N1, N2 : GS_Node_Id) return Boolean is
   begin
      return Matrix (N1, N2);
   end Calls;

   ------------------------
   -- Call_To_Unknown_SE --
   ------------------------

   function Call_To_Unknown_SE (Scope : Scope_Id) return Boolean is
   begin
      return GS_Nodes.Table (Scope).Call_To_Unknown_SE;
   end Call_To_Unknown_SE;

   -------------------------------------
   -- Complete_Information_Extraction --
   -------------------------------------

   function Complete_Information_Extraction (N : GS_Node_Id) return Boolean is
      pragma Unreferenced (N);
   begin
      pragma Assert (False);
      --  Placeholder at the moment
      return False;
   end Complete_Information_Extraction;

   -------------------------------
   -- Contains_Dispatching_Call --
   -------------------------------

   function Contains_Dispatching_Call (N : GS_Node_Id) return Boolean is
   begin
      return GS_Nodes.Table (N).Contains_Dispatching_Call;
   end Contains_Dispatching_Call;

   ---------------------------
   -- Contains_Dynamic_Call --
   ---------------------------

   function Contains_Dynamic_Call (N : GS_Node_Id) return Boolean is
   begin
      return GS_Nodes.Table (N).Contains_Dynamic_Call;
   end Contains_Dynamic_Call;

   --------------------------------
   -- Correct_Side_Effect_Status --
   --------------------------------

   procedure Correct_Side_Effect_Status
     (For_Node  : GS_Node_Id;
      From_Node : GS_Node_Id)
   is
      For_SE  : constant Side_Effect_Statuses := Side_Effect_Status (For_Node);
      From_SE : constant Side_Effect_Statuses :=
        Side_Effect_Status (From_Node);
   begin

      if For_SE < Global_Side_Effect then

         if For_SE < From_SE
           and then
            not (From_SE = Local_Side_Effect
              and then
                 Local_Side_Effect_Level (From_Node) >= Scope_Level (For_Node))
         then
            Set_Side_Effect_Status
              (Of_Scope => For_Node,
               To       => From_SE);
            --  This sets the side effect cause SLOC for For_Node to
            --  Nil_String_Loc

            if From_SE = Local_Side_Effect then
               Set_Local_Side_Effect_Level
                 (Of_Scope => For_Node,
                  To_Level => Local_Side_Effect_Level (From_Node));
            end if;

         elsif For_SE = From_SE
            and then
               For_SE = Local_Side_Effect
            and then
               Local_Side_Effect_Level (For_Node) >
               Local_Side_Effect_Level (From_Node)
         then
            Set_Side_Effect_Status
              (Of_Scope => For_Node,
               To       => From_SE);
            --  This sets the side effect cause SLOC for For_Node to
            --  Nil_String_Loc

            Set_Local_Side_Effect_Level
              (For_Node,
               Local_Side_Effect_Level (From_Node));
         end if;

         if Side_Effect_Status (For_Node) = Global_Side_Effect then
            Set_Side_Effect_Defined (For_Node);
            Set_Call_To_Unknown_SE (For_Node, False);
         end if;

      end if;

   end Correct_Side_Effect_Status;

   ------------------------
   -- Corresponding_Node --
   ------------------------

   function Corresponding_Node
     (El          : Asis.Element;
      Needed_Kind : GS_Node_Kinds := Not_A_Node)
      return        GS_Node_Id
   is
      Tmp_El     : Asis.Element;
      Task_Def_E : Asis.Element;
      Task_Def_N : GS_Node_Id;
      Result     : GS_Node_Id := Find_Node (El, Needed_Kind => Needed_Kind);
   begin

      if No (Result) and then not Is_Nil (El) then
         Tmp_El := Enclosing_Element (El);

         --  The following IF statement is needed to process the situation when
         --  we have a task entry call, but we have not created yet the node
         --  representing this task. The code in the IF path is very close
         --  to the body of Store_Task_Creation_Arc. For F815-005.

         if Needed_Kind = Not_A_Node
           and then
            Is_Task_Creation (Tmp_El)
         then

            case Flat_Element_Kind (Tmp_El) is
               when A_Single_Task_Declaration =>
                  Result :=
                    Corresponding_Task_Node (Tmp_El, Single_Task => True);

               when A_Variable_Declaration |
                    A_Constant_Declaration =>

                  Task_Def_E := Get_Root_Type (Tmp_El);

                  if not Is_Nil (Type_Declaration_View (Task_Def_E)) then
                     Task_Def_E := Type_Declaration_View (Task_Def_E);
                  end if;

                  Task_Def_N :=
                    Corresponding_Node (Task_Def_E, A_Task_Definition);

                  Result :=
                    Corresponding_Task_Node
                      (El,
                       Single_Task   => False,
                       Task_Def_Node => Task_Def_N);

               when others =>
                  null;
                  pragma Assert (False);
            end case;

         else
            Result := Register_Node (El, Needed_Kind);
         end if;

      end if;

      return Result;
   end Corresponding_Node;

   -------------------------------------
   -- Corresponding_Protected_Op_Node --
   -------------------------------------

   function Corresponding_Protected_Op_Node
     (Protected_Obj : Asis.Element;
      Protected_Op  : GS_Node_Id)
      return GS_Node_Id
   is
      Result          : GS_Node_Id :=
        Find_Node (Protected_Obj, Protected_Op => Protected_Op);
      Res_Kind        : GS_Node_Kinds;
      Encl_Scope_El   : Asis.Element;
      Encl_Scope_Node : Scope_Id;
   begin

      if No (Result) then

         case GS_Node_Kind (Protected_Op) is
            when A_Protected_Procedure_Body =>
               Res_Kind := A_Protected_Procedure;
            when A_Protected_Function_Body =>
               Res_Kind := A_Protected_Function;
            when A_Protected_Entry_Body =>
               Res_Kind := A_Protected_Entry;
            when others =>
               pragma Assert (False);
               Res_Kind := Not_A_Node;
         end case;

         Result := Register_Node (Protected_Obj, Node_Kind => Res_Kind);
         Set_Protected_Op (Result, Protected_Op);

         Encl_Scope_El   := Enclosing_Scope (Protected_Obj);
         Encl_Scope_Node := Corresponding_Node (Encl_Scope_El);

         Set_Enclosing_Scope (Result, Encl_Scope_Node);  --  ?????
      end if;

      return Result;
   end Corresponding_Protected_Op_Node;

   -----------------------------
   -- Corresponding_Task_Node --
   -----------------------------

   function Corresponding_Task_Node
     (El            : Asis.Element;
      Single_Task   : Boolean    := True;
      Task_Def_Node : GS_Node_Id := No_GS_Node)
      return          GS_Node_Id
   is
      Result          : GS_Node_Id := Find_Node (El);
      Definition_El   : Asis.Element;
      Definition_Node : GS_Node_Id := Task_Def_Node;
   begin

      if No (Result) then
         Result := Register_Node (El, Node_Kind => A_Task_Object);

         if Single_Task then
            Definition_El := Object_Declaration_View (El);

            if Is_Nil (Definition_El) then
               Definition_El := El;
            end if;

            Definition_Node :=
              Corresponding_Node (Definition_El, A_Task_Definition);
         end if;

         Set_Task_Definition (Result, Definition_Node);

      end if;

      return Result;
   end Corresponding_Task_Node;

   -------------------
   -- Current_Scope --
   -------------------

   function Current_Scope return Scope_Id is
   begin

      if Current_Scopes.Last >= Current_Scopes.First then
         return Current_Scopes.Table (Current_Scopes.Last);
      else
         raise Scope_Stack_Error;
      end if;

   end Current_Scope;

   -------------------------
   -- Define_GS_Node_Kind --
   -------------------------

   function Define_GS_Node_Kind (El : Asis.Element) return GS_Node_Kinds is
      Result    :          GS_Node_Kinds      := Not_A_Node;
      Encl_Elem : constant Asis.Element       := Enclosing_Element (El);
      Encl_Kind : constant Flat_Element_Kinds := Flat_Element_Kind (Encl_Elem);
   begin

      --  A partial implementation only!

      case Flat_Element_Kind (El) is
         when Not_An_Element =>
            null;

         when A_Procedure_Declaration =>

            if Encl_Kind = A_Protected_Definition then
               Result := A_Protected_Procedure_Body;
            else
               Result := A_Procedure;
            end if;

         when A_Procedure_Body_Declaration |
              A_Procedure_Body_Stub        =>
            Result := A_Procedure;

         when A_Function_Declaration =>

            if Encl_Kind = A_Protected_Definition then
               Result := A_Protected_Function_Body;
            else
               Result := A_Function;
            end if;

         when A_Function_Body_Declaration |
              A_Function_Body_Stub        =>
            Result := A_Function;

         when A_Package_Declaration      |
              A_Package_Body_Declaration =>

            if Is_Nil (Encl_Elem) then
               Result := A_Library_Package;
            elsif Declaration_Kind (Encl_Elem) =
                  A_Package_Instantiation
                and then
                  Is_Nil (Enclosing_Element (Encl_Elem))
            then
               Result := An_Extended_Library_Package_Instantiation;
            else
               pragma Assert (False);
               null;
            end if;

         when A_Package_Instantiation =>

            if Is_Nil (Encl_Elem) then
               Result := A_library_Package_Instantiation;
            else
               pragma Assert (False);
               null;
            end if;

         when A_Single_Task_Declaration =>
            Result := A_Task_Object;
         when An_Entry_Declaration =>
            Result := A_Protected_Entry_Body;

         when A_Procedure_Renaming_Declaration |
              A_Function_Renaming_Declaration  =>

               if Flat_Element_Kind (El) = A_Function_Renaming_Declaration then
                  Result := A_Function;
               else
                  Result := A_Procedure;
               end if;

         when A_Protected_Definition =>
            Result := A_Protected_Definition;

         when A_Task_Definition =>
            Result := A_Task_Definition;

         when A_Task_Type_Declaration =>

            pragma Assert (Is_Nil (Type_Declaration_View (El)));

            Result := A_Task_Definition;
         when others =>
            Ada.Wide_Text_IO.Put_Line (Debug_Image (El));

            if Is_Text_Available (El) then
               Ada.Wide_Text_IO.Put_Line (Element_Image (El));
            end if;

            pragma Assert (False);
            null;
      end case;

      return Result;
   end Define_GS_Node_Kind;

   ------------------------
   -- Define_Side_Effect --
   ------------------------

   procedure Define_Side_Effect
     (Element              : Asis.Element;
      New_SE_Status        : out Side_Effect_Statuses;
      Is_Unresolved_Call   : out Boolean;
      Change_Data_At_Level : out Scope_Levels)
   is
      Arg_Kind : constant Flat_Element_Kinds := Flat_Element_Kind (Element);

      Changed_El           : Asis.Element := Nil_Element;
      Enclosing_Scope_El   : Asis.Element;
      Enclosing_Scope_Node : GS_Node_Id;

      Called_Entity_El   : Asis.Element;
      Called_Entity_Node : GS_Node_Id;
   begin

      New_SE_Status        := No_Side_Effect;
      Is_Unresolved_Call   := False;
      Change_Data_At_Level := Unknown_Scope_Level;

      case Arg_Kind is
         when An_Assignment_Statement =>
            Changed_El := Changed_Element (Assignment_Variable_Name (Element));
         when A_Procedure_Call_Statement |
              A_Function_Call            =>
            --  What about entry calls???

            if Arg_Kind = A_Function_Call then
               Called_Entity_El := Corresponding_Called_Function (Element);
            else
               Called_Entity_El := Corresponding_Called_Entity (Element);
            end if;

            if Is_Nil (Called_Entity_El) then

               if Is_Call_To_Predefined_Operation (Element)
                 or else
                  Is_Call_To_Attribute_Subprogram (Element)
               then
                  --  No side effect!
                  return;
               end if;

               --  Dynamic call, so
               Is_Unresolved_Call := True;
            else

               if Declaration_Kind (Called_Entity_El) =
                  An_Enumeration_Literal_Specification
               then
                  --  No side effect!
                  return;
               end if;

               Called_Entity_El := Corresponding_Element (Called_Entity_El);

               if Is_Predefined_Operation_Renaming (Called_Entity_El) then
                  --  No side effect!
                  return;
               end if;

               Called_Entity_Node := Corresponding_Node (Called_Entity_El);

               if Side_Effect_Defined (Called_Entity_Node) then
                  --  If for the currrent entity side effect is not defined,
                  --  we can not make any conclusion...

                  New_SE_Status := Side_Effect_Status (Called_Entity_Node);

                  if New_SE_Status = Local_Side_Effect then
                     Change_Data_At_Level :=
                       Local_Side_Effect_Level (Called_Entity_Node);
                  end if;

               end if;

            end if;

            --  We should jump out of this routine here not to get to the
            --  assignment-specific processing
            return;

         when others =>
            pragma Assert (False);
            null;
      end case;

      if Is_Nil (Changed_El) then
         --  This means that we have a dynamic situation here:
         New_SE_Status := Potentially_Global_Side_Effect;
      else

         --  Changing subprogram or entry parameter can not cause a side
         --  effect

         if Defining_Name_Kind (Changed_El) = A_Defining_Identifier
           and then
            Declaration_Kind (Enclosing_Element (Changed_El)) =
              A_Parameter_Specification
         then
            New_SE_Status := No_Side_Effect;
         else

            Enclosing_Scope_El   := Enclosing_Scope (Changed_El);
            Enclosing_Scope_Node := Find_Node (Enclosing_Scope_El);

            if No (Enclosing_Scope_Node)
               --  This means that Enclosing_Scope_El is in a global scope that
               --  has not been processed yet
              or else
               Is_Global_Scope (Enclosing_Scope_Node)
            then
               New_SE_Status := Global_Side_Effect;
            elsif Enclosing_Scope_Node = Current_Scope then
               New_SE_Status := No_Side_Effect;
            else
               --  The only possibility is that Changed_El is in some enclosing
               --  global scope
               New_SE_Status        := Local_Side_Effect;
               Change_Data_At_Level := Scope_Level (Enclosing_Scope_Node);
               pragma Assert (Change_Data_At_Level /= Unknown_Scope_Level);
            end if;

         end if;

      end if;

   end Define_Side_Effect;

   ----------
   -- Done --
   ----------

   function Done return Boolean is
   begin
      return Iterator_Done;
   end Done;

   ------------------------------------
   -- Enclosing_Protected_Definition --
   ------------------------------------

   function Enclosing_Protected_Definition
     (For_PO : GS_Node_Id)
      return   GS_Node_Id
   is
   begin
      pragma Assert
        (GS_Node_Kind (For_PO) in
          A_Protected_Procedure_Body .. A_Protected_Entry_Body);

      return GS_Nodes.Table (For_PO).Node_Field_1;
   end Enclosing_Protected_Definition;

   ---------------------
   -- Enclosing_Scope --
   ---------------------

   function Enclosing_Scope (N : GS_Node_Id) return Scope_Id is
   begin
      return GS_Nodes.Table (N).Enclosing_Scope;
   end Enclosing_Scope;

   ---------------------
   -- Enclosed_Source --
   ---------------------

   function Enclosed_Source (N : GS_Node_Id) return SF_Id is
   begin
      return GS_Nodes.Table (N).SF;
   end Enclosed_Source;

   ---------------
   -- Find_Node --
   ---------------

   function Find_Node
     (El           : Asis.Element;
      Needed_Kind  : GS_Node_Kinds := Not_A_Node;
      Protected_Op : GS_Node_Id := No_GS_Node)
      return         GS_Node_Id
   is
      Result : GS_Node_Id := Hash_Table (Hash (El));
   begin

      if Is_Nil (El) then
         return No_GS_Node;
      end if;

      while Present (Result) loop

         if Is_Equal (Result, El, Needed_Kind, Protected_Op) then
            exit;
         end if;

         Result := GS_Nodes.Table (Result).Hash_Link;
      end loop;

      return Result;
   end Find_Node;

   --------------------------
   -- First_Enclosed_Scope --
   --------------------------

   function First_Enclosed_Scope (N : GS_Node_Id) return Scope_Id is
   pragma Unreferenced (N);
   begin
      pragma Assert (False);
      --  Placeholder at the moment
      return No_Scope;
   end First_Enclosed_Scope;

   ----------------------
   -- Get_Protected_Op --
   ----------------------

   function Get_Protected_Op (For_Task : GS_Node_Id) return GS_Node_Id is
   begin
      pragma Assert (GS_Node_Kind (For_Task) in
                       A_Protected_Procedure .. A_Protected_Entry);
      return GS_Nodes.Table (For_Task).Node_Field_1;
   end Get_Protected_Op;

   -------------------------
   -- Get_Task_Definition --
   -------------------------

   function Get_Task_Definition (For_Task : GS_Node_Id) return GS_Node_Id is
   begin
      pragma Assert (GS_Node_Kind (For_Task) = A_Task_Object);
      return GS_Nodes.Table (For_Task).Node_Field_1;
   end Get_Task_Definition;

   ------------------
   -- GS_Node_Kind --
   ------------------

   function GS_Node_Kind (N : GS_Node_Id) return GS_Node_Kinds is
   begin
      return GS_Nodes.Table (N).Node_Kind;
   end GS_Node_Kind;

   ---------------------------
   -- GS_Node_Renaming_Kind --
   ---------------------------

   function GS_Node_Renaming_Kind (N : GS_Node_Id) return Renaming_Kinds is
   begin
      return GS_Nodes.Table (N).Renaming_Kind;
   end GS_Node_Renaming_Kind;

   ----------
   -- Hash --
   ----------

   function Hash (El : Asis.Element) return Hash_Index_Type is
   begin
      return Asis.Elements.Hash (El) mod Hash_Num;
   end Hash;

   --------------------------
   -- Has_Dynamic_Priority --
   --------------------------

   function Has_Dynamic_Priority (N : GS_Node_Id) return Boolean is
   begin
      return
         Priority_Defined (N)
       and then
         GS_Nodes.Table (N).Has_Dynamic_Priority;
   end Has_Dynamic_Priority;

   ----------------
   -- Initialize --
   ----------------

   procedure Initialize is
   begin
      Current_Scopes.Init;
      Hash_Table := (others => No_GS_Node);

      --  Locating the node representing the evironment task:
      GS_Nodes.Append (Environment_Task_Node_Rec);
      Environment_Task_Node := GS_Nodes.Last;

      Set_Current_Scope (GS_Nodes.Last);

   end Initialize;

   --------------
   -- Is_Equal --
   --------------

   function Is_Equal
     (GS_Node      : GS_Node_Id;
      El           : Asis.Element;
      Needed_Kind  : GS_Node_Kinds := Not_A_Node;
      Protected_Op : GS_Node_Id := No_GS_Node)
      return         Boolean
   is
      N_Kind  :  constant GS_Node_Kinds := GS_Node_Kind (GS_Node);
      Op_Kind :  GS_Node_Kinds;
      Result  : Boolean := False;
   begin

      if Present (GS_Node) then

         if Needed_Kind = Not_A_Node
           or else
            Needed_Kind = N_Kind
         then

            if Present (Protected_Op) then
               Op_Kind := GS_Node_Kind (Protected_Op);

               if (N_Kind = A_Protected_Procedure
                  and then
                   Op_Kind = A_Protected_Procedure_Body)
                 or else
                  (N_Kind = A_Protected_Function
                  and then
                   Op_Kind = A_Protected_Function_Body)
                 or else
                  (N_Kind = A_Protected_Entry
                  and then
                   Op_Kind = A_Protected_Entry_Body)
               then
                  Result :=
                     Protected_Op = Get_Protected_Op (GS_Node)
                    and then
                     Get_String (GS_Nodes.Table (GS_Node).SLOC) =
                     Build_GNAT_Location (El);
               end if;

            elsif Get_String (GS_Nodes.Table (GS_Node).SLOC) =
                  Build_GNAT_Location (El)
            then
               Result :=
                  not (N_Kind = A_Protected_Definition
                     or else
                       N_Kind = A_Protected_Procedure_Body
                     or else
                       N_Kind = A_Protected_Function_Body
                     or else
                       N_Kind = A_Protected_Entry_Body)
                or else
                  N_Kind = Define_GS_Node_Kind (El);
            end if;

         end if;

      end if;

      return Result;
   end Is_Equal;

   ---------------------
   -- Is_Global_Scope --
   ---------------------

   function Is_Global_Scope (Scope : Scope_Id) return Boolean is
   begin

      if Scope = Environment_Task_Node then
         return True;
      else
         return Is_Scope (Scope)
              and then
                GS_Nodes.Table (Scope).Scope_Level = 0;
      end if;

   end Is_Global_Scope;

   --------------------
   -- Is_Local_Scope --
   --------------------

   function Is_Local_Scope (N : GS_Node_Id) return Boolean is
   begin
      return Is_Scope (N) and then GS_Nodes.Table (N).Scope_Level > 0;
   end Is_Local_Scope;

   -----------------------
   -- Is_Recursive_Node --
   -----------------------

   function Is_Recursive_Node (N : GS_Node_Id) return Boolean is
   begin
      return Matrix (N, N);
   end Is_Recursive_Node;

   -----------------
   -- Is_RTL_Node --
   -----------------

   function Is_RTL_Node (N : GS_Node_Id) return Boolean is
   begin
      return GS_Nodes.Table (N).Is_RTL_Node;
   end Is_RTL_Node;

   --------------
   -- Is_Scope --
   --------------

   function Is_Scope (N : GS_Node_Id) return Boolean is
   begin
      return GS_Nodes.Table (N).Is_Scope;
   end Is_Scope;

   -------------------
   -- Is_Subprogram --
   -------------------

   function Is_Subprogram (N : GS_Node_Id) return Boolean is
   begin
      return GS_Nodes.Table (N).Node_Kind in
                A_Procedure .. A_Function_Instantiation;
   end Is_Subprogram;

   -----------------------------
   -- Local_Side_Effect_Level --
   -----------------------------

   function Local_Side_Effect_Level
     (Of_Scope : Scope_Id)
      return     Scope_Levels
   is
   begin
      return GS_Nodes.Table (Of_Scope).Local_Side_Effect_Level;
   end Local_Side_Effect_Level;

   --------------
   -- Location --
   --------------

   function Location (N : GS_Node_Id) return String_Loc is
   begin
      return GS_Nodes.Table (N).SLOC;
   end Location;

   ---------------
   -- Next_Node --
   ---------------

   function Next_Node return GS_Node_Id is
   begin
      Advance_Iterator;
      return Current_Node;
   end Next_Node;

   ----------------
   -- Next_Scope --
   ----------------

   function Next_Scope (S : Scope_Id) return Scope_Id is
   pragma Unreferenced (S);
   begin
      pragma Assert (False);
      --  Placeholder at the moment
      return No_Scope;
   end Next_Scope;

   --------
   -- No --
   --------

   function No (N : GS_Node_Id) return Boolean is
   begin
      return N not in First_GS_Node .. GS_Nodes.Last;
   end No;

   -------------------
   -- Node_Priority --
   -------------------

   function Node_Priority (N : GS_Node_Id) return Any_Priority is
   begin
      return GS_Nodes.Table (N).Node_Priority;
   end Node_Priority;

   -------------
   -- Present --
   -------------

   function Present (N : GS_Node_Id) return Boolean is
   begin
      return N in First_GS_Node .. GS_Nodes.Last;
   end Present;

   -----------------------
   -- Print_All_Callers --
   -----------------------

   procedure Print_All_Callers (N : Existing_GS_Node_Id) is
      No_Element : Boolean := True;
   begin

      for Next_Caller in First_GS_Node .. GS_Nodes.Last loop
         if Matrix (Next_Caller, N) then
            No_Element := False;
            Info_No_EOL (Next_Caller'Img);
         end if;
      end loop;

      if No_Element then
         Info_No_EOL (" ...nothing...");
      end if;

      Info ("");
   end Print_All_Callers;

   ---------------------
   -- Print_All_Calls --
   ---------------------

   procedure Print_All_Calls (N : Existing_GS_Node_Id) is
      No_Element : Boolean := True;
   begin

      for Next_Call in First_GS_Node .. GS_Nodes.Last loop

         if Matrix (N, Next_Call) then
            No_Element := False;
            Info_No_EOL (Next_Call'Img);
         end if;
      end loop;

      if No_Element then
         Info_No_EOL (" ...nothing...");
      end if;

      Info ("");
   end Print_All_Calls;

   ----------------------------
   -- Print_Global_Structure --
   ----------------------------

   procedure Print_Global_Structure is
   begin
      Info ("*** NODES TABLE ***");

      for J in First_GS_Node .. GS_Nodes.Last loop
         Print_Node (J);
      end loop;

   end Print_Global_Structure;

   ----------------
   -- Print_Node --
   ----------------

   procedure Print_Node
     (N                    : GS_Node_Id;
      Extended_Debug_Image : Boolean := False)
   is
   begin
      Info ("Node_Id =" & N'Img);

      Info_No_EOL (Ident_String);
      Info        ("Node_Kind       = " &  GS_Nodes.Table (N).Node_Kind'Img);

      Info_No_EOL (Ident_String);
      Info        ("SF              =" & GS_Nodes.Table (N).SF'Img);

      Info_No_EOL (Ident_String);
      Info        ("SLOC            = " &
                   Get_String (GS_Nodes.Table (N).SLOC));

      Info_No_EOL (Ident_String);
      Info_No_EOL ("Enclosing_Scope =" & Enclosing_Scope (N)'Img);

      if Enclosing_Scope (N) = No_Scope then
         Info_No_EOL (" (****** INDEFINED!!!)");
      end if;

      Info ("");
      --  ????

      if Is_Scope (N) then
         Info_No_EOL (Ident_String & Ident_String);
         Info        ("Scope level        =" & Scope_Level (N)'Img);

      end if;

      Info_No_EOL (Ident_String);
      Info_No_EOL ("Side Effect Status = " & GS_Nodes.Table (N).SE_Status'Img);

      if not (GS_Nodes.Table (N).SE_Status = No_Side_Effect
            and then
              GS_Nodes.Table (N).Side_Effect_Defined)
      then

         if GS_Nodes.Table (N).SE_Status = Local_Side_Effect then
            Info_No_EOL (" (" & GS_Nodes.Table (N).Local_Side_Effect_Level'Img
                           & ')');
         end if;

         Info ("");

         if GS_Nodes.Table (N).SE_SLOC /= Nil_String_Loc then
            Info_No_EOL (Ident_String & Ident_String);
            Info        ("Side Effec cause location is " &
                         Get_String (GS_Nodes.Table (N).SE_SLOC));
         end if;

         Info_No_EOL (Ident_String & Ident_String);
         Info        ("Side_Effect_Defined = " &
                      GS_Nodes.Table (N).Side_Effect_Defined'Img);

         Info_No_EOL (Ident_String & Ident_String);
         Info        ("Call_To_Unknown_SE = " &
                      GS_Nodes.Table (N).Call_To_Unknown_SE'Img);
      else
         Info ("");
      end if;

      Info_No_EOL (Ident_String);
      Info        ("Body_Analyzed   = " &
                   GS_Nodes.Table (N).Body_Analyzed'Img);

      Info_No_EOL (Ident_String);
      Info        ("Hash_Link       =" & GS_Nodes.Table (N).Hash_Link'Img);

      case GS_Nodes.Table (N).Node_Kind is

         when A_Task_Object =>
            Info_No_EOL (Ident_String);
            Info_No_EOL (Ident_String);
            Info        ("Corresponding task def  =" &
                         Get_Task_Definition (N)'Img);
         when A_Protected_Procedure .. A_Protected_Entry =>
            Info_No_EOL (Ident_String);
            Info_No_EOL (Ident_String);
            Info        ("Executable protected operation =" &
                         Get_Protected_Op (N)'Img);
         when A_Protected_Procedure_Body .. A_Protected_Entry_Body =>
            Info_No_EOL (Ident_String);
            Info_No_EOL (Ident_String);
            Info        ("Enclosing Protected Definition =" &
                         Enclosing_Protected_Definition (N)'Img);
         when others =>
            null;
      end case;

      if GS_Node_Renaming_Kind (N) /= Not_A_Renamimg then
         Info_No_EOL (Ident_String);
         Info        ("Renaming_Kind   = " & GS_Node_Renaming_Kind (N)'Img);

         if GS_Node_Renaming_Kind (N) /= Enum_Literal_Renaming then
            Info_No_EOL (Ident_String);
            Info_No_EOL (Ident_String);
            Info        ("Renamed entity =" & Renamed_Entity (N)'Img);
         end if;
      end if;

      Info_No_EOL (Ident_String);
      Info_No_EOL ("Priority ");

      if Priority_Defined (N) then

         if Has_Dynamic_Priority (N) then
            Info ("dynamic");
         else
            Info ("=" & Node_Priority (N)'Img);
         end if;

      else
         Info ("**INDEFINED**");
      end if;

      Info_No_EOL (Ident_String);
      Info        ("Is_Used         = " & GS_Nodes.Table (N).Is_Used'Img);

      Info_No_EOL (Ident_String & "Direct calls:");
      Print_Node_List (GS_Nodes.Table (N).Calls_Chain);

      Info_No_EOL (Ident_String & "Direct callers:");
      Print_Node_List (GS_Nodes.Table (N).Callers_Chain);

      if Matrix /= null then
         Info_No_EOL (Ident_String & "All calls:");
         Print_All_Calls (N);

         Info_No_EOL (Ident_String & "All callers:");
         Print_All_Callers (N);
      end if;

      Info ("");

      --  Extended debug output

      if Extended_Debug_Image then

         declare
            Set_To_Output : Call_Lists.Set;
            No_Element    : Boolean := True;
         begin

            Info ("*** Extended debug image ***");

            if Is_Recursive_Node (N) then
               Build_Recursive_Chain (N, Set_To_Output);
               Info_No_EOL (Ident_String & "Recursive chain:");
               Print_Node_List (Set_To_Output);
               Info ("");
            end if;

            if not Side_Effect_Defined (N) then
               --  Print out the called nodes with nondefined side effect:
               Info_No_EOL (Ident_String &
                            "Calls with undefinite side effect:");

               for Next_Call in First_GS_Node .. GS_Nodes.Last loop

                  if Matrix (N, Next_Call)
                    and then
                     not Side_Effect_Defined (Next_Call)
                  then
                     No_Element := False;
                     Info_No_EOL (Next_Call'Img);
                  end if;
               end loop;

               if No_Element then
                  Info_No_EOL (" ...nothing...");
               end if;

               Info ("");
            end if;

         end;

         Info ("");
      end if;

   end Print_Node;

   ---------------------
   -- Print_Node_List --
   ---------------------

   procedure Print_Node_List (L : Call_Lists.Set; Ident : Natural := 0) is
      Next_El :  Call_Lists.Cursor := Call_Lists.First (L);
   begin

      for J in 1 .. Ident loop
         Info_No_EOL (Ident_String);
      end loop;

      if Next_El = Call_Lists.No_Element then
         Info_No_EOL (" ...nothing...");
      else

         while Next_El /= Call_Lists.No_Element loop
            Info_No_EOL (Call_Lists.Element (Next_El)'Img);
            Next_El := Call_Lists.Next (Next_El);
         end loop;

      end if;

      Info ("");

   end Print_Node_List;

   ----------------------
   -- Priority_Defined --
   ----------------------

   function Priority_Defined (N : GS_Node_Id) return Boolean is
   begin
      return GS_Nodes.Table (N).Priority_Defined;
   end Priority_Defined;

   ---------------------
   -- Register_Entity --
   ---------------------

   function Register_Entity
     (El               : Asis.Element;
      Fix_Protected_Op : Boolean := False)
      return             GS_Node_Id
   is
      Corresponding_El : Asis.Element := Corresponding_Element (El);
      Result           : GS_Node_Id   := Find_Node (Corresponding_El);

      Separate_Body : Asis.Element;
      Tmp_SF        : SF_Id;

      Tmp_Node : GS_Node_Id;

   begin
      if No (Result) then

         if Is_Nil (Corresponding_El)
           and then
            Declaration_Kind (El) = A_Task_Body_Declaration
         then
            --  F711-001

            Corresponding_El := Corresponding_Declaration (El);

            Result :=
              Find_Node (Corresponding_El, Needed_Kind => A_Task_Definition);

            if No (Result) then
               Result :=
                 Register_Node
                   (Corresponding_El, Node_Kind => A_Task_Definition);
            end if;

         else
            Result := Register_Node (Corresponding_El);
         end if;

      end if;

      if Is_Body (El)
          or else
            Is_Renaming_As_Body (El)
      then
         Set_Body_Analyzed (Result, True);
      end if;

      if Declaration_Kind (El) in
         A_Procedure_Body_Stub .. A_Protected_Body_Stub
      then

         Separate_Body := Corresponding_Subunit (El);

         if Is_Nil (Separate_Body) then
            Error ("cannot locate the proper body for subunit ???");
         else
            Tmp_SF := File_Find (Separate_Body);

            if not Present (Tmp_SF) then
               Tmp_SF :=
                 Add_Needed_Source
                   (Normalize_Pathname
                      (To_String
                         (Asis.Compilation_Units.Text_Name
                            (Asis.Elements.Enclosing_Compilation_Unit
                               (Separate_Body)))));
               Gnatcheck.Diagnoses.Add_Line_To_Mapping_Table;
            end if;

         end if;
      end if;

      if Fix_Protected_Op
        and then
           (Declaration_Kind (El) in
              A_Procedure_Declaration .. A_Function_Declaration
           or else
            Declaration_Kind (El) = An_Entry_Declaration)
        and then
         GS_Node_Kind (Result) in
            A_Protected_Procedure_Body .. A_Protected_Entry_Body
        and then
         No (Enclosing_Protected_Definition (Result))
      then
         Tmp_Node := Find_Node (Enclosing_Element (El));
         pragma Assert (Present (Tmp_Node));
         Set_Enclosing_Protected_Definition (Result, Tmp_Node);
      end if;

      return Result;
   end Register_Entity;

   procedure Register_Entity
     (El               : Asis.Element;
      Fix_Protected_Op : Boolean := False)
   is
      Tmp : GS_Node_Id := Register_Entity (El, Fix_Protected_Op);
      pragma Warnings (Off, Tmp);
   begin
      null;
   end Register_Entity;

   -------------------
   -- Register_Node --
   -------------------

   function Register_Node
     (El         : Asis.Element;
      Node_Kind  : GS_Node_Kinds := Not_A_Node)
      return       GS_Node_Id
   is
      Hash_Value       : constant Hash_Index_Type := Hash (El);
      Last_In_Chain    : GS_Node_Id               := Hash_Table (Hash_Value);
      Node_Kind_To_Set : GS_Node_Kinds            := Node_Kind;
      Is_Used          : Boolean                  := False;
      Encl_Scope       : Scope_Id                 := No_Scope;
      New_Scope_Lev    : Scope_Levels             := Unknown_Scope_Level;
      Body_Analyzed    : Boolean                  := not Needs_Completion (El);
      New_Node         : GS_Node_Record;
      Node_SF          : SF_Id                    := No_SF_Id;
      Result           : GS_Node_Id;
      Is_RTL_Node      : constant Boolean        :=
         Unit_Origin (Enclosing_Compilation_Unit (El)) /= An_Application_Unit;
   begin

      if Node_Kind_To_Set = Not_A_Node then
         Node_Kind_To_Set := Define_GS_Node_Kind (El);
      end if;

      if Is_Nil (Enclosing_Element (El)) then

         Encl_Scope := Environment_Task_Node;

         if Node_Kind_To_Set in A_Procedure .. A_Function_Instantiation then

            if Can_Be_Main_Program (Enclosing_Compilation_Unit (El)) then
               Is_Used := True;
            end if;

            New_Scope_Lev := Global_Scope_Level + 1;
         else
            New_Scope_Lev := Global_Scope_Level;
         end if;

      end if;

      --  Library-level subprogram instantiations:

      if Node_Kind_To_Set in A_Procedure .. A_Function
        and then
         Is_Part_Of_Instance (El)
        and then
         Is_Nil (Enclosing_Element (Enclosing_Element (El)))
      then
         Encl_Scope    := Environment_Task_Node;
         New_Scope_Lev := Global_Scope_Level + 1;
      end if;

      if Node_Kind_To_Set = A_Protected_Definition then
         --  We can get into creation of the node for a protected definition
         --  only in the regular traversing
         Encl_Scope     := Current_Scope;

         --  We do not care about analyzing bodies for protected definitions -
         --  the check that is made for protected operations is enough
         Body_Analyzed := True;
      end if;

      if Is_Body (El) then
         Body_Analyzed := False;
      end if;

      if not Process_RTL_Units
       and then
         Is_RTL_Node
      then
         Is_Used       := True;
         Encl_Scope    := Environment_Task_Node;
         Body_Analyzed := True;
      else
         Node_SF := File_Find (El);

         if not Present (Node_SF) then
            Node_SF :=
               Add_Needed_Source
                 (Normalize_Pathname
                    (To_String
                       (Asis.Compilation_Units.Text_Name
                          (Asis.Elements.Enclosing_Compilation_Unit (El)))));

            Gnatcheck.Diagnoses.Add_Line_To_Mapping_Table;
         end if;

      end if;

      if No (Encl_Scope) then
         Encl_Scope :=
           Corresponding_Node (Enclosing_Scope (Enclosing_Element (El)));
      end if;

      if New_Scope_Lev = Unknown_Scope_Level then
         New_Scope_Lev := Scope_Level (Encl_Scope) + 1;
      end if;

      New_Node :=
        (Node_Kind                 => Node_Kind_To_Set,
         SF                        => Node_SF,
         SLOC                      => Build_GNAT_Location (El),
         Enclosing_Scope           => Encl_Scope,                    --  ????
         Is_Scope                  => Is_Scope (El),
         Scope_Level               => New_Scope_Lev,
         Local_Side_Effect_Level   => Unknown_Scope_Level,
         SE_Status                 => Unknown,
         SE_SLOC                   => Nil_String_Loc,
         Side_Effect_Defined       => False,
         Call_To_Unknown_SE        => False,
         Node_Priority             => Default_Priority,
         Has_Dynamic_Priority      => False,
         Priority_Defined          => False,
         Body_Analyzed             => Body_Analyzed,
         Calls_Chain               => Call_Lists.Empty_Set,
         Callers_Chain             => Call_Lists.Empty_Set,
         Hash_Link                 => No_GS_Node,
         Node_Field_1              => No_GS_Node,
         Contains_Dispatching_Call => False,
         Contains_Dynamic_Call     => False,
         Renaming_Kind             => Not_A_Renamimg,
         Is_Dynamic                => False,
         Is_Used                   => Is_Used,
         Is_RTL_Node               => Is_RTL_Node);

--      pragma Assert (False
--        or else Flat_Element_Kind (El) = A_Procedure_Declaration
--        or else Flat_Element_Kind (El) = A_Function_Declaration
--        or else ((Flat_Element_Kind (El) = A_Procedure_Body_Declaration
--                or else
--                 Flat_Element_Kind (El) = A_Function_Body_Declaration)
--             and then
--                 Acts_As_Spec (El)));

      pragma Assert
         (Present (New_Node.SF)
         or else
          (not Process_RTL_Units and then Is_RTL_Node));

      if (Declaration_Kind (El) in
            A_Procedure_Declaration .. A_Function_Declaration
         and then
          not Needs_Completion (El))
         --  This means that El is a subprogram that do not have the body in
         --  Ada
        or else
         Node_Kind_To_Set = A_Library_Package
      then
         New_Node.SE_Status           := No_Side_Effect;
         New_Node.Side_Effect_Defined := True;
      end if;

      if not Process_RTL_Units
       and then
         Is_RTL_Node
      then
         --  We have to continue to set stubs for non-analysable RTL node
         --  fields
         New_Node.SE_Status           := No_Side_Effect;
         New_Node.Side_Effect_Defined := True;
--         New_Node.Priority_Defined    := True;        ???
         New_Node.Priority_Defined    := True;
      end if;

      GS_Nodes.Append (New_Node);
      Result := GS_Nodes.Last;

      if No (Last_In_Chain) then
         Hash_Table (Hash_Value) := Result;
      else
         while Present (GS_Nodes.Table (Last_In_Chain).Hash_Link) loop
            Last_In_Chain := GS_Nodes.Table (Last_In_Chain).Hash_Link;
         end loop;

         GS_Nodes.Set_Hash_Link (N => Last_In_Chain, Val => Result);
      end if;

      if not (not Process_RTL_Units
           and then
             Is_RTL_Node)
      then
         Store_Needed_Source (El);
      end if;

      if Is_Renaming (El) then
         Set_Renaming_Node (Result, El);
      end if;

      return Result;
   end Register_Node;

   --------------------------
   -- Remove_Current_Scope --
   --------------------------

   procedure Remove_Current_Scope is
   begin

      if Current_Scopes.Last >= Current_Scopes.First then
         Current_Scopes.Decrement_Last;
      else
         raise Scope_Stack_Error;
      end if;

   end Remove_Current_Scope;

   --------------------
   -- Renamed_Entity --
   --------------------

   function Renamed_Entity (N : GS_Node_Id) return GS_Node_Id is
   begin
      --  ??? pragma Assert (???);
      return GS_Nodes.Table (N).Node_Field_1;
   end Renamed_Entity;

   ---------------------
   -- Reset_Itrerator --
   ---------------------

   procedure Reset_Itrerator
     (For_Node : Existing_GS_Node_Id;
      Call_Set : Call_Set_Kinds)
   is
   begin
      Iterator_Done := False;
      Iterator_Node := For_Node;
      Iterating_Set := Call_Set;
      Current_Node  := First_GS_Node - 1;
   end Reset_Itrerator;

   -----------------
   -- Scope_Level --
   -----------------

   function Scope_Level (Scope : Scope_Id) return Scope_Levels is
   begin
      return GS_Nodes.Table (Scope).Scope_Level;
   end Scope_Level;

   -----------------------
   -- Set_Body_Analyzed --
   -----------------------

   procedure Set_Body_Analyzed (N : GS_Node_Id; Val : Boolean) renames
     GS_Nodes.Set_Body_Analyzed;

   -----------------------
   -- Set_Current_Scope --
   -----------------------

   procedure Set_Current_Scope (Scope : Asis.Element) is
   begin
      Set_Current_Scope (Corresponding_Node (Corresponding_Element (Scope)));
   end Set_Current_Scope;

   procedure Set_Current_Scope (Scope : GS_Node_Id) is
   begin
      --  ??? Links between scopes ???

      if Scope /= Environment_Task_Node then
         Set_Enclosing_Scope (Scope);
      end if;

      Current_Scopes.Append (Scope);

      if Side_Effect_Status (Scope) = Unknown then
         Set_Side_Effect_Status (Scope, No_Side_Effect);
      end if;

   end Set_Current_Scope;

   ----------------------------
   -- Set_Call_To_Unknown_SE --
   ----------------------------

   procedure Set_Call_To_Unknown_SE
     (Scope : Scope_Id;
      Val   : Boolean := True)
   renames GS_Nodes.Set_Call_To_Unknown_SE;

   -----------------------------------
   -- Set_Contains_Dispatching_Call --
   -----------------------------------

   procedure Set_Contains_Dispatching_Call (N : GS_Node_Id) renames
     GS_Nodes.Set_Contains_Dispatching_Call;

   -------------------------------
   -- Set_Contains_Dynamic_Call --
   -------------------------------

   procedure Set_Contains_Dynamic_Call (N : GS_Node_Id) renames
      GS_Nodes.Set_Contains_Dynamic_Call;

   --------------------------
   -- Set_Dynamic_Priority --
   --------------------------

   procedure Set_Dynamic_Priority (N : GS_Node_Id) renames
     GS_Nodes.Set_Dynamic_Priority;

   ----------------------------------------
   -- Set_Enclosing_Protected_Definition --
   ----------------------------------------

   procedure Set_Enclosing_Protected_Definition
     (For_PO : GS_Node_Id;
      P_Def  : GS_Node_Id)
   renames GS_Nodes.Set_Enclosing_Protected_Definition;

   -------------------------
   -- Set_Enclosing_Scope --
   -------------------------

   procedure Set_Enclosing_Scope
     (N : GS_Node_Id;
      S : Scope_Id := Current_Scope)
   renames GS_Nodes.Set_Enclosing_Scope;

   -------------------------------
   -- Set_GS_Node_Renaming_Kind --
   -------------------------------

   procedure Set_GS_Node_Renaming_Kind
     (N   : GS_Node_Id;
      Val : Renaming_Kinds)
   renames GS_Nodes.Set_GS_Node_Renaming_Kind;

   ------------------
   -- Set_Is_Scope --
   ------------------

   procedure Set_Is_Scope (N : GS_Node_Id) renames GS_Nodes.Set_Is_Scope;

   ---------------------------------
   -- Set_Local_Side_Effect_Level --
   ---------------------------------

   procedure Set_Local_Side_Effect_Level
     (Of_Scope : Scope_Id;
      To_Level : Scope_Levels)
   renames GS_Nodes.Set_Local_Side_Effect_Level;

   ------------------
   -- Set_Priority --
   ------------------

   procedure Set_Priority (N : GS_Node_Id; Val : Any_Priority) renames
      GS_Nodes.Set_Priority;

   --------------------------
   -- Set_Priority_Defined --
   --------------------------

   procedure Set_Priority_Defined (N : GS_Node_Id) renames
     GS_Nodes.Set_Priority_Defined;

   ----------------------
   -- Set_Protected_Op --
   ----------------------

   procedure Set_Protected_Op (For_Obj : GS_Node_Id; Pr_Op : GS_Node_Id)
     renames GS_Nodes.Set_Protected_Op;

   ------------------------
   -- Set_Renamed_Entity --
   ------------------------

   procedure Set_Renamed_Entity (For_Node : GS_Node_Id; Val : GS_Node_Id)
     renames GS_Nodes.Set_Renamed_Entity;

   -----------------------
   -- Set_Renaming_Node --
   -----------------------

   procedure Set_Renaming_Node
    (Renaming_Node : GS_Node_Id;
     Renaming_El   : Asis.Element)
   is
      Renamed_El    : Asis.Element;
      Renamed_Node  : GS_Node_Id     := No_GS_Node;
      Renaming_Kind : Renaming_Kinds := Not_A_Renamimg;
   begin

      --  Partial implementation only!!!

      if Is_Enum_Literal_Renaming (Renaming_El) then
         Renaming_Kind := Enum_Literal_Renaming;
         Set_Body_Analyzed (Renaming_Node, True);
      else

         Renamed_El := Declaration_Of_Renamed_Entity (Renaming_El);

         --  Correcting the renamed element, the correction depends on the
         --  current approach to representation this or that entities in the
         --  call graph

         case Declaration_Kind (Renamed_El) is

            when An_Entry_Declaration =>
               if Definition_Kind (Enclosing_Element (Renamed_El)) =
                  A_Task_Definition
               then
                  Renamed_El :=
                    Enclosing_Element (Enclosing_Element (Renamed_El));
               end if;

--            when  =>
                  --  ... to be continued?
            when others =>
               null;
         end case;

         if not Is_Nil (Renamed_El) then
            Renamed_El := Corresponding_Element (Renamed_El);
         end if;

         Renamed_Node := Corresponding_Node (Renamed_El);
         --  What about the case when Declaration_Of_Renamed_Entity returns
         --  Nil_Element?
      end if;

      if Is_Renaming_As_Body (Renaming_El) then
         Set_Body_Analyzed (Renaming_Node, True);
         Renaming_Kind := Renaming_As_Body;
      elsif Used_To_Pass_Actual_Subpr (Renaming_El) then
         Renaming_Kind := Pass_Actual_Subprogram;
      elsif Renaming_Kind = Not_A_Renamimg then
         Set_Body_Analyzed (Renaming_Node, True);
         Renaming_Kind := Renaming_As_Declaration;
      end if;

      Set_Renamed_Entity        (Renaming_Node, Renamed_Node);
      Set_GS_Node_Renaming_Kind (Renaming_Node, Renaming_Kind);

      if Is_Nil (Renamed_El) then
         --  We assume that the renamed entity is OK in every respect,
         --  see FB11-003
         Set_Body_Analyzed       (Renaming_Node, True);
         Set_Side_Effect_Status  (Renaming_Node, No_Side_Effect);
         Set_Side_Effect_Defined (Renaming_Node);
      end if;

   end Set_Renaming_Node;

   ---------------------
   -- Set_Scope_Level --
   ---------------------

   procedure Set_Scope_Level (N : Scope_Id; Val : Scope_Levels) renames
      GS_Nodes.Set_Scope_Level;

   -----------------------------
   -- Set_Side_Effect_Defined --
   -----------------------------

   procedure Set_Side_Effect_Defined
     (Of_Scope : Scope_Id;
      Val      : Boolean := True)
   renames GS_Nodes.Set_Side_Effect_Defined;

   ----------------------------
   -- Set_Side_Effect_Status --
   ----------------------------

   procedure Set_Side_Effect_Status
     (Of_Scope : Scope_Id;
      To       : Side_Effect_Statuses;
      At_SLOC  : String_Loc := Nil_String_Loc)
   renames GS_Nodes.Set_Side_Effect_Status;

   -------------------------
   -- Set_Task_Definition --
   -------------------------

   procedure Set_Task_Definition (T : GS_Node_Id; T_Def : GS_Node_Id) renames
     GS_Nodes.Set_Task_Definition;

   -----------------------
   -- Side_Effect_Cause --
   -----------------------

   function Side_Effect_Cause (N : GS_Node_Id) return Side_Effect_Causes is
   pragma Unreferenced (N);
   begin
      pragma Assert (False);
      --  Placeholder at the moment
      return No_Side_Effec_Cause;
   end Side_Effect_Cause;

   ---------------------------
   -- Side_Effect_Cause_Loc --
   ---------------------------

   function Side_Effect_Cause_Loc (N : GS_Node_Id) return String_Loc is
   pragma Unreferenced (N);
   begin
      pragma Assert (False);
      --  Placeholder at the moment
      return Nil_String_Loc;
   end Side_Effect_Cause_Loc;

   -------------------------
   -- Side_Effect_Defined --
   -------------------------

   function Side_Effect_Defined (Of_Scope : Scope_Id) return Boolean is
   begin
      return GS_Nodes.Table (Of_Scope).Side_Effect_Defined;
   end Side_Effect_Defined;

   ------------------------
   -- Side_Effect_Status --
   ------------------------

   function Side_Effect_Status
     (Scope : Scope_Id)
      return  Side_Effect_Statuses
   is
   begin
      return GS_Nodes.Table (Scope).SE_Status;
   end Side_Effect_Status;

   ---------------
   -- Store_Arc --
   ---------------

   procedure Store_Arc (Called_Node : GS_Node_Id) is
      Stored   : Boolean;
   begin

      --  First, store the Current_Scope --calls--> Called_Node arc:

      GS_Nodes.Add_Node_To_List
        (To_Node     => Current_Scope,
         Node_To_Add => Called_Node,
         Set_To_Add  => Calls,
         Inserted    => Stored);

      --  Now, store the Called_Node --is called by--> Current_Scope arc:

      if Stored then

         GS_Nodes.Add_Node_To_List
           (To_Node     => Called_Node,
            Node_To_Add => Current_Scope,
            Set_To_Add  => Callers,
            Inserted    => Stored);

      end if;

   end Store_Arc;

   procedure Store_Arc (Called_Entity : Asis.Element) is
      Called_Node : constant GS_Node_Id := Corresponding_Node (Called_Entity);
   begin
      pragma Assert (Present (Called_Node));
      Store_Arc (Called_Node);
   end Store_Arc;

   -------------------------
   -- Store_Needed_Source --
   -------------------------

   procedure Store_Needed_Source (El : Asis.Element) is
      Completion_El : Asis.Element;
      SF            : SF_Id;
   begin
      --  If we have N already stored in the Call Graph node table, it means
      --  that for N itself we have already stored the source file - either as
      --  an argument file or as a needed file. It is not enough if El (for
      --  that N has been created and stored in the Call Graph) is a
      --  declaration requiring completion

      if Needs_Completion (El)
        and then
         Unit_Kind (Enclosing_Compilation_Unit (El)) not in
           A_Procedure_Instance .. A_Package_Instance
      then

         Completion_El := Corresponding_Body (El); --  ???

         if Is_Nil (Completion_El) then
            --  Try to compute the name of the corresponding body file

            declare
               Body_Name : constant String := Get_Body_Name (El);
            begin

               if Is_Regular_File (Body_Name) then
                  SF := File_Find (Body_Name);

                  if not Present (SF) then
                     SF := Add_Needed_Source (Body_Name);
                     Gnatcheck.Diagnoses.Add_Line_To_Mapping_Table;
                  end if;
               else
                  Error
                    ("Can not locate the body for " &
                     Short_Source_Name (File_Find (El)));
               end if;

            end;

         else
            SF := File_Find (Completion_El);

            if not Present (SF) then
               SF := Add_Needed_Source
                 (To_String (Asis.Compilation_Units.Text_Name
                               (Asis.Elements.Enclosing_Compilation_Unit
                                  (Completion_El))));

               Gnatcheck.Diagnoses.Add_Line_To_Mapping_Table;
            end if;

         end if;

      end if;

   end Store_Needed_Source;

   -----------------------------
   -- Store_Task_Creation_Arc --
   -----------------------------

   procedure Store_Task_Creation_Arc (El : Asis.Element) is
      Arg_Kind  : constant Flat_Element_Kinds := Flat_Element_Kind (El);
      Task_Node :          GS_Node_Id;
   begin

      case Arg_Kind is
         when A_Single_Task_Declaration =>
            Task_Node := Corresponding_Task_Node (El, Single_Task => True);
            Store_Arc (Task_Node);
         when A_Variable_Declaration |
              A_Constant_Declaration =>

            declare
               Tasks            : constant Element_List := Names (El);
               Task_Def         :          Asis.Element;
               Task_Def_Node    :          GS_Node_Id;
               Task_Def_Defined :          Boolean      := False;
            begin

               for J in Tasks'Range loop
                  Task_Node := Find_Node (Tasks (J));

                  if No (Task_Node) then

                     if not Task_Def_Defined then
                        Task_Def         := Get_Root_Type (El);

                        if not Is_Nil (Type_Declaration_View (Task_Def)) then
                           Task_Def := Type_Declaration_View (Task_Def);
                        end if;

                        Task_Def_Node :=
                          Corresponding_Node (Task_Def, A_Task_Definition);

                        Task_Def_Defined := True;
                     end if;

                     Task_Node      :=
                        Corresponding_Task_Node
                          (Tasks (J),
                           Single_Task   => False,
                           Task_Def_Node => Task_Def_Node);

                  end if;

                  Store_Arc (Task_Node);
               end loop;

            end;

         when others =>
            null;
            pragma Assert (False);
      end case;

   end Store_Task_Creation_Arc;

end Gnatcheck.Global_State;
