gcc/ada/bindo-augmentors.adb

   1 ------------------------------------------------------------------------------
   2 --                                                                          --
   3 --                         GNAT COMPILER COMPONENTS                         --
   4 --                                                                          --
   5 --                      B I N D O . A U G M E N T O R S                     --
   6 --                                                                          --
   7 --                                 B o d y                                  --
   8 --                                                                          --
   9 --             Copyright (C) 2019-2023, Free Software Foundation, Inc.      --
  10 --                                                                          --
  11 -- GNAT is free software;  you can  redistribute it  and/or modify it under --
  12 -- terms of the  GNU General Public License as published  by the Free Soft- --
  13 -- ware  Foundation;  either version 3,  or (at your option) any later ver- --
  14 -- sion.  GNAT is distributed in the hope that it will be useful, but WITH- --
  15 -- OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY --
  16 -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  17 -- for  more details.  You should have  received  a copy of the GNU General --
  18 -- Public License  distributed with GNAT; see file COPYING3.  If not, go to --
  19 -- http://www.gnu.org/licenses for a complete copy of the license.          --
  20 --                                                                          --
  21 -- GNAT was originally developed  by the GNAT team at  New York University. --
  22 -- Extensive contributions were provided by Ada Core Technologies Inc.      --
  23 --                                                                          --
  24 ------------------------------------------------------------------------------
  25
  26 with Debug;  use Debug;
  27 with Output; use Output;
  28 with Types;  use Types;
  29
  30 with Bindo.Writers;
  31 use  Bindo.Writers;
  32 use  Bindo.Writers.Phase_Writers;
  33
  34 package body Bindo.Augmentors is
  35
  36    ------------------------------
  37    -- Library_Graph_Augmentors --
  38    ------------------------------
  39
  40    package body Library_Graph_Augmentors is
  41
  42       ----------------
  43       -- Statistics --
  44       ----------------
  45
  46       Longest_Path : Natural := 0;
  47       --  The length of the longest path found during the traversal of the
  48       --  invocation graph.
  49
  50       Total_Visited : Natural := 0;
  51       --  The number of visited invocation graph vertices during the process
  52       --  of augmentation.
  53
  54       -----------------------
  55       -- Local subprograms --
  56       -----------------------
  57
  58       procedure Visit_Elaboration_Root
  59         (Inv_Graph : Invocation_Graph;
  60          Root      : Invocation_Graph_Vertex_Id);
  61       pragma Inline (Visit_Elaboration_Root);
  62       --  Start a DFS traversal from elaboration root Root to:
  63       --
  64       --    * Detect transitions between units.
  65       --
  66       --    * Create invocation edges for each such transition where the
  67       --      successor is Root.
  68
  69       procedure Visit_Elaboration_Roots (Inv_Graph : Invocation_Graph);
  70       pragma Inline (Visit_Elaboration_Roots);
  71       --  Start a DFS traversal from all elaboration roots to:
  72       --
  73       --    * Detect transitions between units.
  74       --
  75       --    * Create invocation edges for each such transition where the
  76       --      successor is the current root.
  77
  78       procedure Visit_Vertex
  79         (Inv_Graph                  : Invocation_Graph;
  80          Invoker                    : Invocation_Graph_Vertex_Id;
  81          Last_Vertex                : Library_Graph_Vertex_Id;
  82          Root_Vertex                : Library_Graph_Vertex_Id;
  83          Visited_Invokers           : IGV_Sets.Membership_Set;
  84          Activates_Task             : Boolean;
  85          Internal_Controlled_Action : Boolean;
  86          Path                       : Natural);
  87       pragma Inline (Visit_Vertex);
  88       --  Visit invocation graph vertex Invoker to:
  89       --
  90       --    * Detect a transition from the last library graph vertex denoted by
  91       --      Last_Vertex to the library graph vertex of Invoker.
  92       --
  93       --    * Create an invocation edge in library graph Lib_Graph to reflect
  94       --      the transition, where the predecessor is the library graph vertex
  95       --      or Invoker, and the successor is Root_Vertex.
  96       --
  97       --    * Visit the neighbours of Invoker.
  98       --
  99       --  Flag Internal_Controlled_Action should be set when the DFS traversal
 100       --  visited an internal controlled invocation edge. Path is the length of
 101       --  the path.
 102
 103       procedure Write_Statistics;
 104       pragma Inline (Write_Statistics);
 105       --  Write the statistical information of the augmentation to standard
 106       --  output.
 107
 108       ---------------------------
 109       -- Augment_Library_Graph --
 110       ---------------------------
 111
 112       procedure Augment_Library_Graph (Inv_Graph : Invocation_Graph) is
 113          Lib_Graph : constant Library_Graph := Get_Lib_Graph (Inv_Graph);
 114       begin
 115          pragma Assert (Present (Lib_Graph));
 116
 117          --  Nothing to do when there is no invocation graph
 118
 119          if not Present (Inv_Graph) then
 120             return;
 121          end if;
 122
 123          Start_Phase (Library_Graph_Augmentation);
 124
 125          --  Prepare the statistics data
 126
 127          Longest_Path  := 0;
 128          Total_Visited := 0;
 129
 130          Visit_Elaboration_Roots (Inv_Graph);
 131          Write_Statistics;
 132
 133          End_Phase (Library_Graph_Augmentation);
 134       end Augment_Library_Graph;
 135
 136       ----------------------------
 137       -- Visit_Elaboration_Root --
 138       ----------------------------
 139
 140       procedure Visit_Elaboration_Root
 141         (Inv_Graph : Invocation_Graph;
 142          Root      : Invocation_Graph_Vertex_Id)
 143       is
 144          Lib_Graph : constant Library_Graph := Get_Lib_Graph (Inv_Graph);
 145          pragma Assert (Present (Inv_Graph));
 146          pragma Assert (Present (Lib_Graph));
 147          pragma Assert (Present (Root));
 148
 149          Root_Vertex : constant Library_Graph_Vertex_Id :=
 150                          Body_Vertex (Inv_Graph, Root);
 151
 152          Visited : IGV_Sets.Membership_Set;
 153
 154       begin
 155          --  Nothing to do when the unit where the elaboration root resides
 156          --  lacks elaboration code. This implies that any invocation edges
 157          --  going out of the unit are unwanted. This behavior emulates the
 158          --  old elaboration order mechanism.
 159
 160          if Has_No_Elaboration_Code (Lib_Graph, Root_Vertex) then
 161             return;
 162          end if;
 163
 164          --  Prepare the global data
 165
 166          Visited := IGV_Sets.Create (Number_Of_Vertices (Inv_Graph));
 167
 168          Visit_Vertex
 169            (Inv_Graph                  => Inv_Graph,
 170             Invoker                    => Root,
 171             Last_Vertex                => Root_Vertex,
 172             Root_Vertex                => Root_Vertex,
 173             Visited_Invokers           => Visited,
 174             Activates_Task             => False,
 175             Internal_Controlled_Action => False,
 176             Path                       => 0);
 177
 178          IGV_Sets.Destroy (Visited);
 179       end Visit_Elaboration_Root;
 180
 181       -----------------------------
 182       -- Visit_Elaboration_Roots --
 183       -----------------------------
 184
 185       procedure Visit_Elaboration_Roots (Inv_Graph : Invocation_Graph) is
 186          Lib_Graph : constant Library_Graph := Get_Lib_Graph (Inv_Graph);
 187          pragma Assert (Present (Inv_Graph));
 188          pragma Assert (Present (Lib_Graph));
 189
 190          Iter : Elaboration_Root_Iterator;
 191          Root : Invocation_Graph_Vertex_Id;
 192
 193       begin
 194          Iter := Iterate_Elaboration_Roots (Inv_Graph);
 195          while Has_Next (Iter) loop
 196             Next (Iter, Root);
 197
 198             Visit_Elaboration_Root (Inv_Graph => Inv_Graph, Root => Root);
 199          end loop;
 200       end Visit_Elaboration_Roots;
 201
 202       ------------------
 203       -- Visit_Vertex --
 204       ------------------
 205
 206       procedure Visit_Vertex
 207         (Inv_Graph                  : Invocation_Graph;
 208          Invoker                    : Invocation_Graph_Vertex_Id;
 209          Last_Vertex                : Library_Graph_Vertex_Id;
 210          Root_Vertex                : Library_Graph_Vertex_Id;
 211          Visited_Invokers           : IGV_Sets.Membership_Set;
 212          Activates_Task             : Boolean;
 213          Internal_Controlled_Action : Boolean;
 214          Path                       : Natural)
 215       is
 216          Lib_Graph : constant Library_Graph := Get_Lib_Graph (Inv_Graph);
 217
 218          New_Path : constant Natural := Path + 1;
 219
 220          Edge           : Invocation_Graph_Edge_Id;
 221          Edge_Kind      : Invocation_Kind;
 222          Invoker_Vertex : Library_Graph_Vertex_Id;
 223          Iter           : Edges_To_Targets_Iterator;
 224
 225       begin
 226          pragma Assert (Present (Inv_Graph));
 227          pragma Assert (Present (Lib_Graph));
 228          pragma Assert (Present (Invoker));
 229          pragma Assert (Present (Last_Vertex));
 230          pragma Assert (Present (Root_Vertex));
 231          pragma Assert (IGV_Sets.Present (Visited_Invokers));
 232
 233          --  Nothing to do when the current invocation graph vertex has already
 234          --  been visited.
 235
 236          if IGV_Sets.Contains (Visited_Invokers, Invoker) then
 237             return;
 238          end if;
 239
 240          IGV_Sets.Insert (Visited_Invokers, Invoker);
 241
 242          --  Update the statistics
 243
 244          Longest_Path  := Natural'Max (Longest_Path, New_Path);
 245          Total_Visited := Total_Visited + 1;
 246
 247          --  The library graph vertex of the current invocation graph vertex
 248          --  differs from that of the previous invocation graph vertex. This
 249          --  indicates that elaboration is transitioning from one unit to
 250          --  another. Add a library graph edge to capture this dependency.
 251
 252          Invoker_Vertex := Body_Vertex (Inv_Graph, Invoker);
 253          pragma Assert (Present (Invoker_Vertex));
 254
 255          if Invoker_Vertex /= Last_Vertex then
 256
 257             --  The path ultimately reaches back into the unit where the root
 258             --  resides, resulting in a self dependency. In most cases this is
 259             --  a valid circularity, except when the path went through one of
 260             --  the Deep_xxx finalization-related routines. Do not create a
 261             --  library graph edge because the circularity is the result of
 262             --  expansion and thus spurious.
 263
 264             if Invoker_Vertex = Root_Vertex
 265               and then Internal_Controlled_Action
 266             then
 267                null;
 268
 269             --  Otherwise create the library graph edge, even if this results
 270             --  in a self dependency.
 271
 272             else
 273                Add_Edge
 274                  (G              => Lib_Graph,
 275                   Pred           => Invoker_Vertex,
 276                   Succ           => Root_Vertex,
 277                   Kind           => Invocation_Edge,
 278                   Activates_Task => Activates_Task);
 279             end if;
 280          end if;
 281
 282          --  Extend the DFS traversal to all targets of the invocation graph
 283          --  vertex.
 284
 285          Iter := Iterate_Edges_To_Targets (Inv_Graph, Invoker);
 286          while Has_Next (Iter) loop
 287             Next (Iter, Edge);
 288             Edge_Kind := Kind (Inv_Graph, Edge);
 289
 290             Visit_Vertex
 291               (Inv_Graph                  => Inv_Graph,
 292                Invoker                    => Target (Inv_Graph, Edge),
 293                Last_Vertex                => Invoker_Vertex,
 294                Root_Vertex                => Root_Vertex,
 295                Visited_Invokers           => Visited_Invokers,
 296                Activates_Task             =>
 297                  Activates_Task
 298                    or else Edge_Kind = Task_Activation,
 299                Internal_Controlled_Action =>
 300                  Internal_Controlled_Action
 301                    or else Edge_Kind in Internal_Controlled_Invocation_Kind,
 302                Path                       => New_Path);
 303          end loop;
 304       end Visit_Vertex;
 305
 306       ----------------------
 307       -- Write_Statistics --
 308       ----------------------
 309
 310       procedure Write_Statistics is
 311       begin
 312          --  Nothing to do when switch -d_L (output library item graph) is not
 313          --  in effect.
 314
 315          if not Debug_Flag_Underscore_LL then
 316             return;
 317          end if;
 318
 319          Write_Str ("Library Graph Augmentation");
 320          Write_Eol;
 321          Write_Eol;
 322
 323          Write_Str ("Vertices visited   : ");
 324          Write_Num (Int (Total_Visited));
 325          Write_Eol;
 326
 327          Write_Str ("Longest path length: ");
 328          Write_Num (Int (Longest_Path));
 329          Write_Eol;
 330          Write_Eol;
 331
 332          Write_Str ("Library Graph Augmentation end");
 333          Write_Eol;
 334          Write_Eol;
 335       end Write_Statistics;
 336    end Library_Graph_Augmentors;
 337
 338 end Bindo.Augmentors;