-------------------------------------------------------------------------------
--                                                                          --
--                          GNATCHECK COMPONENTS                            --
--                                                                          --
--            G N A T S Y N C . G L O B A L _ I N F O . D A T A             --
--                                                                          --
--                                 B o d y                                  --
--                                                                          --
--                    Copyright (C) 2007-2008, AdaCore                      --
--                                                                          --
-- GNATSYNC  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.                                       --
--                                                                          --
-- GNATSYNC is maintained by AdaCore (http://www.adacore.com).              --
--                                                                          --
------------------------------------------------------------------------------

with Ada.Calendar;
with Ada.Containers.Ordered_Sets;
with Ada.Containers.Vectors;
with Ada.Characters.Handling;    use Ada.Characters.Handling;
with Ada.Strings.Fixed;          use Ada.Strings.Fixed;
with Ada.Unchecked_Deallocation;

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.Extensions.Flat_Kinds; use Asis.Extensions.Flat_Kinds;
with Asis.Statements;            use Asis.Statements;

with Atree;                      use Atree;
with Einfo;                      use Einfo;
with Sinfo;                      use Sinfo;
with Table;

with Asis.Set_Get;               use Asis.Set_Get;

with ASIS_UL.Common;             use ASIS_UL.Common;
with ASIS_UL.Misc;               use ASIS_UL.Misc;
with ASIS_UL.Options;            use ASIS_UL.Options;
with ASIS_UL.Output;             use ASIS_UL.Output;
with ASIS_UL.Utilities;

with Gnatsync.ASIS_Utilities;    use Gnatsync.ASIS_Utilities;
with Gnatsync.Options;           use Gnatsync.Options;

package body Gnatsync.Global_Info.Data is

   ----------------------------------------------------------------
   -- Global structure internal representation data and routines --
   ----------------------------------------------------------------

   function "<" (Left, Right : Link) return Boolean;
   function "=" (Left, Right : Link) return Boolean;
   --  These functions compare only node Ids and ignore SLOCs.

   package SLOC_Node_Lists is new Ada.Containers.Ordered_Sets
     (Element_Type => Link);
   --  Represents ordered sets of called/referenced nodes with SLOCs of the
   --  place where call/reference takes place.

   package No_SLOC_Node_Lists is new Ada.Containers.Ordered_Sets
     (Element_Type => GS_Node_Id);
   --  Represents ordered sets of called/referenced nodes without SLOCs of the
   --  place where call/reference takes place.

   --  We need links to nodes with SLOCs in case if we have to generated
   --  useful call (back)traces (that say not onlu who is called, but also
   --  when it is called). But it is too expansive to use the link lists with
   --  SLOCs for big lists, such as list of alll the calls (moreover, for an
   --  indirect call SLOC does not make very much sence to have SLOC for
   --  indirect calls or references)

   procedure Add_SLOC_Node_List_To_Node_List
     (Target : in out No_SLOC_Node_Lists.Set;
      Source :        SLOC_Node_Lists.Set);
   --  This procedure is similar to the Union set container operation, the
   --  only difference is that Source is a link list with SLOCs, but the
   --  target does not have SLOCs

   -----------------
   -- Scope stack --
   -----------------

   type Critical_Section_Id is new Natural;
   --  This ID type is needed to store the information about critical sections
   --  for the scopes.

   package Section_Start_Table is new Standard.Table.Table
     (Table_Component_Type => Thread_Info_Id,
      Table_Index_Type     => Critical_Section_Id,
      Table_Low_Bound      => 1,
      Table_Initial        => 50,
      Table_Increment      => 100,
      Table_Name           => "critical sections starts table");

   function Get_First_Critical_Section return Critical_Section_Id;
   --  Returns the first ID of the critical section start for the given scope.
   --  Should bw called only for specifying the corresponding property of the
   --  new scope to be placed in the scope stack!

   procedure Remove_Current_Scope_Critical_Sections;
   --  Remove fron the data structures describing the critical sections all the
   --  information corresponding to the current scope.

   function Current_Scope_Sections_Start return Critical_Section_Id;
   --  Returns the ID representing the first (possible) entry describing the
   --  start of the critical section for the given scope.

   subtype Scope_Ind_Type is Natural;

   type Scope_Record is record
      Scope : Scope_Id;
      --  Used to keep stack of enclosed scopes

      Scope_Tree_Node : Node_Id;
      --  reference to the tree node of the corresponding node. (This node is
      --  returned by Einfo.Scope function for the entities defined in this
      --  scope)

      First_Critical_Section : Critical_Section_Id;
      --  Marks the first possible ID of the record about the critical section
      --  start.

   end record;

   package Scope_Stack is new Table.Table
     (Table_Component_Type => Scope_Record,
      Table_Index_Type     => Scope_Ind_Type,
      Table_Low_Bound      => 1,
      Table_Initial        => 50,
      Table_Increment      => 100,
      Table_Name           => "scope stack table");

   type GS_Node_Record is record

      -------------------
      -- Common fields --
      -------------------

      --  Fields that exist for all entities. Should we use a discriminanted
      --  record here???

      Node_Kind : GS_Node_Kinds;

      SLOC : String_Loc;
      --  The full string location of the node (in case of generic
      --  instantiations includes the full istantiation chain)

      Name_Img : String_Loc;
      --  (Short) Ada name of the entity

      Enclosing_Scope : Scope_Id;

      Scope_Level : Natural;
      --  For a scope node, represents the nesting level of the scopes.
      --  Is needed for analyzing if a data object is global for a scope, The
      --  scope level of an environment task is 1. If the node is not a scope,
      --  or if it corresponds to a subprogram for that the body has not been
      --  analyzed yet, the scope level is 0.

      Hash_Link : GS_Node_Id;
      --  Link to the next entry in the node table for the same hash code.

      Direct_Read_References  : SLOC_Node_Lists.Set;
      Direct_Write_References : SLOC_Node_Lists.Set;
      --  For a callable node - references to global objects directly accessed
      --  by the callable entity. For a data node - list of all the callable
      --  entities that directly access the data entity

      Indirect_Read_References  : No_SLOC_Node_Lists.Set;
      Indirect_Write_References : No_SLOC_Node_Lists.Set;
      --  For a callable node - references to all the global objects indirectly
      --  accessed by the callbe entity (as a result of side-effect subprogram
      --  calls). FOr a data node - list of all the callable entities
      --  indirectly accessing this node.

      ----------------------------------
      -- Fields for callable entities --
      ----------------------------------

      Calls_Chain : SLOC_Node_Lists.Set;
      --  A set of calls issued by the given node (that is - a set of nodes
      --  that are DIRECTLY called by the given node)

      All_Calls_Chain : No_SLOC_Node_Lists.Set;
      --  A set off all the nodes called by the given node, directly or
      --  indirectly

      Body_Analyzed : Boolean;
      --  Indicates if the body of the callable entity has been analyzed

      Is_Renaming : Boolean;
      --  Sets ON if the entity is a subprogram that has a body declared by
      --  renaming-as-body

      Renamed_Subprogram : GS_Node_Id;
      --  If Is_Renaming  is ON, is supposed to point to the renamed subprogram
      --  entity.
      --  ??? We can not properly process renamings of task entries.
      --  ??? Do we need this field? We can store the corresponding reference
      --  as the (only) called subprogram

      Is_Of_No_Interest : Boolean;
      --  If Is_Renaming  is ON, sets ON in case if this is a renaming of an
      --  enumeration literal (so it cannot call anything), or a renaming of
      --  a protected operation (so it is considered safe), or a renaming of
      --  a subprogram pointed by an access value (so we cannot do anything
      --  with it).

      Is_Foreign_Thread : Boolean;
      --  Sets for procedures only. If this flag is ON, this means that the
      --  corresponding procedure should be considered as a foreign thread.

   end record;

   type List_Types is
     (Calls,
      All_Calls,
      Direct_Read_References,
      Direct_Write_References,
      Indirect_Read_References,
      Indirect_Write_References);

   type GS_Node_Record_Access is access GS_Node_Record;

   Environment_Task_Node_Rec : GS_Node_Record;

   package GS_Nodes_Container is new Ada.Containers.Vectors
      (Index_Type   => Existing_GS_Node_Id,
       Element_Type => GS_Node_Record);
   --  We can not use a hashed container. We need a hash function that works on
   --  ASIS Elements, but we cannot save ASIS Elements in the Container,
   --  because an Element becomes obsolete as soon as its enclosing Context
   --  gets closed.

   GS_Nodes_Table : GS_Nodes_Container.Vector;
   --  This is the set of nodes representing the global state of the analyzed
   --  sources.

   ------------------------------------------
   -- Internal global structure operations --
   ------------------------------------------

   ---------------------
   -- Access routines --
   ---------------------

   function Table (N : GS_Node_Id) return GS_Node_Record_Access;
   --  Returns the pointer to the element from GS_Nodes_Table

   function GS_Node_Calls (N : GS_Node_Id) return SLOC_Node_Lists.Set;
   pragma Unreferenced (GS_Node_Calls);
   --  Returns the set of nodes called by the argument node

   function GS_Node_Hash_Link (N : GS_Node_Id) return GS_Node_Id;
   --  Returns the hash link of the node. Returns No_GS_Node in case if No (N).

   function GS_Is_Renaming (N : GS_Node_Id) return Boolean;
   --  Tells if the node is a renaming of another node

   function GS_Node_Scope_Level (N : GS_Node_Id) return Natural;
   --  Returns the scope level of the scope node. Returns 0 if the node is
   --  not a scope node or if the scope level is not known yet.

   function Nas_Indirect_References (N : GS_Node_Id) return  Boolean;
   pragma Unreferenced (Nas_Indirect_References);
   --  Checks if N (it is supposed to be a task node) has indirect object
   --  references

   function Has_Indirect_Reads (N : GS_Node_Id) return  Boolean;
   --  Checks if N (it is supposed to be a task node) has indirect read object
   --  references

   function Has_Indirect_Writes (N : GS_Node_Id) return  Boolean;
   --  Checks if N (it is supposed to be a task node) has indirect write object
   --  references

   ---------------------
   -- Update routines --
   ---------------------

   procedure Set_Hash_Link   (N : GS_Node_Id; Val : GS_Node_Id);
   procedure Set_Scope_Level (N : GS_Node_Id; Val : Positive);

   procedure Add_Node_To_List
     (To_Node     : GS_Node_Id;
      To_List     : List_Types;
      Link_To_Add : Link);
   --  Adds to the list pointed by To_List parameter of To_Node either the
   --  whole link pointed by Link_To_Add or only the node from it, this
   --  depends on the kind of the target list. If a link with the node from the
   --  argument link (or a node from the link) is already in the target list,
   --  does nothing.

   -------------------------
   -- Processing routines --
   -------------------------

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

   function Find_Node (El : Asis.Element) return GS_Node_Id;
   --  Looks for the node corresponding to the given Element in the call graph.
   --  Returns No_GS_Node if there is no such node. Note, that this function
   --  assumes that Corresponding_Element has been applied to its argument
   --  before the call.

   function Is_Equal (N : GS_Node_Id; El : Asis.Element) return Boolean;
   --  Checks if the Element represented by N is equal to El. Returns False if
   --  No (N).

   function Register_Node
     (El          : Asis.Element;
      Encl_Scope  : Scope_Id := No_Scope)
      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 this
   --  Element has Corresponding_Element has been applied to its argument
   --  Element before the call. If set to non-empty value, Enclosing_Scope
   --  parameter is used to specify the enclosing scope of the node to be
   --  created.
   --  This function can never return No_GS_Node.

   procedure Check_Call_Graph_Completeness;
   --  Checks if the call information stored in the global data structure is
   --  complete and allows to construct the full Call Graph. Generates a
   --  diagnostic message each time when any incompleteness is detected.

   procedure Traverse_Renamings;
   --  This procedure goes trough all the Call Graph nodes and sets or updates
   --  (direct) call chains for subprogram entities that haverenaming-as-body
   --  as completion.
   --  ???

   function Is_Global_For
     (Scope : Scope_Id;
      Node  : GS_Node_Id)
      return  Boolean;
   --  Checks if Node is global for Scope (the actual for Scope is supposed
   --  to be a scope node). If Node corresponds to library-level data object,
   --  this function returns True.

   -----------------------------------------------------------------------
   --  Computing the call traces: data structures and local subprograms --
   -----------------------------------------------------------------------

   type Call_Chain_Element is record
      Called_Entity  : GS_Node_Id;
      Calling_Entity : Natural;
   end record;
   --  Represents the one link in one call chain - says who is called and who
   --  calls it. For the called entity we store the corresponding node, and for
   --  the calling entity - the index in the (previous) row of Trace_Matrix
   --  where the caller is stored.

   Nil_Call_Chain_Element : constant Call_Chain_Element :=
     (No_GS_Node, 0);

   type Trace_Matrix_Array is array
     (Positive range <>, Positive range <>) of Call_Chain_Element;

   type Access_Trace_Matrix_Array is access Trace_Matrix_Array;

   procedure Free_Trace_Matrix is new Ada.Unchecked_Deallocation
     (Object => Trace_Matrix_Array,
      Name   => Access_Trace_Matrix_Array);

   Trace_Matrix : Access_Trace_Matrix_Array;
   --  This matix creates the call traces of interest. A call trace is an
   --  ordered sequence of callable entities in which each entity *directly*
   --  call the next one (and is called by the previous one)
   --
   --  All traces start (as a first called entity in the trace) with some
   --  specific callable entity (task) for that the matrix is created. If a
   --  given task calls (directly or indirectly) N entities, so we do not need
   --  more then N traces, and each trace cannot contain more then N links. So
   --  we need a matrix of the size (1 .. N, 1 .. N). The first row will
   --  contain entities directly called by the task, each next row will contain
   --  entities directly called by the entities stored in the previous row.
   --  Each row will contain less then N entities, when feeding in the matrix
   --  for the given task, each row is feeding in from left to right, the tail
   --  of the row contains Nil_Call_Chain_Element values.
   --
   --  Note, that Trace_Matrix contains not *all* the possible call traces
   --  started from the given node, but it contains (exactly one) trace of
   --  direct calls that is enough to get to a data element for that in is
   --  created
   --
   --  We cannot create Trace_Matrix statically because we do not know how many
   --  nodes are called by the given task
   --
   --  To fill in Trace_Matrix for a given node, we use a straightforward
   --  modification of Dijkstra algorythm.

   Trace_End_Line   : Natural;
   Trace_End_Column : Natural;
   --  Indicates the element in the Matrix that gives us the end of the trace
   --  from a given task to a given Element.

   Non_Processed_Calls  : No_SLOC_Node_Lists.Set;
   --  Contains a list of the entities that are (indirectly) called by the
   --  given task and that have not been included in the trace Matrix yet

   Processed_Calls  : No_SLOC_Node_Lists.Set;
   --  Contains a list of the entities that have been pr0cessed at the last \
   --  step of Trase_Matrix creation, they should be removed from
   --  Non_Processed_Calls

   -------------------------------------------------
   -- Local subprograms for computing call traces --
   -------------------------------------------------

   procedure Print_Backtrace
     (From        : GS_Node_Id;
      To          : GS_Node_Id;
      Access_Kind : Reference_Kinds);
   --  Builds and prints out the backtrace from the task node From to the
   --  routine that directly accesses the data node To.

   -------------------------------------
   -- Hash table for call graph nodes --
   -------------------------------------

   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

   ---------------------------
   -- Debug output routines --
   ---------------------------

   procedure Print_Node (N : GS_Node_Id);
   --  Prints into Stderr the debug image of the node

   procedure Output_Node (N : GS_Node_Id);
   --  Depending on the options set generates the trace of the node processing.
   --  If Verbose_Mode is ON, outputs into Stderr the number of the
   --  nodes left and the name of the entity corresponding to the node being
   --  processed. Otherwise, if Quiet_Mode is OFF, outputs only the number of
   --  nodes left. If Progress_Indicator_Mode is ON, generates the output to be
   --  used for GPS progress indicator.
   --
   --  ASIS_UL.Source_Table.Output_Source is used as a protorype for this
   --  routine

   procedure Print_SLOC_List (Node_List : SLOC_Node_Lists.Set);
   procedure Print_List      (Node_List : No_SLOC_Node_Lists.Set);
   --  Debug routines, print into Stderr the debug image of the argument link
   --  list of nodes (without or with SLOC info).

   procedure Print_List_SLOCS
     (Indentation_Level : Natural := 0;
      Node_List         : No_SLOC_Node_Lists.Set);
      pragma Unreferenced (Print_List_SLOCS);
   --  Prints into Stderr the debug image of the argument list of nodes, the
   --  image contains node SLOCS only (The argument list does not contain
   --  SLOCs, SLOCs are obraied from node records

   Time_Start : Ada.Calendar.Time;
   Exect_Time : Duration;
   --  Used to compute duration of time-concuming processing steps

   use type Ada.Calendar.Time;

   --------------------------------
   -- Report generation routines --
   --------------------------------

   function Should_Be_Reported (Node : GS_Node_Id) return Boolean;
   --  Checks if the given node should be reported as potential unsunhronized
   --  data access. A node is reported if there is one task that writes to it
   --  and there is another task that either writes to it or reads from it.
   --  A task type is considered as being different from itself. The
   --  environment task is considered along with user-defined task.

   procedure Report_SLOC_List (Node_List : SLOC_Node_Lists.Set);
   --  Prints the argument list into the report file using the following
   --  format:
   --
   --     task [type] <name> at <SLOC>
   --
   --  where SLOC is the source location of the data access

   procedure Report_No_SLOC_List
     (Node_List   : No_SLOC_Node_Lists.Set;
      Data_Node   : GS_Node_Id;
      Access_Kind : Reference_Kinds);
   --  Prints the argument list into the report file using the following
   --  format:
   --
   --     task [type] <name> (<SLOC>)
   --
   --  where SLOC is the source location of the beginning of the corresponding
   --  task body. If Output_Level is set to Full, prints out the backtrace for
   --  each indirect call to Data_Node (in this case the routine assumes that
   --  the argument list is a list of indirect read or write accesses to the
   --  argument node

   procedure Full_Direct_Link_List_Image  --  ??? do we need this?
     (Indentation_Level : Natural := 0;
      Node_List         : SLOC_Node_Lists.Set);
      pragma Unreferenced (Full_Direct_Link_List_Image);
   --  Prints into Stderr the image of the argument list of nodes, using the
   --  following format:
   --
   --     at SLOC1 to SLOC2
   --
   --  where SLOC1 is the SLOC of the place where the event (call to or
   --  reference to an entity) takes place, and SLOC2 is the SLOC of the
   --  called/referenced entity

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

   ---------
   -- "<" --
   ---------

   function "<" (Left, Right : Link) return Boolean is
   begin
      return Left.Node < Right.Node;
   end "<";

   ---------
   -- "=" --
   ---------

   function "=" (Left, Right : Link) return Boolean is
   begin
      return Left.Node = Right.Node;
   end "=";

   function GS_Node_Scope_Level (N : GS_Node_Id) return Natural is
   begin
      return Table (N).Scope_Level;
   end GS_Node_Scope_Level;

   -------------------------------------
   -- Add_SLOC_Node_List_To_Node_List --
   -------------------------------------

   procedure Add_SLOC_Node_List_To_Node_List
     (Target : in out No_SLOC_Node_Lists.Set;
      Source :        SLOC_Node_Lists.Set)
   is
      Next_Element : SLOC_Node_Lists.Cursor;
      Tmp_Cursor   : No_SLOC_Node_Lists.Cursor;
      Tmp_Boolean  : Boolean;
      pragma Warnings (Off, Tmp_Cursor);
      pragma Warnings (Off, Tmp_Boolean);
   begin

      if not SLOC_Node_Lists.Is_Empty (Source) then

         Next_Element := SLOC_Node_Lists.First (Source);

         while SLOC_Node_Lists.Has_Element (Next_Element) loop

            No_SLOC_Node_Lists.Insert
             (Container => Target,
              New_Item  => SLOC_Node_Lists.Element (Next_Element).Node,
              Position  => Tmp_Cursor,
              Inserted  => Tmp_Boolean);

            Next_Element := SLOC_Node_Lists.Next (Next_Element);
         end loop;

      end if;

   end Add_SLOC_Node_List_To_Node_List;

   -----------------------------------
   -- Check_Call_Graph_Completeness --
   -----------------------------------

   procedure Check_Call_Graph_Completeness is
   begin

      for Node in First_GS_Node .. Last_Node loop

         if GS_Node_Kind (Node) in Callable_Nodes
           and then
            not GS_Is_Of_No_Interest (Node)
           and then
            not GS_Body_Analyzed (Node)
         then
            ASIS_UL.Output.Warning
              ("body is not analyzed for " & Get_String (GS_Node_SLOC (Node)));
         end if;

      end loop;

   end Check_Call_Graph_Completeness;

   --------------------------------
   -- Check_For_Critical_Section --
   --------------------------------

   procedure Check_For_Critical_Section (Call : Asis.Element) is
      Called_El : Asis.Element := Corresponding_Called_Entity (Call);
      Border_Id : Thread_Info_Id;
   begin

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

      if not Is_Nil (Called_El) then
         Border_Id := Get_Section_Border_Id (Called_El);

         if Present (Border_Id) then

            if Thread_Info_Kind (Border_Id) = Section_Start then
               Section_Start_Table.Append (Border_Id);

            elsif Thread_Info_Kind (Border_Id) = Section_End then
               for J in reverse Section_Start_Table.Last ..
                                Current_Scope_Sections_Start
               loop
                  if Closes_Section
                      (Started_By   => Section_Start_Table.Table (J),
                       Closing_Item => Border_Id)
                  then
                     --  This is not good from preformance viewpoint, but we
                     --  hope that we will never have too many opened critical
                     --  sections

                     for K in J .. Section_Start_Table.Last - 1 loop
                        Section_Start_Table.Table (K) :=
                          Section_Start_Table.Table (K + 1);
                     end loop;

                     Section_Start_Table.Decrement_Last;

                     exit;
                  end if;

               end loop;

            end if;

         end if;
      end if;

   end Check_For_Critical_Section;

   ------------------------------------
   -- Compute_Task_Global_References --
   ------------------------------------

   procedure Compute_Task_Global_References is
      Next_Call : No_SLOC_Node_Lists.Cursor;
      Next_Ref  : SLOC_Node_Lists.Cursor;
      Link_Tmp  : Link;

   begin

      if not Quiet_Mode then
         Info ("compute task global references - start (total: " &
               Last_Node'Img & " nodes)");

         if ASIS_UL.Options.Compute_Timing and then Debug_Mode then
            Time_Start := Ada.Calendar.Clock;
         end if;

      end if;

      for Node in First_GS_Node .. Last_Node loop

         if GS_Node_Kind (Node) in Task_Nodes
           or else
            (Foreign_Threads_Present
            and then
             GS_Is_Foreign_Thread (Node))
         then

            Output_Node (Node);

            --  Traverse the set of all calls:

            Next_Call :=
              No_SLOC_Node_Lists.First (Table (Node).All_Calls_Chain);

            while No_SLOC_Node_Lists.Has_Element (Next_Call) loop

               if not GS_Is_Of_No_Interest
                        (No_SLOC_Node_Lists.Element (Next_Call))
               then

                  --  Read references
                  Next_Ref :=
                    SLOC_Node_Lists.First
                      (Table (No_SLOC_Node_Lists.Element (Next_Call)).
                          Direct_Read_References);

                  while SLOC_Node_Lists.Has_Element (Next_Ref) loop

                     if not SLOC_Node_Lists.Contains
                              (Table (Node).Direct_Read_References,
                               SLOC_Node_Lists.Element (Next_Ref))
                       and then
                        (Is_Global_For
                           (Node  => SLOC_Node_Lists.Element (Next_Ref).Node,
                            Scope => Node)
                         or else
                          GS_Is_Local_Var_Accessed_By_Local_Tasks
                            (SLOC_Node_Lists.Element (Next_Ref).Node))
                     then
                        Link_Tmp := SLOC_Node_Lists.Element (Next_Ref);

                        Add_Node_To_List
                          (To_Node     => Node,
                           To_List     => Indirect_Read_References,
                           Link_To_Add => Link_Tmp);

                        Add_Node_To_List
                          (To_Node     => Link_Tmp.Node,
                           To_List     => Indirect_Read_References,
                           Link_To_Add => (Node => Node,
                                           SLOC => Nil_String_Loc));
                     end if;

                     Next_Ref := SLOC_Node_Lists.Next (Next_Ref);
                  end loop;

                  --  Write references
                  Next_Ref :=
                    SLOC_Node_Lists.First
                      (Table (No_SLOC_Node_Lists.Element (Next_Call)).
                          Direct_Write_References);

                  while SLOC_Node_Lists.Has_Element (Next_Ref) loop

                     if not SLOC_Node_Lists.Contains
                              (Table (Node).Direct_Write_References,
                               SLOC_Node_Lists.Element (Next_Ref))
                       and then
                        (Is_Global_For
                           (Node  => SLOC_Node_Lists.Element (Next_Ref).Node,
                            Scope => Node)
                         or else
                          GS_Is_Local_Var_Accessed_By_Local_Tasks
                            (SLOC_Node_Lists.Element (Next_Ref).Node))
                     then
                        Link_Tmp := SLOC_Node_Lists.Element (Next_Ref);

                        Add_Node_To_List
                          (To_Node     => Node,
                           To_List     => Indirect_Write_References,
                           Link_To_Add => Link_Tmp);

                        Add_Node_To_List
                          (To_Node     => Link_Tmp.Node,
                           To_List     => Indirect_Write_References,
                           Link_To_Add => (Node => Node,
                                           SLOC => Nil_String_Loc));
                     end if;

                     Next_Ref := SLOC_Node_Lists.Next (Next_Ref);
                  end loop;

               end if;

               Next_Call := No_SLOC_Node_Lists.Next (Next_Call);
            end loop;

         end if;

      end loop;

      if not Quiet_Mode then
         Info_No_EOL ("compute task global references - done");

         if ASIS_UL.Options.Compute_Timing and then Debug_Mode then
            Exect_Time := Ada.Calendar.Clock - Time_Start;
            Info (", execution time is" & Exect_Time'Img & " seconds");
         else
            Info ("");
         end if;

      end if;

   end Compute_Task_Global_References;

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

   function Corresponding_Node
     (El              : Element;
      Enclosing_Scope : Scope_Id := No_Scope)
      return            GS_Node_Id
   is
      Corresponding_El : constant Asis.Element := Corresponding_Element (El);
      Result           :          GS_Node_Id   := Find_Node (Corresponding_El);
   begin

      if No (Result) then
         Result := Register_Node (Corresponding_El, Enclosing_Scope);
      end if;

      return Result;
   end Corresponding_Node;

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

   function Current_Scope return Scope_Id is
   begin

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

   end Current_Scope;

   -----------------------------
   -- Current_Scope_Tree_Node --
   -----------------------------

   function Current_Scope_Tree_Node return Node_Id is
   begin

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

   end Current_Scope_Tree_Node;

   ----------------------------------
   -- Current_Scope_Sections_Start --
   ----------------------------------

   function Current_Scope_Sections_Start return Critical_Section_Id is
   begin

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

   end Current_Scope_Sections_Start;

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

   function Define_GS_Node_Kind (El : Asis.Element) return GS_Node_Kinds is
      Result : GS_Node_Kinds := Not_A_Node;
   begin

      case Flat_Element_Kind (El) is
         when A_Procedure_Declaration      |
              A_Function_Declaration       |
              A_Procedure_Body_Declaration |
              A_Function_Body_Declaration  |
              A_Procedure_Body_Stub        |
              A_Function_Body_Stub         |
              A_Procedure_Instantiation    |
              A_Function_Instantiation     =>
            Result := A_Subprogram;
         when A_Task_Body_Declaration =>

            if Declaration_Kind (Corresponding_Declaration (El)) =
               A_Task_Type_Declaration
            then
               Result := A_Task_Type_Body;
            else
               Result := A_Single_Task_Body;
            end if;

         when A_Defining_Identifier =>
            Result := A_Data_Object;
         when others =>
            null;
      end case;

      return Result;
   end Define_GS_Node_Kind;

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

   function Find_Node (El : Asis.Element) 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) then
            exit;
         end if;

         Result :=
           GS_Nodes_Container.Element (GS_Nodes_Table, Result).Hash_Link;
      end loop;

      return Result;
   end Find_Node;

   ---------------------------------
   -- Full_Direct_Link_List_Image --
   ---------------------------------

   procedure Full_Direct_Link_List_Image
     (Indentation_Level : Natural := 0;
      Node_List         : SLOC_Node_Lists.Set)
   is
      Next_El : SLOC_Node_Lists.Cursor := SLOC_Node_Lists.First (Node_List);

      use SLOC_Node_Lists;
   begin
      if Next_El = SLOC_Node_Lists.No_Element then
         Report (Indentation_Level * Ident_String & " ...nothing...");
      else

         while Next_El /= SLOC_Node_Lists.No_Element loop
            Report_No_EOL (Indentation_Level * Ident_String & "at ");
            Report_No_EOL
              (Get_String (SLOC_Node_Lists.Element (Next_El).SLOC));
            Report_No_EOL (" to ");
            Report
              (Get_String
                 (Table (SLOC_Node_Lists.Element (Next_El).Node).SLOC));
            Next_El := SLOC_Node_Lists.Next (Next_El);
         end loop;

      end if;

      Report ("");

   end Full_Direct_Link_List_Image;

   ---------------------
   -- Generate_Report --
   ---------------------

   procedure Generate_Report is
      Ident_String : constant String := "   ";
      use Ada.Containers;
   begin

      if not Quiet_Mode then
         Info ("generate report - start (total: " &
               Last_Node'Img & " nodes)");

         if ASIS_UL.Options.Compute_Timing and then Debug_Mode then
            Time_Start := Ada.Calendar.Clock;
         end if;

      end if;

      for Data_Node in First_GS_Node .. Last_Node loop

         if GS_Node_Kind (Data_Node) = A_Data_Object
           and then
            Should_Be_Reported (Data_Node)
         then

            Output_Node (Data_Node);

            Report (Get_String (GS_Node_SLOC (Data_Node)) &
                    " unprotected access to data object "  &
                    Get_String (GS_Node_Name_Img (Data_Node)));

            if Output_Level > Brief then

               if SLOC_Node_Lists.Length
                    (Table (Data_Node).Direct_Read_References) > 0
               then
                  Report (Ident_String & "is directly read by");
                  Report_SLOC_List (Table (Data_Node).Direct_Read_References);
               end if;

               if No_SLOC_Node_Lists.Length
                    (Table (Data_Node).Indirect_Read_References) > 0
               then
                  Report (Ident_String & "is indirectly read by");
                  Report_No_SLOC_List
                    (Node_List   => Table (Data_Node).Indirect_Read_References,
                     Data_Node   => Data_Node,
                     Access_Kind => Read);
               end if;

               if SLOC_Node_Lists.Length
                    (Table (Data_Node).Direct_Write_References) > 0
               then
                  Report (Ident_String & "is directly written by");
                  Report_SLOC_List (Table (Data_Node).Direct_Write_References);
               end if;

               if No_SLOC_Node_Lists.Length
                    (Table (Data_Node).Indirect_Write_References) > 0
               then
                  Report (Ident_String & "is indirectly written by");
                  Report_No_SLOC_List
                    (Node_List   => Table (Data_Node).
                                      Indirect_Write_References,
                     Data_Node   => Data_Node,
                     Access_Kind => Write);
               end if;

               Report ("");
            end if;

         end if;

      end loop;

      if not Quiet_Mode then
         Info_No_EOL ("generate report - done");

         if ASIS_UL.Options.Compute_Timing and then Debug_Mode then
            Exect_Time := Ada.Calendar.Clock - Time_Start;
            Info (", execution time is" & Exect_Time'Img & " seconds");
         else
            Info ("");
         end if;

      end if;

   end Generate_Report;

   --------------------------------
   -- Get_First_Critical_Section --
   --------------------------------

   function Get_First_Critical_Section return Critical_Section_Id is
   begin
      return Section_Start_Table.Last + 1;
   end Get_First_Critical_Section;

   ----------------------
   -- GS_Body_Analyzed --
   ----------------------

   function GS_Body_Analyzed (N : GS_Node_Id) return Boolean is
   begin
      pragma Assert (GS_Node_Kind (N) in Callable_Nodes);
      return Table (N).Body_Analyzed;
   end GS_Body_Analyzed;

   ------------------------
   -- GS_Enclosing_Scope --
   ------------------------

   function GS_Enclosing_Scope (N : GS_Node_Id) return GS_Node_Id is
   begin

      if No (N) then
         return No_GS_Node;
      else
         return Table (N).Enclosing_Scope;
      end if;

   end GS_Enclosing_Scope;

   --------------------------
   -- GS_Is_Foreign_Thread --
   --------------------------

   function GS_Is_Foreign_Thread (N : GS_Node_Id) return Boolean is
   begin
      return Table (N).Is_Foreign_Thread;
   end GS_Is_Foreign_Thread;

   ---------------------------------------------
   -- GS_Is_Local_Var_Accessed_By_Local_Tasks --
   ---------------------------------------------

   function GS_Is_Local_Var_Accessed_By_Local_Tasks
     (N    : GS_Node_Id)
      return Boolean
   is
   begin
      --  Use the callable node flag...
      pragma Assert (GS_Node_Kind (N) = A_Data_Object);
      return Table (N).Is_Renaming;
   end GS_Is_Local_Var_Accessed_By_Local_Tasks;

   --------------------------
   -- GS_Is_Of_No_Interest --
   --------------------------

   function GS_Is_Of_No_Interest (N : GS_Node_Id) return Boolean is
   begin
      return Table (N).Is_Of_No_Interest;
   end GS_Is_Of_No_Interest;

   --------------------
   -- GS_Is_Renaming --
   --------------------

   function GS_Is_Renaming (N : GS_Node_Id) return Boolean is
   begin
      return GS_Node_Kind (N) = A_Subprogram and then Table (N).Is_Renaming;
   end GS_Is_Renaming;

   -------------------
   -- GS_Node_Calls --
   -------------------

   function GS_Node_Calls (N : GS_Node_Id) return SLOC_Node_Lists.Set is
   begin
      pragma Assert (GS_Node_Kind (N) in Callable_Nodes);

      return Table (N).Calls_Chain;
   end GS_Node_Calls;

   -----------------------
   -- GS_Node_Hash_Link --
   -----------------------

   function GS_Node_Hash_Link (N : GS_Node_Id) return GS_Node_Id is
   begin

      if No (N) then
         return No_GS_Node;
      else
         return Table (N).Hash_Link;
      end if;

   end GS_Node_Hash_Link;

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

   function GS_Node_Kind (N : GS_Node_Id) return GS_Node_Kinds is
   begin

      if No (N) then
         return Not_A_Node;
      else
         return Table (N).Node_Kind;
      end if;

   end GS_Node_Kind;

   ----------------------
   -- GS_Node_Name_Img --
   ----------------------

   function GS_Node_Name_Img (N : GS_Node_Id) return String_Loc is
   begin
      return Table (N).Name_Img;
   end GS_Node_Name_Img;

   ------------------
   -- GS_Node_SLOC --
   ------------------

   function GS_Node_SLOC (N : GS_Node_Id) return String_Loc is
   begin

      if No (N) then
         return Nil_String_Loc;
      else
         return Table (N).SLOC;
      end if;

   end GS_Node_SLOC;

   -------------------------
   -- GS_Node_Scope_Level --
   -------------------------

   ------------------------
   -- Has_Indirect_Reads --
   ------------------------

   function Has_Indirect_Reads (N : GS_Node_Id) return  Boolean is
   begin
      pragma Assert (GS_Node_Kind (N) in Task_Nodes);

      return not No_SLOC_Node_Lists.Is_Empty
        (Table (N).Indirect_Read_References);
   end Has_Indirect_Reads;

   -----------------------------
   -- Nas_Indirect_References --
   -----------------------------

   function Nas_Indirect_References (N : GS_Node_Id) return  Boolean is
   begin
      pragma Assert (GS_Node_Kind (N) in Task_Nodes);
      return Has_Indirect_Reads (N) or else Has_Indirect_Writes (N);
   end Nas_Indirect_References;

   -------------------------
   -- Has_Indirect_Writes --
   -------------------------

   function Has_Indirect_Writes (N : GS_Node_Id) return  Boolean is
   begin
      pragma Assert (GS_Node_Kind (N) in Task_Nodes);
      return not No_SLOC_Node_Lists.Is_Empty
        (Table (N).Indirect_Write_References);
   end Has_Indirect_Writes;

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

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

   -------------------------
   -- In_Critical_Section --
   -------------------------

   function In_Critical_Section return Boolean is
   begin
      return Current_Scope_Sections_Start <= Section_Start_Table.Last;
   end In_Critical_Section;

   ---------------------------------
   -- Init_Critical_Section_Table --
   ---------------------------------

   procedure Init_Critical_Section_Table is
   begin
      Section_Start_Table.Init;
   end Init_Critical_Section_Table;

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

   procedure Initialize is
   begin
      GS_Nodes_Container.Reserve_Capacity
        (Container => GS_Nodes_Table,
         Capacity  => 1_000);

      Scope_Stack.Init;
      Hash_Table := (others => No_GS_Node);

      --  Locating the node representing the evironment task:
      GS_Nodes_Container.Append (Container => GS_Nodes_Table,
                                 New_Item  => Environment_Task_Node_Rec);

      Environment_Task_Node := Last_Node;

      Set_Current_Scope (Environment_Task_Node, Empty);
   end Initialize;

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

   function Is_Equal (N : GS_Node_Id; El : Asis.Element) return Boolean is
      Result  : Boolean := False;
   begin

      pragma Assert (Is_Equal (El, Corresponding_Element (El)));

      if Present (N) then

         if GS_Node_Kind (N) = Define_GS_Node_Kind (El)
           and then
            Get_String (GS_Node_SLOC (N)) = Build_GNAT_Location (El)
         then
            Result := True;
         end if;

      end if;

      return Result;
   end Is_Equal;

   -------------------
   -- Is_Global_For --
   -------------------

   function Is_Global_For
     (Scope : Scope_Id;
      Node  : GS_Node_Id)
      return  Boolean
   is
      Node_Encl_Scope  : constant GS_Node_Id := GS_Enclosing_Scope (Node);
      Node_Scope_Level : constant Positive   :=
        GS_Node_Scope_Level (Node_Encl_Scope);

      Scope_Encl_Scope : GS_Node_Id;
      Result           : Boolean := False;
   begin

      pragma Assert (GS_Node_Scope_Level (Scope) > 0);

      if Node_Encl_Scope = Environment_Task_Node then
         Result := True;
      elsif Node_Scope_Level < GS_Node_Scope_Level (Scope) then
         Scope_Encl_Scope := GS_Enclosing_Scope (Scope);

         while GS_Node_Scope_Level (Scope_Encl_Scope) /= Node_Scope_Level loop
            Scope_Encl_Scope := GS_Enclosing_Scope (Scope_Encl_Scope);
         end loop;

         Result := Scope_Encl_Scope = Node_Encl_Scope;

      end if;

      return Result;
   end Is_Global_For;

   ---------------------------------
   -- Is_Global_For_Current_Scope --
   ---------------------------------

   function Is_Global_For_Current_Scope
     (Def_Name : Asis.Element)
      return     Boolean
   is
      Result          :          Boolean := True;
      Encl_Scope_Node :          Node_Id := Scope (Node (Def_Name));
      Curr_Scope_Node : constant Node_Id := Current_Scope_Tree_Node;
   begin

      --  If Enclosing_Scope is a single task declaration, we may have to
      --  adjust Encl_Scope_Node: for local entities declared in the package
      --  body it will point to the  artificial task type entity:

      if Ekind (Encl_Scope_Node) = E_Task_Type
        and then
         not Comes_From_Source (Encl_Scope_Node)
      then
         Encl_Scope_Node := Corresponding_Body (Parent (Encl_Scope_Node));
      end if;

      while Present (Encl_Scope_Node) loop

         if Encl_Scope_Node = Curr_Scope_Node then
            Result := False;
            exit;
         end if;

         Encl_Scope_Node := Scope (Encl_Scope_Node);
      end loop;

      return Result;
   end Is_Global_For_Current_Scope;

   ---------------
   -- Last_Node --
   ---------------

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

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

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

   --------------------------------------
   -- Node attribute update procedures --
   --------------------------------------
   Bool_Tmp           : Boolean;
   Int_Tmp            : Integer;
   GS_Node_Tmp        : GS_Node_Id;
   Link_Tmp           : Link;
   Call_List_Type_Tmp : List_Types;

   procedure Add_Node_To_List      (For_Node_Rec : in out GS_Node_Record);
   procedure Set_Body_Analyzed     (For_Node_Rec : in out GS_Node_Record);
   procedure Set_Hash_Link         (For_Node_Rec : in out GS_Node_Record);
   procedure Set_Is_Foreign_Thread (For_Node_Rec : in out GS_Node_Record);
   procedure Set_Is_Of_No_Interest (For_Node_Rec : in out GS_Node_Record);
   procedure Set_Is_Renaming       (For_Node_Rec : in out GS_Node_Record);
   procedure Set_Scope_Level       (For_Node_Rec : in out GS_Node_Record);
   --  Procedure for updating the node record.

   procedure Add_Node_To_List (For_Node_Rec : in out GS_Node_Record) is
      Tmp_SLOC_Cursor     : SLOC_Node_Lists.Cursor;
      Tmp_No_SLOC_Cursor  : No_SLOC_Node_Lists.Cursor;
      Tmp_Boolean         : Boolean;
      pragma Warnings (Off, Tmp_SLOC_Cursor);
      pragma Warnings (Off, Tmp_No_SLOC_Cursor);
      pragma Warnings (Off, Tmp_Boolean);
   begin

      case Call_List_Type_Tmp is
         when Calls =>
            SLOC_Node_Lists.Insert
             (Container => For_Node_Rec.Calls_Chain,
              New_Item  => Link_Tmp,
              Position  => Tmp_SLOC_Cursor,
              Inserted  => Tmp_Boolean);
         when All_Calls =>
            No_SLOC_Node_Lists.Insert
             (Container => For_Node_Rec.All_Calls_Chain,
              New_Item  => Link_Tmp.Node,
              Position  => Tmp_No_SLOC_Cursor,
              Inserted  => Tmp_Boolean);
         when Direct_Read_References =>
            SLOC_Node_Lists.Insert
             (Container => For_Node_Rec.Direct_Read_References,
              New_Item  => Link_Tmp,
              Position  => Tmp_SLOC_Cursor,
              Inserted  => Tmp_Boolean);
         when Direct_Write_References =>
            SLOC_Node_Lists.Insert
             (Container => For_Node_Rec.Direct_Write_References,
              New_Item  => Link_Tmp,
              Position  => Tmp_SLOC_Cursor,
              Inserted  => Tmp_Boolean);
         when Indirect_Read_References =>
            No_SLOC_Node_Lists.Insert
             (Container => For_Node_Rec.Indirect_Read_References,
              New_Item  => Link_Tmp.Node,
              Position  => Tmp_No_SLOC_Cursor,
              Inserted  => Tmp_Boolean);
         when Indirect_Write_References =>
            No_SLOC_Node_Lists.Insert
             (Container => For_Node_Rec.Indirect_Write_References,
              New_Item  => Link_Tmp.Node,
              Position  => Tmp_No_SLOC_Cursor,
              Inserted  => Tmp_Boolean);
      end case;

   end Add_Node_To_List;

   procedure Add_Node_To_List
     (To_Node     : GS_Node_Id;
      To_List     : List_Types;
      Link_To_Add : Link)
   is
   begin
      Link_Tmp           := Link_To_Add;
      Call_List_Type_Tmp := To_List;

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

   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 := True) is
   begin

      pragma Assert (GS_Node_Kind (N) in Callable_Nodes);

      Bool_Tmp := Val;

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

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

   procedure Set_Is_Foreign_Thread (For_Node_Rec : in out GS_Node_Record) is
   begin
      For_Node_Rec.Is_Foreign_Thread := Bool_Tmp;
   end Set_Is_Foreign_Thread;

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

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

   procedure Set_Is_Local_Var_Accessed_By_Local_Tasks
     (N   : GS_Node_Id;
      Val : Boolean := True)
   is
   begin
      --  Use the callable node flag...
      pragma Assert (GS_Node_Kind (N) = A_Data_Object);

      Bool_Tmp := Val;

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

   procedure Set_Is_Of_No_Interest (For_Node_Rec : in out GS_Node_Record) is
   begin
      For_Node_Rec.Is_Of_No_Interest := Bool_Tmp;
   end Set_Is_Of_No_Interest;

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

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

   procedure Set_Is_Renaming (For_Node_Rec : in out GS_Node_Record) is
   begin
      For_Node_Rec.Is_Renaming := Bool_Tmp;
   end Set_Is_Renaming;

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

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

   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_Hash_Link (N : GS_Node_Id; Val : GS_Node_Id) is
   begin
      GS_Node_Tmp := Val;

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

   procedure Set_Scope_Level (N : GS_Node_Id; Val : Positive) 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;

   -----------------
   -- Output_Node --
   -----------------

   procedure Output_Node (N : GS_Node_Id) is
      N_Img           : constant String     := N'Img;
      Nodes_Remaining : constant GS_Node_Id := Last_Node - N;
   begin

      if not Quiet_Mode then

         if Progress_Indicator_Mode then
            declare
               Percent : String := GS_Node_Id'Image ((N * 100) / Last_Node);
            begin
               Percent (1) := '(';
               Info ("completed" & N'Img & " out of"
                     & Last_Node'Img & " "
                     & Percent & "%)...");
            end;
         end if;

         if Verbose_Mode or else Debug_Mode then
            Info ("[" & N_Img (2 .. N_Img'Last) & "]  " &
                  Get_String (GS_Node_Name_Img (N))     &
                  " - " & Get_String (GS_Node_SLOC (N)));

         else
            Info_No_EOL ("Nodes remaining:");
            Info_No_EOL (Nodes_Remaining'Img);
            Info_No_EOL ("     ");
            Info_No_EOL ((1 => ASCII.CR));
         end if;

      end if;
   end Output_Node;

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

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

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

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

      for J in First_GS_Node .. Last_Node loop
         Print_Node (J);
      end loop;

      Info ("*** HASH CHAINS ***");

      --  Code is taken from the GNAT Namet.Finalize procedure (with simple
      --  modifications to make it working in gnatsync environment)

      declare
         Max_Chain_Length : constant := 100; --  50 in GNAT
         --  Max length of chains for which specific information is output

         F : array (Integer range 0 .. Max_Chain_Length) of Integer;
         --  N'th entry is number of chains of length N

         Probes : Integer := 0;
         --  Used to compute average number of probes
         Tmp    : Integer;

         Nsyms : Integer := 0;
         --  Number of symbols in table

      begin
         for J in F'Range loop
            F (J) := 0;
         end loop;

         for J in Hash_Index_Type loop
            if Hash_Table (J) = No_GS_Node then
               F (0) := F (0) + 1;

            else
               Info_No_EOL ("Hash_Table (");
               Info_No_EOL (J'Img);
               Info_No_EOL (") has ");

               declare
                  C : Integer := 1;
                  N : GS_Node_Id;

               begin
                  C := 0;
                  N := Hash_Table (J);

                  while N /= No_GS_Node loop
                     N := GS_Node_Hash_Link (N);
                     C := C + 1;
                  end loop;

                  Info_No_EOL (C'Img);
                  Info        (" entries");

                  if C < Max_Chain_Length then
                     F (C) := F (C) + 1;
                  else
                     F (Max_Chain_Length) := F (Max_Chain_Length) + 1;
                  end if;

                  N := Hash_Table (J);

                  while N /= No_GS_Node loop
                     Info_No_EOL ("   ");
                     Info_No_EOL (Get_String (GS_Node_Name_Img (N)));
                     Info_No_EOL (" - ");
                     Info        (Get_String (GS_Node_SLOC (N)));
                     N := GS_Node_Hash_Link (N);
                  end loop;
               end;
            end if;
         end loop;

--         Write_Eol;

         for J in Integer range 0 .. Max_Chain_Length loop
            if F (J) /= 0 then
               Info_No_EOL ("Number of hash chains of length ");

               if J < 10 then
                  Info_No_EOL (" ");
               end if;

               Info_No_EOL (J'Img);

               if J = Max_Chain_Length then
                  Info_No_EOL (" or greater");
               end if;

               Info_No_EOL (" = ");
               Info        (F (J)'Img);

               if J /= 0 then
                  Nsyms := Nsyms + F (J);
                  Probes := Probes + F (J) * (1 + J) * 100;
               end if;
            end if;
         end loop;

         Info ("");
         Info_No_EOL ("Average number of probes for lookup = ");
         Probes := Probes / Nsyms;
         Tmp := Probes / 200;
         Info_No_EOL (Tmp'Img);
         Info_No_EOL (".");
         Probes := (Probes mod 200) / 2;
         Info_No_EOL ((1 => Character'Val (48 + Probes / 10)));
         Info_No_EOL ((1 => Character'Val (48 + Probes mod 10)));
         Info ("");
         Info ("");

      end;
   end Print_Global_Structure;

   ----------------
   -- Print_List --
   ----------------

   procedure Print_List (Node_List : No_SLOC_Node_Lists.Set) is
      Next_El : No_SLOC_Node_Lists.Cursor :=
        No_SLOC_Node_Lists.First (Node_List);

      use No_SLOC_Node_Lists;
   begin

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

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

      end if;

      Info ("");

   end Print_List;

   ----------------------
   -- Print_List_SLOCS --
   ----------------------

   procedure Print_List_SLOCS
     (Indentation_Level : Natural := 0;
      Node_List         : No_SLOC_Node_Lists.Set)
   is
      Next_El : No_SLOC_Node_Lists.Cursor :=
        No_SLOC_Node_Lists.First (Node_List);

      use No_SLOC_Node_Lists;
   begin

      if Next_El = No_SLOC_Node_Lists.No_Element then
         Report (Indentation_Level * Ident_String & " ...nothing...");
      else

         while Next_El /= No_SLOC_Node_Lists.No_Element loop
            Report_No_EOL (Indentation_Level * Ident_String);
            Report (Get_String
              (GS_Node_SLOC (No_SLOC_Node_Lists.Element (Next_El))));
            Next_El := No_SLOC_Node_Lists.Next (Next_El);
         end loop;

      end if;

      Info ("");

   end Print_List_SLOCS;

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

   procedure Print_Node (N : GS_Node_Id) is
   begin
      Info_No_EOL ("Node_Id =" & N'Img);
      Info_No_EOL (" - " & GS_Node_Kind (N)'Img);
      Info_No_EOL (" - " & Get_String (GS_Node_Name_Img (N)));
      Info        (" - " & Get_String (GS_Node_SLOC (N)));

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

      if GS_Enclosing_Scope (N) = No_Scope then
         Info_No_EOL (" (****** INDEFINED!!!)");
      else
         Info_No_EOL
           ('(' & Image (GS_Node_Scope_Level (GS_Enclosing_Scope (N))) & ')');
      end if;

      Info ("");

      if GS_Node_Scope_Level (N) /= 0 then
         Info_No_EOL (Ident_String);
         Info        ("Scope_Level     = " &
                      GS_Node_Scope_Level (N)'Img);
      end if;

      Info_No_EOL (Ident_String);
      Info        ("Hash_Link       =" & GS_Node_Hash_Link (N)'Img);

      if GS_Is_Of_No_Interest (N) then
         Info_No_EOL (Ident_String);
         Info        ("---Node is of NO INTEREST---");
      end if;

      if GS_Is_Foreign_Thread (N) then
         Info_No_EOL (Ident_String);
         Info        ("Is foreign thread");
      end if;

      if GS_Node_Kind (N) in Callable_Nodes then
         Info_No_EOL (2 * Ident_String);
         Info        ("Body_Analyzed = " & GS_Body_Analyzed (N)'Img);

         if GS_Is_Renaming (N) then
            Info (2 * Ident_String & "this is a RENAMING node");
         end if;

         Info_No_EOL (2 * Ident_String & "direct calls (");
         Info_No_EOL
           (Trim (SLOC_Node_Lists.Length (Table (N).Calls_Chain)'Img,
                  Side => Ada.Strings.Both));
         Info_No_EOL ("):");
         Print_SLOC_List (Table (N).Calls_Chain);

         if GS_Node_Kind (N) in Task_Nodes then
            Info_No_EOL (2 * Ident_String & "all calls (");
            Info_No_EOL
              (Trim (No_SLOC_Node_Lists.Length (Table (N).All_Calls_Chain)'Img,
                     Side => Ada.Strings.Both));
            Info_No_EOL ("):");
            Print_List (Table (N).All_Calls_Chain);
         end if;

      else
         if GS_Is_Local_Var_Accessed_By_Local_Tasks (N) then
            Info
              (2 * Ident_String & "local object accessed by enclosed tasks");
         end if;
      end if;

      Info (Ident_String & "REFERENCES:");

      Info_No_EOL (2 * Ident_String & "direct read references   :");
      Print_SLOC_List (Table (N).Direct_Read_References);

      Info_No_EOL (2 * Ident_String & "direct write references  :");
      Print_SLOC_List (Table (N).Direct_Write_References);

      Info_No_EOL (2 * Ident_String & "indirect read references :");
      Print_List (Table (N).Indirect_Read_References);

      Info_No_EOL (2 * Ident_String & "indirect write references:");
      Print_List (Table (N).Indirect_Write_References);

      Info ("");

   end Print_Node;

   ---------------------
   -- Print_SLOC_List --
   ---------------------

   procedure Print_SLOC_List (Node_List : SLOC_Node_Lists.Set) is
      Next_El : SLOC_Node_Lists.Cursor := SLOC_Node_Lists.First (Node_List);

      use SLOC_Node_Lists;
   begin

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

         Info ("");

         while Next_El /= SLOC_Node_Lists.No_Element loop
            Info_No_EOL (Ident_String);
            Info_No_EOL (Ident_String);
            Info_No_EOL (SLOC_Node_Lists.Element (Next_El).Node'Img);
            Info ("(" &
                  Get_String (SLOC_Node_Lists.Element (Next_El).SLOC) & ")");
            Next_El := SLOC_Node_Lists.Next (Next_El);
         end loop;

      end if;

      Info ("");

   end Print_SLOC_List;

   ---------------------
   -- Print_Backtrace --
   ---------------------

   procedure Print_Backtrace
     (From        : GS_Node_Id;
      To          : GS_Node_Id;
      Access_Kind : Reference_Kinds)
   is
      Next_Direct_Call : SLOC_Node_Lists.Cursor;
      --  Next call from the set of direct calls of the task From
      --  Also used to get information from trace nodes when generating
      --  the report

      One_Step_Trace : Boolean := False;
      --  Flag indicating if we are lucky and have a simple one-step trace
      --  (this most probably is the most common case). If this flag set on,
      --  Next_Direct_Call points to the needed called entity

      Next_Call : No_SLOC_Node_Lists.Cursor;
      --  Next call from the set of (indirect) calls to be processed
      Row       : Positive := 1;
      --  The number of the row in Trace_Matrix that is currently filled in.
      --  Note that the first row is filled in by the call to Init_Trace_Marix.

      New_Row_Column : Positive;
      --  Column in Trace_Matrix to place the new link into.

      Max_Trace_Len : constant Positive := Positive
        (No_SLOC_Node_Lists.Length (Table (From).All_Calls_Chain));
      --  Defines the size of Trace_Matrix that is enough to compute any needed
      --  trace

      Next_Node_To_Report : GS_Node_Id;
      Calling_Node        : GS_Node_Id;

   begin
      --  First, initialize Non_Processed_Calls and check if we indeed have to
      --  create Trase_Matrix

      Free_Trace_Matrix (Trace_Matrix);

      Trace_Matrix :=
        new Trace_Matrix_Array (1 .. Max_Trace_Len, 1 .. Max_Trace_Len);

      Trace_Matrix.all := (others => (others => Nil_Call_Chain_Element));

      No_SLOC_Node_Lists.Clear (Non_Processed_Calls);
      No_SLOC_Node_Lists.Clear (Processed_Calls);

      No_SLOC_Node_Lists.Union
        (Target => Non_Processed_Calls,
         Source => Table (From).All_Calls_Chain);

      Next_Direct_Call :=
        SLOC_Node_Lists.First (Table (From).Calls_Chain);

      New_Row_Column := 1;

      while SLOC_Node_Lists.Has_Element (Next_Direct_Call) loop

         if (Access_Kind = Read
            and then
             SLOC_Node_Lists.Contains
               (Table (SLOC_Node_Lists.Element
                  (Next_Direct_Call).Node).Direct_Read_References,
                (Node => To, SLOC => Nil_String_Loc)))
          or else
            (Access_Kind = Write
            and then
             SLOC_Node_Lists.Contains
               (Table (SLOC_Node_Lists.
                  Element (Next_Direct_Call).Node).Direct_Write_References,
                (Node => To, SLOC => Nil_String_Loc)))
         then
            One_Step_Trace := True;
            exit;
         end if;

         No_SLOC_Node_Lists.Delete
           (Container => Non_Processed_Calls,
            Item      => SLOC_Node_Lists.Element (Next_Direct_Call).Node);

         Trace_Matrix (1, New_Row_Column) :=
           (Called_Entity  => SLOC_Node_Lists.Element (Next_Direct_Call).Node,
            Calling_Entity => 0);

         Next_Direct_Call := SLOC_Node_Lists.Next (Next_Direct_Call);
         New_Row_Column   := New_Row_Column + 1;
      end loop;

      if One_Step_Trace then
         --  No need to create and analyze Trace_Matrix, we already have all
         --  the information needed to print out the trace!
         Next_Node_To_Report :=
           SLOC_Node_Lists.Element (Next_Direct_Call).Node;

         Report_No_EOL (3 * Ident_String);

         if Access_Kind = Read then
            Report_No_EOL ("read by subprogram ");
            Next_Direct_Call := SLOC_Node_Lists.Find
              (Container => Table (Next_Node_To_Report).Direct_Read_References,
               Item      => (Node => To, SLOC => Nil_String_Loc));
         else
            Report_No_EOL ("written by subprogram ");
            Next_Direct_Call := SLOC_Node_Lists.Find
              (Container => Table (Next_Node_To_Report).
                 Direct_Write_References,
               Item      => (Node => To, SLOC => Nil_String_Loc));
         end if;

         Report_No_EOL (Get_String (GS_Node_Name_Img (Next_Node_To_Report)));

         Report_No_EOL (" at ");
         Report (Get_String (SLOC_Node_Lists.Element (Next_Direct_Call).SLOC));

         Report_No_EOL (3 * Ident_String);
         Report_No_EOL ("which is called by ");

         if GS_Is_Foreign_Thread (From) then
            Report_No_EOL ("thread ");
         else
            Report_No_EOL ("task body ");
         end if;

         Report_No_EOL (Get_String (GS_Node_Name_Img (From)));
         Report_No_EOL (" at ");

         Next_Direct_Call := SLOC_Node_Lists.Find
           (Container => Table (From).Calls_Chain,
            Item      => (Node => Next_Node_To_Report,
                          SLOC => Nil_String_Loc));

         Report (Get_String (SLOC_Node_Lists.Element (Next_Direct_Call).SLOC));

         return;
      end if;

      --  If we are here, we do not have any one-step trace that leads to the
      --  data object To. So we have to build and analyse Trace_Matrix

      Trace_End_Line   := 0;
      Trace_End_Column := 0;

      --  What we need is a call trace starting from From and ending with the
      --  (direct) call to a procedure that has a direct access to To, and this
      --  access is of Access_Kind

      --  May be we are lucky, and the needed data object is accessed by some
      --  ditectly called entity

      --  Now trace matix contains only direct calls. But we know that the data
      --  object is accessed indirectly...

      Create_Trace_Matrix :
      while not No_SLOC_Node_Lists.Is_Empty (Non_Processed_Calls) loop

         --  Fill in the new row in Trace_Matrix
         Row            := Row + 1;
         New_Row_Column := 1;

         Next_Call := No_SLOC_Node_Lists.First (Non_Processed_Calls);

         Scan_Non_Processed_Calls :
         while No_SLOC_Node_Lists.Has_Element (Next_Call) loop

            --  Go through the previous row and look for the entity that can
            --  can call Next_Call

            Scan_Last_Row :
            for J in Trace_Matrix'Range (1) loop

               if Trace_Matrix (Row - 1, J) = Nil_Call_Chain_Element then
                  --  All the elements in the last completed row have been
                  --  processed, so
                  exit Scan_Last_Row;
               end if;

               --  Check if the last node in the partially created chain
               --  directly calls Next_Call:

               if SLOC_Node_Lists.Contains
                    (Table (Trace_Matrix (Row - 1, J).Called_Entity).
                       Calls_Chain,
                     (Node => No_SLOC_Node_Lists.Element (Next_Call),
                      SLOC => Nil_String_Loc))
               then
                  --  Add Next_Call to the trace:
                  Trace_Matrix (Row, New_Row_Column) :=
                    (Called_Entity  => No_SLOC_Node_Lists.Element (Next_Call),
                     Calling_Entity => J);

                  if (Access_Kind = Read
                     and then
                      SLOC_Node_Lists.Contains
                        (Table (No_SLOC_Node_Lists.Element
                           (Next_Call)).Direct_Read_References,
                         (Node => To, SLOC => Nil_String_Loc)))
                   or else
                     (Access_Kind = Write
                     and then
                      SLOC_Node_Lists.Contains
                        (Table (No_SLOC_Node_Lists.
                           Element (Next_Call)).Direct_Write_References,
                         (Node => To, SLOC => Nil_String_Loc)))
                  then
                     --  if Next_Call directly accesses To - we are done with
                     --  Trace_Matric creation!
                     Trace_End_Line   := Row;
                     Trace_End_Column := New_Row_Column;
                     exit Create_Trace_Matrix;
                  else
                     --  preparing for the next steps...
                     New_Row_Column := New_Row_Column + 1;

                     No_SLOC_Node_Lists.Insert
                       (Container => Processed_Calls,
                        New_Item  => No_SLOC_Node_Lists.Element (Next_Call));

                     exit Scan_Last_Row;
                  end if;

               end if;

            end loop Scan_Last_Row;

            Next_Call := No_SLOC_Node_Lists.Next (Next_Call);
         end loop Scan_Non_Processed_Calls;

         No_SLOC_Node_Lists.Difference (Non_Processed_Calls, Processed_Calls);
         No_SLOC_Node_Lists.Clear (Processed_Calls);

      end loop Create_Trace_Matrix;

      pragma Assert (Trace_End_Line > 0 and then Trace_End_Column > 0);

      --  Print out the trace that contains more then one link:

      Next_Node_To_Report :=
        Trace_Matrix (Trace_End_Line, Trace_End_Column).Called_Entity;

      Report_No_EOL (3 * Ident_String);

      if Access_Kind = Read then
         Report_No_EOL ("read by subprogram ");
         Next_Direct_Call := SLOC_Node_Lists.Find
           (Container => Table (Next_Node_To_Report).Direct_Read_References,
            Item      => (Node => To, SLOC => Nil_String_Loc));
      else
         Report_No_EOL ("written by subprogram ");
         Next_Direct_Call := SLOC_Node_Lists.Find
           (Container => Table (Next_Node_To_Report).
              Direct_Write_References,
            Item      => (Node => To, SLOC => Nil_String_Loc));
      end if;

      Report_No_EOL (Get_String (GS_Node_Name_Img (Next_Node_To_Report)));

      Report_No_EOL (" at ");
      Report (Get_String (SLOC_Node_Lists.Element (Next_Direct_Call).SLOC));

      while Trace_End_Line > 1 loop
         Calling_Node :=
           Trace_Matrix
             (Trace_End_Line - 1,
              Trace_Matrix (Trace_End_Line,
                            Trace_End_Column).Calling_Entity).Called_Entity;

         Next_Direct_Call := SLOC_Node_Lists.Find
           (Container => Table (Calling_Node).Calls_Chain,
            Item      => (Node => Next_Node_To_Report,
                          SLOC => Nil_String_Loc));

         Report_No_EOL (3 * Ident_String & "which is called by subprogram ");
         Report_No_EOL (Get_String (GS_Node_Name_Img (Calling_Node)));
         Report_No_EOL (" at ");
         Report (Get_String (SLOC_Node_Lists.Element (Next_Direct_Call).SLOC));

         Trace_End_Column :=
           Trace_Matrix (Trace_End_Line, Trace_End_Column).Calling_Entity;
         Next_Node_To_Report := Calling_Node;
         Trace_End_Line      := Trace_End_Line - 1;
      end loop;

      Report_No_EOL (3 * Ident_String);
      Report_No_EOL ("which is called by task body ");
      Report_No_EOL (Get_String (GS_Node_Name_Img (From)));
      Report_No_EOL (" at ");

      Next_Direct_Call := SLOC_Node_Lists.Find
        (Container => Table (From).Calls_Chain,
         Item      => (Node => Next_Node_To_Report,
                       SLOC => Nil_String_Loc));

      Report (Get_String (SLOC_Node_Lists.Element (Next_Direct_Call).SLOC));

   exception
      when Ex : others =>
         Report ("");
         Report_No_EOL (3 * Ident_String);
         Report ("trace is incomplete because of the error detected!!!");
         Report ("");
         Report ("");

         Tool_Failures := Tool_Failures + 1;

         ASIS_UL.Output.Error
           ("failed to create backtrace from task "         &
            Get_String (GS_Node_Name_Img (From))             &
            "(" & Get_String (GS_Node_SLOC (From)) & ") to " &
            Get_String (GS_Node_Name_Img (To))               &
            "(" & Get_String (GS_Node_SLOC (To)) & ")");

         ASIS_UL.Output.Report_Unhandled_Exception (Ex);

         if Debug_Mode then
            Print_Node (From);
            Print_Node (To);
         end if;

   end Print_Backtrace;

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

   function Register_Node
     (El          : Asis.Element;
      Encl_Scope  : Scope_Id := No_Scope)
      return GS_Node_Id
   is
      Encl_Scope_Node  : Scope_Id := Encl_Scope;
      Encl_Scope_El    : Asis.Element;
      New_Node         : GS_Node_Record;
      Hash_Value       : constant Hash_Index_Type := Hash (El);
      Last_In_Chain    : GS_Node_Id               := Hash_Table (Hash_Value);
      Result           : GS_Node_Id;

   begin

      if No (Encl_Scope_Node) then
         --  The following may cause creation of a whole bunch of nodes

         Encl_Scope_El := Enclosing_Scope (El);

         if Is_Nil (Encl_Scope_El) then
            Encl_Scope_Node := Environment_Task_Node;
         else
            Encl_Scope_Node :=
              Corresponding_Node (Corresponding_Element (Encl_Scope_El));
         end if;
      end if;

      New_Node :=
        (Node_Kind                 => Define_GS_Node_Kind (El),
         SLOC                      => Build_GNAT_Location (El),
         Name_Img                  => Enter_String (Get_Enity_Name (El)),
         Enclosing_Scope           => Encl_Scope_Node,
         Scope_Level               => 0,
         Hash_Link                 => No_GS_Node,
         Calls_Chain               => SLOC_Node_Lists.Empty_Set,
         All_Calls_Chain           => No_SLOC_Node_Lists.Empty_Set,
         Direct_Read_References    => SLOC_Node_Lists.Empty_Set,
         Direct_Write_References   => SLOC_Node_Lists.Empty_Set,
         Indirect_Read_References  => No_SLOC_Node_Lists.Empty_Set,
         Indirect_Write_References => No_SLOC_Node_Lists.Empty_Set,
         Body_Analyzed             => False,
         Is_Renaming               => False,
         Renamed_Subprogram        => No_GS_Node,
         Is_Of_No_Interest         => False,
         Is_Foreign_Thread         => False);

      pragma Assert (New_Node.Node_Kind /= Not_A_Node);

      GS_Nodes_Container.Append (Container => GS_Nodes_Table,
                                 New_Item  => New_Node);

      Result := Last_Node;

      if No (Last_In_Chain) then
         Hash_Table (Hash_Value) := Result;
      else

         while Present (GS_Node_Hash_Link (Last_In_Chain)) loop
            Last_In_Chain :=  GS_Node_Hash_Link (Last_In_Chain);
         end loop;

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

      if New_Node.Node_Kind = A_Subprogram then

         if ASIS_UL.Utilities.Is_Imported_Subprogram (El)
           or else
            (not ASIS_UL.Options.Process_RTL_Units
            and then
             Unit_Origin (Enclosing_Compilation_Unit (El)) /=
               An_Application_Unit)
         then
            Set_Body_Analyzed     (Result);
            Set_Is_Of_No_Interest (Result);
         end if;

         if ASIS_UL.Options.Main_Subprogram_Name /= null
           and then
            Is_Nil (Enclosing_Element (El))
           and then
            Can_Be_Main_Program (Enclosing_Compilation_Unit (El))
           and then
            ASIS_UL.Options.Main_Subprogram_Name.all =
            Normalize_Pathname
              (To_String (Text_Name (Enclosing_Compilation_Unit (El))),
               Resolve_Links  => False,
               Case_Sensitive => False)
         then
            --  This is a main subprogram of the partition, store the call from
            --  environment task to it:
            Store_Call_Arc
              (Called_Link  => (Node => Result, SLOC => New_Node.SLOC),
               Calling_Node => Environment_Task_Node);
         end if;

         if Is_Foreign_Thread (El) then
            Set_Is_Foreign_Thread (Result);
         end if;

      end if;

      return Result;

   end Register_Node;

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

   procedure Remove_Current_Scope is
   begin

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

   end Remove_Current_Scope;

   --------------------------------------------
   -- Remove_Current_Scope_Critical_Sections --
   --------------------------------------------

   procedure Remove_Current_Scope_Critical_Sections is
   begin
      Section_Start_Table.Set_Last
        (Gnatsync.Global_Info.Data.Current_Scope_Sections_Start - 1);
   end Remove_Current_Scope_Critical_Sections;

   -------------------------
   -- Report_No_SLOC_List --
   -------------------------

   procedure Report_No_SLOC_List
     (Node_List   : No_SLOC_Node_Lists.Set;
      Data_Node   : GS_Node_Id;
      Access_Kind : Reference_Kinds)
   is
      Next_El   : No_SLOC_Node_Lists.Cursor :=
        No_SLOC_Node_Lists.First (Node_List);
      Next_Node : GS_Node_Id;

      use No_SLOC_Node_Lists;
   begin
      --  We know for sure that the argument list is not empty!

      while Next_El /= No_SLOC_Node_Lists.No_Element loop

         Next_Node := No_SLOC_Node_Lists.Element (Next_El);

         Report_No_EOL (2 * Ident_String);

         if GS_Is_Foreign_Thread (Next_Node) then
            Report_No_EOL ("thread    ");
         else
            Report_No_EOL ("task");

            if GS_Node_Kind (Next_Node) = A_Task_Type_Body then
               Report_No_EOL (" type ");
            else
               Report_No_EOL ("      ");
            end if;

         end if;

         Report_No_EOL (Get_String (GS_Node_Name_Img (Next_Node)));
         Report        (" (" & (Get_String (GS_Node_SLOC (Next_Node))) & ')');

         if Output_Level = Full then
            Print_Backtrace
              (From        => Next_Node,
               To          => Data_Node,
               Access_Kind => Access_Kind);
         end if;

         Next_El := No_SLOC_Node_Lists.Next (Next_El);
      end loop;

   end Report_No_SLOC_List;

   ----------------------
   -- Report_SLOC_List --
   ----------------------

   procedure Report_SLOC_List (Node_List : SLOC_Node_Lists.Set) is
      Next_El   : SLOC_Node_Lists.Cursor := SLOC_Node_Lists.First (Node_List);
      Next_Link : Link;

      use SLOC_Node_Lists;
   begin
      --  We know for sure that the argument list is not empty!

      while Next_El /= SLOC_Node_Lists.No_Element loop

         Next_Link := SLOC_Node_Lists.Element (Next_El);

         if GS_Is_Foreign_Thread (Next_Link.Node) then
            Report_No_EOL (2 * Ident_String & "thread    ");
         else
            Report_No_EOL (2 * Ident_String & "task");

            if GS_Node_Kind (Next_Link.Node) = A_Task_Type_Body then
               Report_No_EOL (" type ");
            else
               Report_No_EOL ("      ");
            end if;

         end if;

         Report_No_EOL (Get_String (GS_Node_Name_Img (Next_Link.Node)));
         Report_No_EOL (" at ");
         Report        (Get_String (Next_Link.SLOC));

         Next_El := SLOC_Node_Lists.Next (Next_El);
      end loop;

   end Report_SLOC_List;

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

   procedure Set_Current_Scope
     (Scope           : GS_Node_Id;
      Scope_Tree_Node : Node_Id)
   is

   begin
      Scope_Stack.Append
        ((Scope, Scope_Tree_Node, Get_First_Critical_Section));
      Set_Scope_Level (Scope, Scope_Stack.Last);
   end Set_Current_Scope;

   ------------------------
   -- Should_Be_Reported --
   ------------------------

   function Should_Be_Reported (Node : GS_Node_Id) return Boolean is
      Result : Boolean := False;
      use Ada.Containers;

      All_Writes : No_SLOC_Node_Lists.Set := No_SLOC_Node_Lists.Empty_Set;
      All_Reads  : No_SLOC_Node_Lists.Set := No_SLOC_Node_Lists.Empty_Set;
      --  Used by Should_Be_Reported to represent  lists of all the tasks that
      --  write to/read from a data object.

   begin

      if SLOC_Node_Lists.Length (Table (Node).Direct_Write_References) > 1
        or else
         No_SLOC_Node_Lists.Length
           (Table (Node).Indirect_Write_References) > 1
      then
         --  For sure more then one task writes to this object, so
         Result := True;

      elsif SLOC_Node_Lists.Length
               (Table (Node).Direct_Write_References) > 0
        or else
         No_SLOC_Node_Lists.Length
           (Table (Node).Indirect_Write_References) > 0
      then
         --  At least one task writes into this object

         All_Writes := No_SLOC_Node_Lists.Union
           (Left  => All_Writes,
            Right => Table (Node).Indirect_Write_References);

         Add_SLOC_Node_List_To_Node_List
           (Target => All_Writes,
            Source => Table (Node).Direct_Write_References);

         if No_SLOC_Node_Lists.Length (All_Writes) > 1
           or else
            (No_SLOC_Node_Lists.Length (All_Writes) = 1
             and then
             GS_Node_Kind (No_SLOC_Node_Lists.First_Element (All_Writes)) =
              A_Task_Type_Body
             and then
              Is_Global_For
                (Node  => Node,
                 Scope => No_SLOC_Node_Lists.First_Element (All_Writes)))
         then
            --  More then one different tasks writes into object, no need
            --  to check reads, the last condition is needed to filter out the
            --  cases like this:
            --
            --  task type T;
            --  task body T is
            --     Local_Var : Integer;
            --     task Local_Task;
            --
            --     task body Local_Task is
            --     ...  --  no access to Local_Var
            --     end Local_Task;
            --  begin
            --
            --    Local_Var := Local_Var + 1;
            --  end T

            Result := True;
         else
            --  Only one task writes into the object, and this is not a task
            --  type. So we have to check reads:

            All_Reads := No_SLOC_Node_Lists.Union
              (Left  => All_Reads,
               Right => Table (Node).Indirect_Read_References);

            Add_SLOC_Node_List_To_Node_List
              (Target => All_Reads,
               Source => Table (Node).Direct_Read_References);

            if No_SLOC_Node_Lists.Length (All_Reads) > 1
              or else
               (No_SLOC_Node_Lists.Length (All_Reads) > 0
               and then
                No_SLOC_Node_Lists.First_Element (All_Writes) /=
                No_SLOC_Node_Lists.First_Element (All_Reads))
            then
               Result := True;
            end if;

         end if;

      end if;

      return Result;
   end Should_Be_Reported;

   --------------------
   -- Store_Call_Arc --
   --------------------

   procedure Store_Call_Arc
     (Called_Link  : Link;
      Calling_Node : GS_Node_Id := Current_Scope)
   is
   begin
      Add_Node_To_List
        (To_Node     => Calling_Node,
         To_List     => Calls,
         Link_To_Add => Called_Link);
   end Store_Call_Arc;

   ---------------------
   -- Store_Reference --
   ---------------------

   procedure Store_Reference
     (N              : GS_Node_Id;
      At_SLOC        : String_Loc;
      Reference_Kind : Reference_Kinds)
   is
   begin

      if Reference_Kind = Read
        or else
         Reference_Kind = Read_Write
      then
         Add_Node_To_List
           (To_Node     => Current_Scope,
            To_List     => Direct_Read_References,
            Link_To_Add => (Node => N, SLOC => At_SLOC));

         if GS_Node_Kind (Current_Scope) in Task_Nodes
           or else
            GS_Is_Foreign_Thread (Current_Scope)
         then
            Add_Node_To_List
              (To_Node     => N,
               To_List     => Direct_Read_References,
               Link_To_Add => (Node => Current_Scope, SLOC => At_SLOC));
         end if;

      end if;

      if Reference_Kind = Write
        or else
         Reference_Kind = Read_Write
      then
         Add_Node_To_List
           (To_Node     => Current_Scope,
            To_List     => Direct_Write_References,
            Link_To_Add => (Node => N, SLOC => At_SLOC));

         if GS_Node_Kind (Current_Scope) in Task_Nodes
           or else
            GS_Is_Foreign_Thread (Current_Scope)
         then
            Add_Node_To_List
              (To_Node     => N,
               To_List     => Direct_Write_References,
               Link_To_Add => (Node => Current_Scope, SLOC => At_SLOC));
         end if;

      end if;

   end Store_Reference;

   -------------------------
   -- Store_Section_Start --
   -------------------------

   procedure Store_Section_Start (Start_Proc : Thread_Info_Id) is
   begin
      Section_Start_Table.Append (Start_Proc);
   end Store_Section_Start;

   -----------
   -- 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;

   ------------------------
   -- Transitive_Closure --
   ------------------------

   procedure Transitive_Closure is

      procedure Close_Node (Node : GS_Node_Id);
      --  Creates a list of all the nodes called by the given node using
      --  workpile algorithm.
      --
      --  The following variables are used by this procedure, we define them
      --  as global to avoid elaboration expances for each call of Close_Node.

      New_Set   : No_SLOC_Node_Lists.Set;
      --  A set of nodes that are added to All_Call. For each of the nodes
      --  from this set we should analyse its direct calls and then remove
      --  the node fron this set. We stop the loop for the next node when
      --  this set is empty,

      Newer_Set : No_SLOC_Node_Lists.Set;
      --  Nodes that are added for All_Call at the last iteration of the
      --  processing of New_Set for the given node. They should be added to
      --  New_Set to process their direct calls.

      Next_Direct_Call : No_SLOC_Node_Lists.Cursor;
      Next_Call        : SLOC_Node_Lists.Cursor;

      ----------------
      -- Close_Node --
      ----------------

      procedure Close_Node (Node : GS_Node_Id) is
      begin

         No_SLOC_Node_Lists.Clear (New_Set);
         No_SLOC_Node_Lists.Clear (Newer_Set);

         Add_SLOC_Node_List_To_Node_List
           (Table (Node).All_Calls_Chain, Table (Node).Calls_Chain);

         Add_SLOC_Node_List_To_Node_List (New_Set, Table (Node).Calls_Chain);

         while not No_SLOC_Node_Lists.Is_Empty (New_Set) loop
            Next_Direct_Call := No_SLOC_Node_Lists.First (New_Set);

            Next_Call :=
              SLOC_Node_Lists.First
                (Table (No_SLOC_Node_Lists.Element
                 (Next_Direct_Call)).Calls_Chain);

            while SLOC_Node_Lists.Has_Element (Next_Call) loop

               if not No_SLOC_Node_Lists.Contains
                 (Table (Node).All_Calls_Chain,
                  SLOC_Node_Lists.Element (Next_Call).Node)
               then
                  No_SLOC_Node_Lists.Insert
                    (Newer_Set, SLOC_Node_Lists.Element (Next_Call).Node);
               end if;

               Next_Call := SLOC_Node_Lists.Next (Next_Call);
            end loop;

            No_SLOC_Node_Lists.Delete_First (New_Set);

            if not No_SLOC_Node_Lists.Is_Empty (Newer_Set) then
               No_SLOC_Node_Lists.Union
                 (Table (Node).All_Calls_Chain, Newer_Set);
               No_SLOC_Node_Lists.Union (New_Set,   Newer_Set);
               No_SLOC_Node_Lists.Clear (Newer_Set);
            end if;

         end loop;

      end Close_Node;

   begin

      if not Quiet_Mode then
         Info ("Call graph transitive closure - start (total: " &
               Last_Node'Img & " nodes)");

         if ASIS_UL.Options.Compute_Timing and then Debug_Mode then
            Time_Start := Ada.Calendar.Clock;
         end if;

      end if;

      Traverse_Renamings;
      Check_Call_Graph_Completeness;

      for Node in First_GS_Node .. Last_Node loop

         --  What about the environment task and the main subprogram???

         if GS_Node_Kind (Node) in Task_Nodes
           or else
            (Foreign_Threads_Present
            and then
             GS_Is_Foreign_Thread (Node))
         then
            Output_Node (Node);
            Close_Node (Node);
         end if;

      end loop;

      if not Quiet_Mode then
         Info_No_EOL ("Call graph transitive closure - done");

         if ASIS_UL.Options.Compute_Timing and then Debug_Mode then
            Exect_Time := Ada.Calendar.Clock - Time_Start;
            Info (", execution time is" & Exect_Time'Img & " seconds");
         else
            Info ("");
         end if;

      end if;

   end Transitive_Closure;

   ------------------------
   -- Traverse_Renamings --
   ------------------------

   procedure Traverse_Renamings is
      Already_Processed_Renamings : No_SLOC_Node_Lists.Set;

      procedure Process_Renaming (Node : GS_Node_Id);
      --  Processes one renaming node and after that add node to
      --  Already_Processed_Renamings set. This procedure recursively

      procedure Process_Renaming (Node : GS_Node_Id) is
         Renamed_Node : constant GS_Node_Id :=
           SLOC_Node_Lists.Element
             (SLOC_Node_Lists.First (Table (Node).Calls_Chain)).Node;
      begin

         if GS_Is_Of_No_Interest (Renamed_Node) then
            Set_Is_Of_No_Interest (Node);
            return;
         end if;

         if GS_Is_Renaming (Renamed_Node)
           and then
             not No_SLOC_Node_Lists.Contains
                   (Already_Processed_Renamings, Renamed_Node)
         then
            Process_Renaming (Renamed_Node);
            --  This may define that Renamed_Node is of no interest, so:

            if GS_Is_Of_No_Interest (Renamed_Node) then
               Set_Is_Of_No_Interest (Node);
               return;
            end if;

         end if;

         Set_Body_Analyzed (Node, GS_Body_Analyzed (Renamed_Node));

      end Process_Renaming;

   begin
      No_SLOC_Node_Lists.Clear (Already_Processed_Renamings);

      for Node in First_GS_Node .. Last_Node loop

         if GS_Is_Renaming (Node)
            and then
             not GS_Is_Of_No_Interest (Node)
            and then
             not No_SLOC_Node_Lists.Contains
               (Already_Processed_Renamings, Node)
         then
            Process_Renaming (Node);
         end if;

      end loop;

   end Traverse_Renamings;

begin
   Environment_Task_Node_Rec :=
     (Node_Kind                 => Environment_Task,
      SLOC                      => Nil_String_Loc,
      Name_Img                  => Enter_String ("Environment Task"),
      Enclosing_Scope           => No_Scope,
      Scope_Level               => 0,
      Hash_Link                 => No_GS_Node,
      Calls_Chain               => SLOC_Node_Lists.Empty_Set,
      All_Calls_Chain           => No_SLOC_Node_Lists.Empty_Set,
      Direct_Read_References    => SLOC_Node_Lists.Empty_Set,
      Direct_Write_References   => SLOC_Node_Lists.Empty_Set,
      Indirect_Read_References  => No_SLOC_Node_Lists.Empty_Set,
      Indirect_Write_References => No_SLOC_Node_Lists.Empty_Set,
      Body_Analyzed             => True,
      Is_Renaming               => False,
      Renamed_Subprogram        => No_GS_Node,
      Is_Of_No_Interest         => False,
      Is_Foreign_Thread         => False);

   Initialize;

end Gnatsync.Global_Info.Data;
