asis_2019.0.0_3ca32fa2/tools/tool_utils/asis_ul-global_state.ads

------------------------------------------------------------------------------
--                                                                          --
--                  COMMON ASIS TOOLS COMPONENTS LIBRARY                    --
--                                                                          --
--                 A S I S _ U L . G L O B A L _ S T A T E
--                                                                          --
--                                 S p e c                                  --
--                                                                          --
--                     Copyright (C) 2007-2018, AdaCore                     --
--                                                                          --
-- Asis Utility Library (ASIS UL) 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.  ASIS UL  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.                         --
--                                                                          --
-- ASIS UL is maintained by AdaCore (http://www.adacore.com).               --
--                                                                          --
------------------------------------------------------------------------------

--  This package defines the top of the subhierarchy describing the global
--  state of the set of sources being analyzed.

pragma Ada_2012;

with Ada.Containers.Ordered_Sets;

with Asis;                    use Asis;
with Asis.Extensions.Strings; use Asis.Extensions.Strings;

with Types;                   use Types;

with ASIS_UL.Source_Table;    use ASIS_UL.Source_Table;

package ASIS_UL.Global_State is

   --  The global state is represented as a single set of nodes representing
   --  entities  of different kinds. The global structure represents various
   --  relations between the corresponding entities. Depending on the following
   --  flags, it may contain this or that information.

   ---------------------
   --  Global options --
   ---------------------

   function Compute_Global_Objects_Accessed return Boolean;

   procedure Do_Compute_Global_Objects_Accessed;
   --  Set an internal flag to compute global objects accessed directly or
   --  indirectly by subprograms

   ----------------------------------
   --  Global structure node kinds --
   ----------------------------------

   type GS_Node_Kinds is
     (Not_A_Node,
      --  A null (absent or non-inialized) node

      --  Callable nodes
      Environment_Task,
      A_Package,
      A_Procedure,
      A_Null_Procedure,
      A_Type_Discr_Init_Procedure,
      A_Type_Init_Procedure,
      A_Function,
      A_Task,
      A_Task_Entry,
      A_Protected_Procedure,
      A_Protected_Function,
      A_Protected_Entry,

      --  Data nodes
      A_Data_Object

      --  To be continued???
      );

   --  Nodes for which there all variable declarations should be considered
   --  as global
   subtype Global_Nodes is GS_Node_Kinds range
     Environment_Task .. A_Package;
   subtype Callable_Nodes is GS_Node_Kinds range
     Environment_Task .. A_Protected_Entry;

   subtype Subprogram_Nodes is Callable_Nodes range A_Procedure .. A_Function;
   subtype Protected_Subprogram_Nodes is Callable_Nodes range
     A_Protected_Procedure .. A_Protected_Function;

   ------------------------------------------
   -- Callable entities and the call graph --
   ------------------------------------------

   --  The call graph consists of callable entities and caller-to-callee
   --  relations among them. The call graph gives a static and "flat" picture,
   --  it is not suitable for analysing properties specific for asynchronous
   --  processes. The call graph contains the following nodes:
   --
   --    Environment_Task
   --       This node represents an environment task, the call graph contains
   --       exactly one node of this kind. Environment task calls all the
   --       library level tasks, and it also calls the main subprogram if the
   --       main subprogram is specified. It also calls all the subprograms
   --       that that are called when from the elaboration of library packages.
   --       Nobody can call this node. This node represents the most global
   --       (library-level) scope.
   --
   --    A_Procedure
   --    A_Function
   --       Represent subprograms and subprogram instantiations. A subprogram
   --       is an entity declared by a subprogram declaration, subprogram body
   --       declaration or subprogram body stub in case there is no separate
   --       spec provided for the given subprogram. Subprogram renamings that
   --       are renamings as declarations are not counted for the call graph.
   --       In case of renaming as a body, if renaming can be resolved
   --       statically, this situation is considered as if the given subprogram
   --       calls the entity being renamed.
   --
   --    A_Null_Procedure
   --       Represents a null procedure (Ada 2005). The reason to define a
   --       separate kind for null procedures is that for these procedures it
   --       is known in advance that they do not have any code and they cannot
   --       call, access or update anything.
   --
   --    A_Task
   --       Represents a task that is viewed not as an asynchronous process,
   --       but as a procedure. That is, creation of a task is considered as
   --       a call to a procedure, where the task body is viewed as the body
   --       of the called procedure (in other words, we do not make the
   --       difference between "to call a process" and "to start a process").
   --       ??? Needs better documentation
   --
   --    A_Task_Entry
   --       The call graph considers a task entry call as a procedure call. The
   --       body of this "procedure" is a code of all the accept statements
   --       corresponding to this entry. Enclosing scope for a task entry is
   --       the task entity the entry belongs to.
   --
   --    A_Protected_Procedure
   --    A_Protected_Function
   --       We make the difference between "normal" subprograms and protected
   --       subprograms
   --
   --    A_Protected_Entry
   --       Similar to A_Task_Entry, but for protected entry we have the
   --       entry body instead of a set of accept statements code, and there
   --       is no "parent" reference here (the call graph does not contain
   --       any information about protected types and objects as whole
   --       entities)

   -------------------
   -- Data entities --
   -------------------

   --  To be documented...

   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 from callable entities to data entities
     (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;

   ------------
   -- Scopes --
   ------------

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

   Scope_Stack_Error : exception;

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

   --  The global data structure keeps links between nodes. All links are
   --  ordered, that is, a link goes from node A to node B, each link is stored
   --  for the node it goes from (that is, for A). There are two kinds of
   --  links - links that keep SLOCs of the place in the code that is a reason
   --  to store this link as a part of the global structure (such as a location
   --  of a subprogram call or a location of the reference to a data object),
   --  and links that keep only the nodes to which the link goes to, such
   --  links are used to represent such information as a list of all the
   --  entities called by a given subprogram, directly or indirectly, or a list
   --  of all the (global) data objects referenced by a given subprograms,
   --  directly or indirectly. If a link represent some indirect relation,
   --  there is no sense to keep a SLOC information for it. Keeping SLOCs for
   --  direct links allows to generate useful (back)trace information.

   --  The data structure keeps only one link for each event such as a call
   --  or a reference (that is, if a procedure A calls the procedure B many
   --  times (there are many procedure call statements targeted to B in the
   --  code of A), the node that represents A keeps only one link from A to B).
   --  Usually the SLOC stored as a part of this link corresponds to the
   --  (textually) first occurence of this event in the code.

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

   subtype Link is GS_Node_Id;

   ----------------------------
   -- Storage for node links --
   ----------------------------

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

   package SLOC_Node_Lists is new Ada.Containers.Ordered_Sets
     (Element_Type => SLOC_Link);
   --  Represents ordered sets of node links. Each link from this set contains
   --  a SLOC of the place from which this link originates

   package Node_Lists is new Ada.Containers.Ordered_Sets
     (Element_Type => Link);
   --  Represents ordered sets of node links (with no SLOC information)

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

   type SLOC_Node_List_Access is access SLOC_Node_Lists.Set;
   type Node_List_Access is access Node_Lists.Set;
   --  We need these access types to get node lists that represents call chains
   --  or other similar information for nodes in global structure

   --------------------------------------------------------
   -- General global structure entities/nodes properties --
   --------------------------------------------------------

   function Present (N : GS_Node_Id) return Boolean;
   function No      (N : GS_Node_Id) return Boolean;
   --  Check if the argument represents a nonexistent node

   function Last_Node return GS_Node_Id;
   --  Returtns the last node stored in the global state.

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

   function Is_Callable_Node (N : GS_Node_Id) return Boolean;
   --  Checks if N represents a callable entity

   function Is_Subprogram_Node (N : GS_Node_Id) return Boolean;
   --  Checks if N represents a subprogram or a protected subprogram.

   function Is_Dispatching_Operation_Node (N : GS_Node_Id) return Boolean;
   --  Checks if N represents a dispatching operation. Accepts nodes that do
   --  not represent subprograms and returns False for them

   function Is_Abstract_Subprogram_Node (N : GS_Node_Id) return Boolean;
   --  Checks if N represents an abstract subprogram. Accepts nodes that do
   --  not represent subprograms and returns False for them

   function Is_Implicit_Subprogram_Node (N : GS_Node_Id) return Boolean;
   --  Checks if N represents an impilictly defined inherited subprogram.
   --  Accepts nodes that do not represent subprograms and returns False for
   --  them

   function GS_Node_SLOC (N : GS_Node_Id) return String_Loc;
   --  Returns the Source LOCation of the Ada construct the Node originated
   --  from. Returns Nil_String_Loc for Environment_Task node and in case when
   --  No (N)

   function GS_Node_Name (N : GS_Node_Id) return String;
   --  Retirns the name of the entity denoted by N. In case of expanded
   --  defining name the full expandsed name is returned
   --  ??? Should this function return Wide_String???

   function GS_Enclosed_CU_Name (N : GS_Node_Id) return String;
   --  Returns the name of the Compilation Unit that encloses the entity
   --  denoted by N;
   --  ??? Should this function return Wide_String???

   function GS_Node_Enclosing_Scope (N : GS_Node_Id) return Scope_Id;
   --  Returns the node that is a scope for the argument node. Returns
   --  No_GS_Node for Environment_Task node. Returns No_Scope if No (N).

   function GS_Node_Scope_Level (N : GS_Node_Id) return Natural;
   --  Returns the scope level. Node scope level is the nesting level of the
   --  scope the entity represented by the node belongs to (if the node itself
   --  is a scope, it is considered as belonging to itself). Environment_Task
   --  node has a scope level 1. Raises Constraint_Error is No (N)
   --  ??? See the documentation of Scope_Level field of the GS_Node_Record
   --  type. Needs to be cleaned up.

   function Is_RTL_Node (N : GS_Node_Id) return Boolean;
   --  Checks if the argument node represents an entity from some RTL unit.
   --  Raises Constraint_Error is No (N).

   function Is_Of_No_Interest (N : GS_Node_Id) return Boolean;
   --  Returns True if we are 100% sure that the given node cannot be of any
   --  interest for any analysis that can be performed on the global program
   --  structure. Raises Constraint_Error is No (N).

   function Enclosing_Source (N : GS_Node_Id) return SF_Id;
   --  Returns the ID of the source file the node has been extracted from.
   --  Returns No_SF_Id for Environment_Task. Raises Constraint_Error if
   --  No (N).

   function  Get_Application_Flag_1 (N : GS_Node_Id) return Boolean;
   procedure Set_Application_Flag_1 (N : GS_Node_Id; Val : Boolean);

   function Direct_Calls (N : GS_Node_Id) return SLOC_Node_List_Access;
   function All_Calls (N : GS_Node_Id) return Node_List_Access;
   --  Assuming that Is_Callable_Node (N), return (pointer to) the list of
   --  direct or all calls

   function Direct_Reads (N : GS_Node_Id) return SLOC_Node_List_Access;
   function Direct_Writes (N : GS_Node_Id) return SLOC_Node_List_Access;
   function Indirect_Reads (N : GS_Node_Id) return Node_List_Access;
   function Indirect_Writes (N : GS_Node_Id) return Node_List_Access;
   --  Assuming that Is_Callable_Node (N), return (pointer to) the list of
   --  direct or indirect reads or writes

   ---------------------------------------
   -- General global structure routines --
   ---------------------------------------

   procedure Initialize;
   --  Initializes the data structures needed to represent the global state.

   function Corresponding_Node
     (El              : Element;
      Enclosing_Scope : Scope_Id      := No_Scope;
      Expected_Kind   : GS_Node_Kinds := Not_A_Node;
      Unconditionally : Boolean       := False)
      return            GS_Node_Id;
   --  Returns the Id of the global structure node corresponding to El. If this
   --  El has not been added to the global structure yet, creates the
   --  corresponding node and returns it as the result. If set to non-empty
   --  value, Enclosing_Scope parameter is used to specify the enclosing scope
   --  for the node to be created.
   --
   --  If Expected_Kind is set to some value different from Not_A_Node, then
   --  this procedure looks for/creates the node of the specified kind.
   --
   --  Call to this function may result in creating more than one node in the
   --  global structure. For example, in the call graph, when creating a node
   --  for a callable entity, this function needs to set its scope link, and if
   --  the scope node does not exist, it is created, and the scope's scope
   --  node, and so on. For a type initialization routine it computes all the
   --  calls issued by this routine and creates the corresponding nodes and
   --  links in the call graph.
   --
   --  Creation of the new node may result in adding a new source file in the
   --  source files table (as a needed source). It may be the case when a call
   --  to this function adds more than one needed source (in case we create
   --  a node for some callable entity defined in a proper body of a subunit,
   --  then creation of the corresponding node may result in adding as a needed
   --  source the source for the body where the stub is located and the source
   --  of the corresponding spec).

   --------------------
   -- Debug routines --
   --------------------

   procedure Print_Global_Structure;
   --  Generates into Stderr the debug output for global data structure
   --  if the corresponding debug flag is ON (or if ASIS_UL.Options.Debug_Mode
   --  is ON, but we have to get rid of this flag), otherwise does nothing.

   procedure Print_Node (N : GS_Node_Id);
   --  Outputs into Stderr the debug information about the argument node N.
   --  format of the output

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

private

   --  The entities below are needed only for the implementation of the
   --  global data structure.

   procedure Add_SLOC_Node_List_To_Node_List
     (Target : in out 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 Target
   --  does not have SLOCs (SLOCs parts from the elements of SOURCE are
   --  abandoned)

   -----------------------------------------------------
   --  General structure of the global structure node --
   -----------------------------------------------------

   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 : String_Loc;
      --  Name of the entity represented by the node

      Source_File : SF_Id;
      --  Source file the given node belongs to.

      Enclosing_Scope : Scope_Id;

      Scope_Level : Natural;
      --  For a scope node, represents the nesting level of the scope.
      --  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.

      Is_RTL_Node : Boolean;
      --  Indicates if the given node represents an entity defined in RTL.

      Is_Of_No_Interest : Boolean;
      --  Indicates if the node is of no interest for further analysis because
      --  of any reason. For example, a node represents a function that is an
      --  enumeration literal renaming - such function cannot call anything and
      --  it cannot refer to any data object

      --------------------------------------------------------------
      -- The meaning of the following fields depends on node kind --
      --------------------------------------------------------------

      Bool_Flag_1 : Boolean;
      --  Callable_Node -> Is_Body_Analyzed;
      --  Data_Node     -> ???

      Bool_Flag_2 : Boolean;
      --  Callable_Node -> Is_Renaming;
      --  Data_Node     -> ???

      Bool_Flag_3 : Boolean;
      --  Callable_Node ->
      --     A_Task              A_Task -> Is_Task_Type
      --     other callable nodes -> ???
      --  Data_Node     -> ???

      Bool_Flag_4 : Boolean;
      --  Callable_Node -> Is_Dispatching_Operation_Node;
      --  Data_Node     -> ???

      Bool_Flag_5 : Boolean;
      --  Callable_Node -> Is_Abstract_Subprogram_Node;
      --  Data_Node     -> ???

      Bool_Flag_6 : Boolean;
      --  Callable_Node -> Is_Implicit_Subprogram_Node;
      --  Data_Node     -> ???

      Bool_Flag_7 : Boolean;
      --  Callable_Node -> Is the missing body reported;
      --  Data_Node     -> ???

      Application_Flag_1 : Boolean;
      --  The usage of this flag is up to an application implemented on top of
      --  this call graph structure.

      SLOC_Node_List_1 : SLOC_Node_Lists.Set;
      --  Callable_Node -> Direct_Calls;
      --  Data_Node     -> ???

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

      SLOC_Node_List_3 : SLOC_Node_Lists.Set;
      --  For a callable node - references to global objects directly written
      --  by the callable entity.
      --  For a data node - list of all the callable entities that directly
      --  write the data entity.

      Dispatching_Calls : SLOC_Node_Lists.Set;
      --  For a callable node - if Skip_Dispatching_Calls is ON, dispatching
      --  calls are stored here instead of SLOC_Node_List_1, then a tool
      --  can do transitive closure without taking into account dispatching
      --  calls, analyze the result, then copy stored dispatching calls
      --  into SLOC_Node_List_1 and do transitive closure again.
      --
      --  For a data node - not used

      Node_List_1 : Node_Lists.Set;
      --  Callable_Node -> All_Calls;
      --  Data_Node     -> ???

      Node_List_2 : Node_Lists.Set;
      --  Callable_Node ->
      --    Direct dispatching calls
      --  Data_Node     -> ???

      Node_List_3 : Node_Lists.Set;
      --  Callable_Node ->
      --    Is_Dispatching_Operation_Node ->
      --       Directly implementing subprograms
      --  Data_Node     -> ???

      Node_List_4 : Node_Lists.Set;
      --  Callable_Node ->
      --    Is_Dispatching_Operation_Node ->
      --       All implementing subprograms  ???
      --  Data_Node     -> ???

      Node_List_5 : Node_Lists.Set;
      --  For a callable node - references to global objects indirectly read by
      --  the callable entity.
      --  For a data node - list of all the callable entities that indirectly
      --  read the data entity.

      Node_List_6 : Node_Lists.Set;
      --  For a callable node - references to global objects indirectly written
      --  by the callable entity.
      --  For a data node - list of all the callable entities that indirectly
      --  write the data entity.

   end record;

   --------------------------------
   -- Access and update routines --
   --------------------------------

   type SLOC_Link_List_Types is
     (Calls,
      Dispatching_Calls,
      Direct_Read_References,
      Direct_Write_References,
      Indirect_Read_References,
      Indirect_Write_References
      --  To be continued...
     );
   --  Used to identify a list to operate with

   procedure Add_Link_To_SLOC_List
     (To_Node     : GS_Node_Id;
      Link_To_Add : SLOC_Link;
      To_List     : SLOC_Link_List_Types := Calls);
   --  Adds new link to the list pointed by To_List parameter of To_Node. If a
   --  link with the node from the argument link is already in the list,
   --  does nothing.

   type GS_Node_Record_Access is access GS_Node_Record;

   function Table (N : GS_Node_Id) return GS_Node_Record_Access;
   --  Mimics the notation Instantce_Name.Table (N) in the instantiation of the
   --  GNAT Table package. Returns the (pointer to the )Node with the index N
   --  from GS_Nodes_Table (see the body of the package). Raises
   --  Constraint_Error if a node with this index does not exsist.

   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.

   --  Low-level procedures for setting fields tha are specific for
   --  node kind:
   procedure Set_Bool_Flag_1 (N : GS_Node_Id; Val : Boolean);
   procedure Set_Bool_Flag_2 (N : GS_Node_Id; Val : Boolean);
   procedure Set_Bool_Flag_3 (N : GS_Node_Id; Val : Boolean);
   procedure Set_Bool_Flag_4 (N : GS_Node_Id; Val : Boolean);
   procedure Set_Bool_Flag_5 (N : GS_Node_Id; Val : Boolean);
   procedure Set_Bool_Flag_6 (N : GS_Node_Id; Val : Boolean);
   procedure Set_Bool_Flag_7 (N : GS_Node_Id; Val : Boolean);

end ASIS_UL.Global_State;