771 lines
25 KiB
Ada
771 lines
25 KiB
Ada
------------------------------------------------------------------------------
|
|
-- --
|
|
-- GNAT COMPILER COMPONENTS --
|
|
-- --
|
|
-- B I N D O . B U I L D E R S --
|
|
-- --
|
|
-- B o d y --
|
|
-- --
|
|
-- Copyright (C) 2019-2022, Free Software Foundation, Inc. --
|
|
-- --
|
|
-- GNAT is free software; you can redistribute it and/or modify it under --
|
|
-- terms of the GNU General Public License as published by the Free Soft- --
|
|
-- ware Foundation; either version 3, or (at your option) any later ver- --
|
|
-- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
|
|
-- OUT 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 COPYING3. If not, go to --
|
|
-- http://www.gnu.org/licenses for a complete copy of the license. --
|
|
-- --
|
|
-- GNAT was originally developed by the GNAT team at New York University. --
|
|
-- Extensive contributions were provided by Ada Core Technologies Inc. --
|
|
-- --
|
|
------------------------------------------------------------------------------
|
|
|
|
with Binderr; use Binderr;
|
|
with Butil; use Butil;
|
|
with Debug; use Debug;
|
|
with Opt; use Opt;
|
|
with Output; use Output;
|
|
with Types; use Types;
|
|
|
|
with Bindo.Units; use Bindo.Units;
|
|
|
|
with Bindo.Validators;
|
|
use Bindo.Validators;
|
|
use Bindo.Validators.Invocation_Graph_Validators;
|
|
use Bindo.Validators.Library_Graph_Validators;
|
|
|
|
with Bindo.Writers;
|
|
use Bindo.Writers;
|
|
use Bindo.Writers.Phase_Writers;
|
|
|
|
with GNAT; use GNAT;
|
|
with GNAT.Dynamic_HTables; use GNAT.Dynamic_HTables;
|
|
|
|
package body Bindo.Builders is
|
|
|
|
-------------------------------
|
|
-- Invocation_Graph_Builders --
|
|
-------------------------------
|
|
|
|
package body Invocation_Graph_Builders is
|
|
|
|
-----------------
|
|
-- Global data --
|
|
-----------------
|
|
|
|
Inv_Graph : Invocation_Graph := Invocation_Graphs.Nil;
|
|
Lib_Graph : Library_Graph := Library_Graphs.Nil;
|
|
|
|
-----------------------
|
|
-- Local subprograms --
|
|
-----------------------
|
|
|
|
procedure Create_Edge (IR_Id : Invocation_Relation_Id);
|
|
pragma Inline (Create_Edge);
|
|
-- Create a new edge for invocation relation IR_Id in invocation graph
|
|
-- Inv_Graph.
|
|
|
|
procedure Create_Edges (U_Id : Unit_Id);
|
|
pragma Inline (Create_Edges);
|
|
-- Create new edges for all invocation relations of unit U_Id
|
|
|
|
procedure Create_Vertex
|
|
(IC_Id : Invocation_Construct_Id;
|
|
Vertex : Library_Graph_Vertex_Id);
|
|
pragma Inline (Create_Vertex);
|
|
-- Create a new vertex for invocation construct IC_Id in invocation
|
|
-- graph Inv_Graph. The vertex is linked to vertex Vertex of library
|
|
-- graph Lib_Graph.
|
|
|
|
procedure Create_Vertices (U_Id : Unit_Id);
|
|
pragma Inline (Create_Vertices);
|
|
-- Create new vertices for all invocation constructs of unit U_Id in
|
|
-- invocation graph Inv_Graph.
|
|
|
|
function Declaration_Placement_Vertex
|
|
(Vertex : Library_Graph_Vertex_Id;
|
|
Placement : Declaration_Placement_Kind)
|
|
return Library_Graph_Vertex_Id;
|
|
pragma Inline (Declaration_Placement_Vertex);
|
|
-- Obtain the spec or body of vertex Vertex depending on the requested
|
|
-- placement in Placement.
|
|
|
|
----------------------------
|
|
-- Build_Invocation_Graph --
|
|
----------------------------
|
|
|
|
function Build_Invocation_Graph
|
|
(Lib_G : Library_Graph) return Invocation_Graph
|
|
is
|
|
begin
|
|
pragma Assert (Present (Lib_G));
|
|
|
|
Start_Phase (Invocation_Graph_Construction);
|
|
|
|
-- Prepare the global data
|
|
|
|
Inv_Graph :=
|
|
Create
|
|
(Initial_Vertices => Number_Of_Elaborable_Units,
|
|
Initial_Edges => Number_Of_Elaborable_Units,
|
|
Lib_Graph => Lib_G);
|
|
Lib_Graph := Lib_G;
|
|
|
|
For_Each_Elaborable_Unit (Create_Vertices'Access);
|
|
For_Each_Elaborable_Unit (Create_Edges'Access);
|
|
|
|
Validate_Invocation_Graph (Inv_Graph);
|
|
End_Phase (Invocation_Graph_Construction);
|
|
|
|
return Inv_Graph;
|
|
end Build_Invocation_Graph;
|
|
|
|
-----------------
|
|
-- Create_Edge --
|
|
-----------------
|
|
|
|
procedure Create_Edge (IR_Id : Invocation_Relation_Id) is
|
|
pragma Assert (Present (Inv_Graph));
|
|
pragma Assert (Present (Lib_Graph));
|
|
pragma Assert (Present (IR_Id));
|
|
|
|
Invoker_Sig : constant Invocation_Signature_Id := Invoker (IR_Id);
|
|
Target_Sig : constant Invocation_Signature_Id := Target (IR_Id);
|
|
|
|
pragma Assert (Present (Invoker_Sig));
|
|
pragma Assert (Present (Target_Sig));
|
|
|
|
begin
|
|
-- Nothing to do when the target denotes an invocation construct that
|
|
-- resides in a unit which will never be elaborated.
|
|
|
|
if not Needs_Elaboration (Target_Sig) then
|
|
return;
|
|
end if;
|
|
|
|
Add_Edge
|
|
(G => Inv_Graph,
|
|
Source => Corresponding_Vertex (Inv_Graph, Invoker_Sig),
|
|
Target => Corresponding_Vertex (Inv_Graph, Target_Sig),
|
|
IR_Id => IR_Id);
|
|
end Create_Edge;
|
|
|
|
------------------
|
|
-- Create_Edges --
|
|
------------------
|
|
|
|
procedure Create_Edges (U_Id : Unit_Id) is
|
|
pragma Assert (Present (Inv_Graph));
|
|
pragma Assert (Present (Lib_Graph));
|
|
pragma Assert (Present (U_Id));
|
|
|
|
U_Rec : Unit_Record renames ALI.Units.Table (U_Id);
|
|
|
|
begin
|
|
for IR_Id in U_Rec.First_Invocation_Relation ..
|
|
U_Rec.Last_Invocation_Relation
|
|
loop
|
|
Create_Edge (IR_Id);
|
|
end loop;
|
|
end Create_Edges;
|
|
|
|
-------------------
|
|
-- Create_Vertex --
|
|
-------------------
|
|
|
|
procedure Create_Vertex
|
|
(IC_Id : Invocation_Construct_Id;
|
|
Vertex : Library_Graph_Vertex_Id)
|
|
is
|
|
begin
|
|
pragma Assert (Present (Inv_Graph));
|
|
pragma Assert (Present (Lib_Graph));
|
|
pragma Assert (Present (IC_Id));
|
|
pragma Assert (Present (Vertex));
|
|
|
|
Add_Vertex
|
|
(G => Inv_Graph,
|
|
IC_Id => IC_Id,
|
|
Body_Vertex =>
|
|
Declaration_Placement_Vertex
|
|
(Vertex => Vertex,
|
|
Placement => Body_Placement (IC_Id)),
|
|
Spec_Vertex =>
|
|
Declaration_Placement_Vertex
|
|
(Vertex => Vertex,
|
|
Placement => Spec_Placement (IC_Id)));
|
|
end Create_Vertex;
|
|
|
|
---------------------
|
|
-- Create_Vertices --
|
|
---------------------
|
|
|
|
procedure Create_Vertices (U_Id : Unit_Id) is
|
|
pragma Assert (Present (Inv_Graph));
|
|
pragma Assert (Present (Lib_Graph));
|
|
pragma Assert (Present (U_Id));
|
|
|
|
U_Rec : Unit_Record renames ALI.Units.Table (U_Id);
|
|
Vertex : constant Library_Graph_Vertex_Id :=
|
|
Corresponding_Vertex (Lib_Graph, U_Id);
|
|
|
|
begin
|
|
for IC_Id in U_Rec.First_Invocation_Construct ..
|
|
U_Rec.Last_Invocation_Construct
|
|
loop
|
|
Create_Vertex (IC_Id, Vertex);
|
|
end loop;
|
|
end Create_Vertices;
|
|
|
|
----------------------------------
|
|
-- Declaration_Placement_Vertex --
|
|
----------------------------------
|
|
|
|
function Declaration_Placement_Vertex
|
|
(Vertex : Library_Graph_Vertex_Id;
|
|
Placement : Declaration_Placement_Kind)
|
|
return Library_Graph_Vertex_Id
|
|
is
|
|
begin
|
|
pragma Assert (Present (Lib_Graph));
|
|
pragma Assert (Present (Vertex));
|
|
|
|
if Placement = In_Body then
|
|
return Proper_Body (Lib_Graph, Vertex);
|
|
else
|
|
pragma Assert (Placement = In_Spec);
|
|
return Proper_Spec (Lib_Graph, Vertex);
|
|
end if;
|
|
end Declaration_Placement_Vertex;
|
|
end Invocation_Graph_Builders;
|
|
|
|
----------------------------
|
|
-- Library_Graph_Builders --
|
|
----------------------------
|
|
|
|
package body Library_Graph_Builders is
|
|
|
|
---------------------
|
|
-- Data structures --
|
|
---------------------
|
|
|
|
procedure Destroy_Line_Number (Line : in out Logical_Line_Number);
|
|
pragma Inline (Destroy_Line_Number);
|
|
-- Destroy line number Line
|
|
|
|
function Hash_Unit (U_Id : Unit_Id) return Bucket_Range_Type;
|
|
pragma Inline (Hash_Unit);
|
|
-- Obtain the hash value of key U_Id
|
|
|
|
package Unit_Line_Tables is new Dynamic_Hash_Tables
|
|
(Key_Type => Unit_Id,
|
|
Value_Type => Logical_Line_Number,
|
|
No_Value => No_Line_Number,
|
|
Expansion_Threshold => 1.5,
|
|
Expansion_Factor => 2,
|
|
Compression_Threshold => 0.3,
|
|
Compression_Factor => 2,
|
|
"=" => "=",
|
|
Destroy_Value => Destroy_Line_Number,
|
|
Hash => Hash_Unit);
|
|
|
|
-----------------
|
|
-- Global data --
|
|
-----------------
|
|
|
|
Lib_Graph : Library_Graph := Library_Graphs.Nil;
|
|
|
|
Unit_To_Line : Unit_Line_Tables.Dynamic_Hash_Table :=
|
|
Unit_Line_Tables.Nil;
|
|
-- The map of unit name -> line number, used to detect duplicate unit
|
|
-- names in the forced-elaboration-order file and report errors.
|
|
|
|
-----------------------
|
|
-- Local subprograms --
|
|
-----------------------
|
|
|
|
procedure Add_Unit
|
|
(U_Id : Unit_Id;
|
|
Line : Logical_Line_Number);
|
|
pragma Inline (Add_Unit);
|
|
-- Create a relationship between unit U_Id and its declaration line in
|
|
-- map Unit_To_Line.
|
|
|
|
procedure Create_Forced_Edge
|
|
(Pred : Unit_Id;
|
|
Succ : Unit_Id);
|
|
pragma Inline (Create_Forced_Edge);
|
|
-- Create a new forced edge between predecessor unit Pred and successor
|
|
-- unit Succ.
|
|
|
|
procedure Create_Forced_Edges;
|
|
pragma Inline (Create_Forced_Edges);
|
|
-- Inspect the contents of the forced-elaboration-order file, and create
|
|
-- specialized edges for each valid pair of units listed within.
|
|
|
|
procedure Create_Spec_And_Body_Edge (U_Id : Unit_Id);
|
|
pragma Inline (Create_Spec_And_Body_Edge);
|
|
-- Establish a link between the spec and body of unit U_Id. In certain
|
|
-- cases this may result in a new edge which is added to library graph
|
|
-- Lib_Graph.
|
|
|
|
procedure Create_Vertex (U_Id : Unit_Id);
|
|
pragma Inline (Create_Vertex);
|
|
-- Create a new vertex for unit U_Id in library graph Lib_Graph
|
|
|
|
procedure Create_With_Edge
|
|
(W_Id : With_Id;
|
|
Succ : Library_Graph_Vertex_Id);
|
|
pragma Inline (Create_With_Edge);
|
|
-- Create a new edge for with W_Id where the predecessor is the library
|
|
-- graph vertex of the withed unit, and the successor is Succ. The edge
|
|
-- is added to library graph Lib_Graph.
|
|
|
|
procedure Create_With_Edges (U_Id : Unit_Id);
|
|
pragma Inline (Create_With_Edges);
|
|
-- Establish links between unit U_Id and its predecessor units. The new
|
|
-- edges are added to library graph Lib_Graph.
|
|
|
|
procedure Create_With_Edges
|
|
(U_Id : Unit_Id;
|
|
Succ : Library_Graph_Vertex_Id);
|
|
pragma Inline (Create_With_Edges);
|
|
-- Create new edges for all withs of unit U_Id where the predecessor is
|
|
-- some withed unit, and the successor is Succ. The edges are added to
|
|
-- library graph Lib_Graph.
|
|
|
|
procedure Duplicate_Unit_Error
|
|
(U_Id : Unit_Id;
|
|
Nam : Unit_Name_Type;
|
|
Line : Logical_Line_Number);
|
|
pragma Inline (Duplicate_Unit_Error);
|
|
-- Emit an error concerning the duplication of unit U_Id with name Nam
|
|
-- that is redeclared in the forced-elaboration-order file at line Line.
|
|
|
|
procedure Internal_Unit_Info (Nam : Unit_Name_Type);
|
|
pragma Inline (Internal_Unit_Info);
|
|
-- Emit an information message concerning the omission of an internal
|
|
-- unit with name Nam from the creation of forced edges.
|
|
|
|
function Is_Duplicate_Unit (U_Id : Unit_Id) return Boolean;
|
|
pragma Inline (Is_Duplicate_Unit);
|
|
-- Determine whether unit U_Id is already recorded in map Unit_To_Line
|
|
|
|
function Is_Significant_With (W_Id : With_Id) return Boolean;
|
|
pragma Inline (Is_Significant_With);
|
|
-- Determine whether with W_Id plays a significant role in elaboration
|
|
|
|
procedure Missing_Unit_Info (Nam : Unit_Name_Type);
|
|
pragma Inline (Missing_Unit_Info);
|
|
-- Emit an information message concerning the omission of an undefined
|
|
-- unit found in the forced-elaboration-order file.
|
|
|
|
--------------
|
|
-- Add_Unit --
|
|
--------------
|
|
|
|
procedure Add_Unit
|
|
(U_Id : Unit_Id;
|
|
Line : Logical_Line_Number)
|
|
is
|
|
begin
|
|
pragma Assert (Present (U_Id));
|
|
|
|
Unit_Line_Tables.Put (Unit_To_Line, U_Id, Line);
|
|
end Add_Unit;
|
|
|
|
-------------------------
|
|
-- Build_Library_Graph --
|
|
-------------------------
|
|
|
|
function Build_Library_Graph return Library_Graph is
|
|
begin
|
|
Start_Phase (Library_Graph_Construction);
|
|
|
|
-- Prepare the global data
|
|
|
|
Lib_Graph :=
|
|
Create
|
|
(Initial_Vertices => Number_Of_Elaborable_Units,
|
|
Initial_Edges => Number_Of_Elaborable_Units);
|
|
|
|
For_Each_Elaborable_Unit (Create_Vertex'Access);
|
|
For_Each_Elaborable_Unit (Create_Spec_And_Body_Edge'Access);
|
|
For_Each_Elaborable_Unit (Create_With_Edges'Access);
|
|
Create_Forced_Edges;
|
|
|
|
Validate_Library_Graph (Lib_Graph);
|
|
End_Phase (Library_Graph_Construction);
|
|
|
|
return Lib_Graph;
|
|
end Build_Library_Graph;
|
|
|
|
------------------------
|
|
-- Create_Forced_Edge --
|
|
------------------------
|
|
|
|
procedure Create_Forced_Edge
|
|
(Pred : Unit_Id;
|
|
Succ : Unit_Id)
|
|
is
|
|
pragma Assert (Present (Pred));
|
|
pragma Assert (Present (Succ));
|
|
|
|
Pred_Vertex : constant Library_Graph_Vertex_Id :=
|
|
Corresponding_Vertex (Lib_Graph, Pred);
|
|
Succ_Vertex : constant Library_Graph_Vertex_Id :=
|
|
Corresponding_Vertex (Lib_Graph, Succ);
|
|
|
|
begin
|
|
Write_Unit_Name (Name (Pred));
|
|
Write_Str (" <-- ");
|
|
Write_Unit_Name (Name (Succ));
|
|
Write_Eol;
|
|
|
|
Add_Edge
|
|
(G => Lib_Graph,
|
|
Pred => Pred_Vertex,
|
|
Succ => Succ_Vertex,
|
|
Kind => Forced_Edge,
|
|
Activates_Task => False);
|
|
end Create_Forced_Edge;
|
|
|
|
-------------------------
|
|
-- Create_Forced_Edges --
|
|
-------------------------
|
|
|
|
procedure Create_Forced_Edges is
|
|
Current_Unit : Unit_Id;
|
|
Iter : Forced_Units_Iterator;
|
|
Previous_Unit : Unit_Id;
|
|
Unit_Line : Logical_Line_Number;
|
|
Unit_Name : Unit_Name_Type;
|
|
|
|
begin
|
|
Previous_Unit := No_Unit_Id;
|
|
Unit_To_Line := Unit_Line_Tables.Create (20);
|
|
|
|
-- Inspect the contents of the forced-elaboration-order file supplied
|
|
-- to the binder using switch -f, and diagnose each unit accordingly.
|
|
|
|
Iter := Iterate_Forced_Units;
|
|
while Has_Next (Iter) loop
|
|
Next (Iter, Unit_Name, Unit_Line);
|
|
|
|
Current_Unit := Corresponding_Unit (Unit_Name);
|
|
|
|
if not Present (Current_Unit) then
|
|
Missing_Unit_Info (Unit_Name);
|
|
|
|
elsif Is_Internal_Unit (Current_Unit) then
|
|
Internal_Unit_Info (Unit_Name);
|
|
|
|
elsif Is_Duplicate_Unit (Current_Unit) then
|
|
Duplicate_Unit_Error (Current_Unit, Unit_Name, Unit_Line);
|
|
|
|
-- Otherwise the unit is a valid candidate for a vertex. Create a
|
|
-- forced edge between each pair of units.
|
|
|
|
else
|
|
Add_Unit (Current_Unit, Unit_Line);
|
|
|
|
if Present (Previous_Unit) then
|
|
Create_Forced_Edge
|
|
(Pred => Previous_Unit,
|
|
Succ => Current_Unit);
|
|
end if;
|
|
|
|
Previous_Unit := Current_Unit;
|
|
end if;
|
|
end loop;
|
|
|
|
Unit_Line_Tables.Destroy (Unit_To_Line);
|
|
end Create_Forced_Edges;
|
|
|
|
-------------------------------
|
|
-- Create_Spec_And_Body_Edge --
|
|
-------------------------------
|
|
|
|
procedure Create_Spec_And_Body_Edge (U_Id : Unit_Id) is
|
|
Extra_Vertex : Library_Graph_Vertex_Id;
|
|
Vertex : Library_Graph_Vertex_Id;
|
|
|
|
begin
|
|
pragma Assert (Present (Lib_Graph));
|
|
pragma Assert (Present (U_Id));
|
|
|
|
Vertex := Corresponding_Vertex (Lib_Graph, U_Id);
|
|
|
|
-- The unit denotes a body that completes a previous spec. Link the
|
|
-- spec and body. Add an edge between the predecessor spec and the
|
|
-- successor body.
|
|
|
|
if Is_Body_With_Spec (Lib_Graph, Vertex) then
|
|
Extra_Vertex :=
|
|
Corresponding_Vertex (Lib_Graph, Corresponding_Spec (U_Id));
|
|
Set_Corresponding_Item (Lib_Graph, Vertex, Extra_Vertex);
|
|
|
|
Add_Edge
|
|
(G => Lib_Graph,
|
|
Pred => Extra_Vertex,
|
|
Succ => Vertex,
|
|
Kind => Spec_Before_Body_Edge,
|
|
Activates_Task => False);
|
|
|
|
-- The unit denotes a spec with a completing body. Link the spec and
|
|
-- body.
|
|
|
|
elsif Is_Spec_With_Body (Lib_Graph, Vertex) then
|
|
Extra_Vertex :=
|
|
Corresponding_Vertex (Lib_Graph, Corresponding_Body (U_Id));
|
|
Set_Corresponding_Item (Lib_Graph, Vertex, Extra_Vertex);
|
|
end if;
|
|
end Create_Spec_And_Body_Edge;
|
|
|
|
-------------------
|
|
-- Create_Vertex --
|
|
-------------------
|
|
|
|
procedure Create_Vertex (U_Id : Unit_Id) is
|
|
begin
|
|
pragma Assert (Present (Lib_Graph));
|
|
pragma Assert (Present (U_Id));
|
|
|
|
Add_Vertex
|
|
(G => Lib_Graph,
|
|
U_Id => U_Id);
|
|
end Create_Vertex;
|
|
|
|
----------------------
|
|
-- Create_With_Edge --
|
|
----------------------
|
|
|
|
procedure Create_With_Edge
|
|
(W_Id : With_Id;
|
|
Succ : Library_Graph_Vertex_Id)
|
|
is
|
|
pragma Assert (Present (Lib_Graph));
|
|
pragma Assert (Present (W_Id));
|
|
pragma Assert (Present (Succ));
|
|
|
|
Withed_Rec : With_Record renames Withs.Table (W_Id);
|
|
Withed_U_Id : constant Unit_Id :=
|
|
Corresponding_Unit (Withed_Rec.Uname);
|
|
|
|
Kind : Library_Graph_Edge_Kind;
|
|
Withed_Vertex : Library_Graph_Vertex_Id;
|
|
|
|
begin
|
|
-- Nothing to do when the withed unit does not need to be elaborated.
|
|
-- This prevents spurious dependencies that can never be satisfied.
|
|
|
|
if not Needs_Elaboration (Withed_U_Id) then
|
|
return;
|
|
end if;
|
|
|
|
Withed_Vertex := Corresponding_Vertex (Lib_Graph, Withed_U_Id);
|
|
|
|
-- The with comes with pragma Elaborate. Treat the edge as a with
|
|
-- edge when switch -d_e (ignore the effects of pragma Elaborate)
|
|
-- is in effect.
|
|
|
|
if Withed_Rec.Elaborate
|
|
and then not Debug_Flag_Underscore_E
|
|
then
|
|
Kind := Elaborate_Edge;
|
|
|
|
-- The withed unit is a spec with a completing body. Add an edge
|
|
-- between the body of the withed predecessor and the withing
|
|
-- successor.
|
|
|
|
if Is_Spec_With_Body (Lib_Graph, Withed_Vertex) then
|
|
Add_Edge
|
|
(G => Lib_Graph,
|
|
Pred =>
|
|
Corresponding_Vertex
|
|
(Lib_Graph, Corresponding_Body (Withed_U_Id)),
|
|
Succ => Succ,
|
|
Kind => Kind,
|
|
Activates_Task => False);
|
|
end if;
|
|
|
|
-- The with comes with pragma Elaborate_All. Treat the edge as a with
|
|
-- edge when switch -d_a (ignore the effects of pragma Elaborate_All)
|
|
-- is in effect.
|
|
|
|
elsif Withed_Rec.Elaborate_All
|
|
and then not Debug_Flag_Underscore_A
|
|
then
|
|
Kind := Elaborate_All_Edge;
|
|
|
|
-- Otherwise this is a regular with
|
|
|
|
else
|
|
Kind := With_Edge;
|
|
end if;
|
|
|
|
-- Add an edge between the withed predecessor unit and the withing
|
|
-- successor.
|
|
|
|
Add_Edge
|
|
(G => Lib_Graph,
|
|
Pred => Withed_Vertex,
|
|
Succ => Succ,
|
|
Kind => Kind,
|
|
Activates_Task => False);
|
|
end Create_With_Edge;
|
|
|
|
-----------------------
|
|
-- Create_With_Edges --
|
|
-----------------------
|
|
|
|
procedure Create_With_Edges (U_Id : Unit_Id) is
|
|
begin
|
|
pragma Assert (Present (Lib_Graph));
|
|
pragma Assert (Present (U_Id));
|
|
|
|
Create_With_Edges
|
|
(U_Id => U_Id,
|
|
Succ => Corresponding_Vertex (Lib_Graph, U_Id));
|
|
end Create_With_Edges;
|
|
|
|
-----------------------
|
|
-- Create_With_Edges --
|
|
-----------------------
|
|
|
|
procedure Create_With_Edges
|
|
(U_Id : Unit_Id;
|
|
Succ : Library_Graph_Vertex_Id)
|
|
is
|
|
pragma Assert (Present (Lib_Graph));
|
|
pragma Assert (Present (U_Id));
|
|
pragma Assert (Present (Succ));
|
|
|
|
U_Rec : Unit_Record renames ALI.Units.Table (U_Id);
|
|
|
|
begin
|
|
for W_Id in U_Rec.First_With .. U_Rec.Last_With loop
|
|
if Is_Significant_With (W_Id) then
|
|
Create_With_Edge (W_Id, Succ);
|
|
end if;
|
|
end loop;
|
|
end Create_With_Edges;
|
|
|
|
------------------
|
|
-- Destroy_Unit --
|
|
------------------
|
|
|
|
procedure Destroy_Line_Number (Line : in out Logical_Line_Number) is
|
|
pragma Unreferenced (Line);
|
|
begin
|
|
null;
|
|
end Destroy_Line_Number;
|
|
|
|
--------------------------
|
|
-- Duplicate_Unit_Error --
|
|
--------------------------
|
|
|
|
procedure Duplicate_Unit_Error
|
|
(U_Id : Unit_Id;
|
|
Nam : Unit_Name_Type;
|
|
Line : Logical_Line_Number)
|
|
is
|
|
pragma Assert (Present (U_Id));
|
|
pragma Assert (Present (Nam));
|
|
|
|
Prev_Line : constant Logical_Line_Number :=
|
|
Unit_Line_Tables.Get (Unit_To_Line, U_Id);
|
|
|
|
begin
|
|
Error_Msg_Nat_1 := Nat (Line);
|
|
Error_Msg_Nat_2 := Nat (Prev_Line);
|
|
Error_Msg_Unit_1 := Nam;
|
|
|
|
Error_Msg
|
|
(Force_Elab_Order_File.all
|
|
& ":#: duplicate unit name $ from line #");
|
|
end Duplicate_Unit_Error;
|
|
|
|
---------------
|
|
-- Hash_Unit --
|
|
---------------
|
|
|
|
function Hash_Unit (U_Id : Unit_Id) return Bucket_Range_Type is
|
|
begin
|
|
pragma Assert (Present (U_Id));
|
|
|
|
return Bucket_Range_Type (U_Id);
|
|
end Hash_Unit;
|
|
|
|
------------------------
|
|
-- Internal_Unit_Info --
|
|
------------------------
|
|
|
|
procedure Internal_Unit_Info (Nam : Unit_Name_Type) is
|
|
begin
|
|
pragma Assert (Present (Nam));
|
|
|
|
Write_Line
|
|
("""" & Get_Name_String (Nam) & """: predefined unit ignored");
|
|
end Internal_Unit_Info;
|
|
|
|
-----------------------
|
|
-- Is_Duplicate_Unit --
|
|
-----------------------
|
|
|
|
function Is_Duplicate_Unit (U_Id : Unit_Id) return Boolean is
|
|
begin
|
|
pragma Assert (Present (U_Id));
|
|
|
|
return Unit_Line_Tables.Contains (Unit_To_Line, U_Id);
|
|
end Is_Duplicate_Unit;
|
|
|
|
-------------------------
|
|
-- Is_Significant_With --
|
|
-------------------------
|
|
|
|
function Is_Significant_With (W_Id : With_Id) return Boolean is
|
|
pragma Assert (Present (W_Id));
|
|
|
|
Withed_Rec : With_Record renames Withs.Table (W_Id);
|
|
Withed_U_Id : constant Unit_Id :=
|
|
Corresponding_Unit (Withed_Rec.Uname);
|
|
|
|
begin
|
|
-- Nothing to do for a unit which does not exist any more
|
|
|
|
if not Present (Withed_U_Id) then
|
|
return False;
|
|
|
|
-- Nothing to do for a limited with
|
|
|
|
elsif Withed_Rec.Limited_With then
|
|
return False;
|
|
|
|
-- Nothing to do when the unit does not need to be elaborated
|
|
|
|
elsif not Needs_Elaboration (Withed_U_Id) then
|
|
return False;
|
|
end if;
|
|
|
|
return True;
|
|
end Is_Significant_With;
|
|
|
|
-----------------------
|
|
-- Missing_Unit_Info --
|
|
-----------------------
|
|
|
|
procedure Missing_Unit_Info (Nam : Unit_Name_Type) is
|
|
begin
|
|
pragma Assert (Present (Nam));
|
|
|
|
Write_Line
|
|
("""" & Get_Name_String (Nam) & """: not present; ignored");
|
|
end Missing_Unit_Info;
|
|
end Library_Graph_Builders;
|
|
|
|
end Bindo.Builders;
|