------------------------------------------------------------------------------
--                                                                          --
--                          GNATCHECK COMPONENTS                            --
--                                                                          --
--            G N A T S Y N C . G L O B A L _ I N F O . D A T A             --
--                                                                          --
--                                 S p e c                                  --
--                                                                          --
--                    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).              --
--                                                                          --
------------------------------------------------------------------------------

--  The package defines basic data structures for storing the global state
--  of the analyzed sources

with Types;            use Types;

with ASIS_UL.Strings;  use ASIS_UL.Strings;

with Gnatsync.Threads; use Gnatsync.Threads;

package Gnatsync.Global_Info.Data is

   pragma Elaborate_Body (Gnatsync.Global_Info.Data);

   --  The global structure is a call graph attrubuted by the data objects
   --  referenced by callable entities.
   --
   --  The call graph is a set of callable nodes and arcs between them. Nodes
   --  represent entities that can call another entities or/and can be called
   --  by them.
   --
   --  Data objects ????????

   --  We consider the following node (entity) kinds:

   type GS_Node_Kinds is
     (Not_A_Node,
      --  A null node

      Environment_Task,
      --  This node represents an environment task. This node does not call
      --  any other node, and in cannot be called by any other node, but we
      --  need it to represent a most global (library-level) scope.

      A_Single_Task_Body,
      --  Callable node.
      --  Corresponds to a body, of a sigle task object

      A_Task_Type_Body,
      --  Callable node.
      --  Corresponds to a task body completing a task type declaration

      A_Subprogram,
      --  Callable node.
      --  We do not make any difference between procedures and functions,
      --  subprogram instantiations are treated as subprograms

      A_Data_Object
      --  Data object referenced by a callable entity. We consider only
      --  variable and constant (???) declarations as data objects. We do not
      --  consider as data objects formal parameters or subcomponents
      );

   subtype Callable_Nodes is GS_Node_Kinds
     range Environment_Task .. A_Subprogram;

   subtype Task_Nodes is GS_Node_Kinds
     range Environment_Task .. A_Task_Type_Body;

   --  Each node is pointed by a Node ID, that may be viewed as an index in the
   --  vector of nodes:

   type GS_Node_Id is new Integer range 0 .. Integer'Last;
   --  Index of the nodes representing the global state

   No_GS_Node    : constant GS_Node_Id := GS_Node_Id'First;
   First_GS_Node : constant GS_Node_Id := No_GS_Node + 1;

   Environment_Task_Node : GS_Node_Id;
   --  Node representing the environment task

   subtype Existing_GS_Node_Id is GS_Node_Id
     range First_GS_Node .. GS_Node_Id'Last;

   type Reference_Kinds is
   --  Classifies the references to global data objects
     (Not_A_Reference,
      --  Either not applicable or non-defined
      Read,
      --  Read reference
      Write,
      --  Write reference:
      --  * variable in an assignment statement
      --  * actual for a OUT parameter
      Read_Write);
      --  Reference that can be both read and write:
      --  * actual for IN OUT parameter
      --  * prefix of 'Access and 'Unchecked_Access attribute, we are
      --    over-pessimistic in this case;

   -----------------
   -- Scope_Stack --
   -----------------

   --  Scopes are statically enclosed bodies of callable entities,
   --  Environment_Task_Node represents the outermost (library-level) scope.
   --  Scopes are stored in the stack according to their nesting

   subtype Scope_Id is GS_Node_Id;
   No_Scope  : constant Scope_Id := Scope_Id'First;

   procedure Set_Current_Scope (Scope : GS_Node_Id; Scope_Tree_Node : Node_Id);
   --  Puts the argument on the top of the scope set. We need the corresponding
   --  tree node to check if an entity is global for the current scope.

   procedure Remove_Current_Scope;
   --  Pops the top scope from the stack. Raises Scope_Stack_Error if the scope
   --  stack is empty

   function Current_Scope return Scope_Id;
   --  Returns the top entity from the scope stack. Returns No_Scope_Ind if the
   --  stack is empty

   function Current_Scope_Tree_Node return Node_Id;
   --  Returns the tree node for the current scope. This node always belongs
   --  to the currently accessed tree.

   procedure Init_Critical_Section_Table;
   --  Resets the data structures describing the critical sections into initial
   --  (empty) state. This procedure should be called for each compilation unit
   --  because otherwise we may count critical sections in the library package
   --  bodies across the package porders

   function In_Critical_Section return Boolean;
   --  Checks if the traversing is now in a critical section.

   procedure Check_For_Critical_Section (Call : Asis.Element);
   --  Assuming that Call is a procedure call statement, checks if this call
   --  means the start or the end of a foreign critical section, and if it is,
   --  updates the information about critical s4ections for the current scope.

   procedure Store_Section_Start (Start_Proc : Thread_Info_Id);
   --  Stores that Start_Proc opens a critical section for a current scope

   Scope_Stack_Error : exception;

   -----------
   -- Links --
   -----------

   --  The global structure keeps two kinds of links between nodes - one
   --  represents calls, another - references to global variables. Both kinds
   --  of links are represented by the Id of the node representing the
   --  called/referenced entity, and the SLOC of the (first) call/reference

   type Link is record
      Node : GS_Node_Id;
      SLOC : String_Loc;
   end record;

   ---------------------------------------
   -- Basic global structure operations --
   ---------------------------------------

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

   function Present (N : GS_Node_Id) return Boolean;
   --  Checks if N is within the range of the currently represented nodes

   function No (N : GS_Node_Id) return Boolean;
   --  Checks if N is not in the range of the currently represented nodes

   function Last_Node return GS_Node_Id;
   --  Returtns the last node stored in the call graph.

   function GS_Enclosing_Scope (N : GS_Node_Id) return GS_Node_Id;
   --  Returns the enclosing scoprlink of the node. Returns No_GS_Node in case
   --  if No (N).

   function GS_Node_Kind (N : GS_Node_Id) return GS_Node_Kinds;
   --  Returns the kind of its argument. Returns Not_A_Node in case if No (N).

   function GS_Node_Name_Img (N : GS_Node_Id) return String_Loc;
   --  Returns the SLOC of the node name image. Raises Constraint_Error in case
   --  if No (N).

   function GS_Node_SLOC (N : GS_Node_Id) return String_Loc;
   --  Returns the string location of its argument. Returns Nil_String_Loc in
   --  case if No (N).

   function GS_Body_Analyzed (N : GS_Node_Id) return Boolean;
   --  Tells if the body is analyzed for the given entity

   function GS_Is_Of_No_Interest (N : GS_Node_Id) return Boolean;
   --  Tells if the node is of no interest for global references analysis.

   function GS_Is_Foreign_Thread (N : GS_Node_Id) return Boolean;
   --  Tells if the node is should be considered as a foreign thread

   function GS_Is_Local_Var_Accessed_By_Local_Tasks
     (N    : GS_Node_Id)
      return Boolean;
   --  Tells if the node represents a data object that is local for some
   --  scope (and is accessed by this scope), but that can also be accessed by
   --  some tasks local to this scope.

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

   procedure Set_Body_Analyzed (N : GS_Node_Id; Val : Boolean := True);
   --  Set the flag indicating if the body of the callable entity is analyzed.

   procedure Set_Is_Of_No_Interest (N : GS_Node_Id; Val : Boolean := True);
   --  Set the flag indicating if the callable entity is of no interest for
   --  analyzing global references.

   procedure Set_Is_Renaming (N : GS_Node_Id; Val : Boolean := True);
   --  Set the flag indicating if the callable entity is a renaming of another
   --  callable entity (only renamings-as-bodies are represented in the call
   --  graph),

   procedure Set_Is_Foreign_Thread (N : GS_Node_Id; Val : Boolean := True);
   --  Set the flag indicating if the node is should be considered as a foreign
   --  thread,

   procedure Set_Is_Local_Var_Accessed_By_Local_Tasks
     (N   : GS_Node_Id;
      Val : Boolean := True);
   --  Sets the flag indicating that the node represents a data object that is
   --  local for some scope (and is accessed by this scope), but that can also
   --  be accessed by some tasks local to this scope.

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

   function Is_Global_For_Current_Scope
     (Def_Name : Asis.Element)
      return     Boolean;
   --  Checks if Def_Name (that is supposed to be of a Defining_Identifier
   --  kind) is global for the current scope.

   function Corresponding_Node
     (El              : Element;
      Enclosing_Scope : Scope_Id := No_Scope)
      return            GS_Node_Id;
   --  Returns the Id of the call graph node corresponding to El. If this El
   --  has not been added to the call graph yet, creates it and returns as the
   --  result. If set to non-empty value, Enclosing_Scope parameter is used
   --  to specify the enclosing scope of the node to be created.

   procedure Store_Call_Arc
     (Called_Link  : Link;
      Calling_Node : GS_Node_Id := Current_Scope);
   --  Stores in the call graph the arc representing that the Current Scope
   --  calls Called_Link.Node at Called_Link.SLOC. This procedure assumes that
   --  Present (Called_Link.Node)

   procedure Store_Reference
     (N              : GS_Node_Id;
      At_SLOC        : String_Loc;
      Reference_Kind : Reference_Kinds);
   --  Stores in the global structure the arc(s) representing that the Current
   --  Scope refers At_SLOC to the global data object N. This procedure assumes
   --  that Present (N), Note that arcs are stored for both scope and data
   --  nodes!

   procedure Transitive_Closure;
   --  We do not perform a full transitive closure of the call graph, all that
   --  we need to know is a full set of callable entities called by task
   --  entities (including procedures that are specified as foreign threads).
   --  This is what the given procedure does - it traverses all the nodes
   --  stores in the global data structure, and apply the workpile algorithm to
   --  the task nodes.

   procedure Compute_Task_Global_References;
   --  Compute all the global references for the task and foreign thread nodes
   --  by traversing references of all the called subprograms

   procedure Generate_Report;
   --  Generate the final tool report.

   ---------------------------------------
   -- Initialization and debug routines --
   ---------------------------------------

   procedure Initialize; --  Do we need it in the spec???
   --  Initializes the data structures needed to represent the global state.

   procedure Print_Global_Structure;
   --  Prints into Stderr the debug image of the call graph

end Gnatsync.Global_Info.Data;
