blob: d0df8b053df0f6bb688a4ce08ccfa9f9a4e758a4 [file] [log] [blame]
------------------------------------------------------------------------------
-- --
-- GNAT COMPILER COMPONENTS --
-- --
-- B I N D O . U N I T 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 Bindo.Writers;
use Bindo.Writers;
use Bindo.Writers.Phase_Writers;
package body Bindo.Units is
-------------------
-- Signature set --
-------------------
package Signature_Sets is new Membership_Sets
(Element_Type => Invocation_Signature_Id,
"=" => "=",
Hash => Hash_Invocation_Signature);
-----------------
-- Global data --
-----------------
-- The following set stores all invocation signatures that appear in
-- elaborable units.
Elaborable_Constructs : Signature_Sets.Membership_Set := Signature_Sets.Nil;
-- The following set stores all units the need to be elaborated
Elaborable_Units : Unit_Sets.Membership_Set := Unit_Sets.Nil;
-----------------------
-- Local subprograms --
-----------------------
function Corresponding_Unit (Nam : Name_Id) return Unit_Id;
pragma Inline (Corresponding_Unit);
-- Obtain the unit which corresponds to name Nam
function Is_Stand_Alone_Library_Unit (U_Id : Unit_Id) return Boolean;
pragma Inline (Is_Stand_Alone_Library_Unit);
-- Determine whether unit U_Id is part of a stand-alone library
procedure Process_Invocation_Construct (IC_Id : Invocation_Construct_Id);
pragma Inline (Process_Invocation_Construct);
-- Process invocation construct IC_Id by adding its signature to set
-- Elaborable_Constructs_Set.
procedure Process_Invocation_Constructs (U_Id : Unit_Id);
pragma Inline (Process_Invocation_Constructs);
-- Process all invocation constructs of unit U_Id for classification
-- purposes.
procedure Process_Unit (U_Id : Unit_Id);
pragma Inline (Process_Unit);
-- Process unit U_Id for unit classification purposes
------------------------------
-- Collect_Elaborable_Units --
------------------------------
procedure Collect_Elaborable_Units is
begin
Start_Phase (Unit_Collection);
for U_Id in ALI.Units.First .. ALI.Units.Last loop
Process_Unit (U_Id);
end loop;
End_Phase (Unit_Collection);
end Collect_Elaborable_Units;
------------------------
-- Corresponding_Body --
------------------------
function Corresponding_Body (U_Id : Unit_Id) return Unit_Id is
pragma Assert (Present (U_Id));
U_Rec : Unit_Record renames ALI.Units.Table (U_Id);
begin
pragma Assert (U_Rec.Utype = Is_Spec);
return U_Id - 1;
end Corresponding_Body;
------------------------
-- Corresponding_Spec --
------------------------
function Corresponding_Spec (U_Id : Unit_Id) return Unit_Id is
pragma Assert (Present (U_Id));
U_Rec : Unit_Record renames ALI.Units.Table (U_Id);
begin
pragma Assert (U_Rec.Utype = Is_Body);
return U_Id + 1;
end Corresponding_Spec;
------------------------
-- Corresponding_Unit --
------------------------
function Corresponding_Unit (FNam : File_Name_Type) return Unit_Id is
begin
return Corresponding_Unit (Name_Id (FNam));
end Corresponding_Unit;
------------------------
-- Corresponding_Unit --
------------------------
function Corresponding_Unit (Nam : Name_Id) return Unit_Id is
begin
return Unit_Id (Get_Name_Table_Int (Nam));
end Corresponding_Unit;
------------------------
-- Corresponding_Unit --
------------------------
function Corresponding_Unit (UNam : Unit_Name_Type) return Unit_Id is
begin
return Corresponding_Unit (Name_Id (UNam));
end Corresponding_Unit;
---------------
-- File_Name --
---------------
function File_Name (U_Id : Unit_Id) return File_Name_Type is
pragma Assert (Present (U_Id));
U_Rec : Unit_Record renames ALI.Units.Table (U_Id);
begin
return U_Rec.Sfile;
end File_Name;
--------------------
-- Finalize_Units --
--------------------
procedure Finalize_Units is
begin
Signature_Sets.Destroy (Elaborable_Constructs);
Unit_Sets.Destroy (Elaborable_Units);
end Finalize_Units;
------------------------------
-- For_Each_Elaborable_Unit --
------------------------------
procedure For_Each_Elaborable_Unit (Processor : Unit_Processor_Ptr) is
Iter : Elaborable_Units_Iterator;
U_Id : Unit_Id;
begin
Iter := Iterate_Elaborable_Units;
while Has_Next (Iter) loop
Next (Iter, U_Id);
Processor.all (U_Id);
end loop;
end For_Each_Elaborable_Unit;
-------------------
-- For_Each_Unit --
-------------------
procedure For_Each_Unit (Processor : Unit_Processor_Ptr) is
begin
for U_Id in ALI.Units.First .. ALI.Units.Last loop
Processor.all (U_Id);
end loop;
end For_Each_Unit;
--------------
-- Has_Next --
--------------
function Has_Next (Iter : Elaborable_Units_Iterator) return Boolean is
begin
return Unit_Sets.Has_Next (Unit_Sets.Iterator (Iter));
end Has_Next;
-----------------------------
-- Has_No_Elaboration_Code --
-----------------------------
function Has_No_Elaboration_Code (U_Id : Unit_Id) return Boolean is
pragma Assert (Present (U_Id));
U_Rec : Unit_Record renames ALI.Units.Table (U_Id);
begin
return U_Rec.No_Elab;
end Has_No_Elaboration_Code;
-------------------------------
-- Hash_Invocation_Signature --
-------------------------------
function Hash_Invocation_Signature
(IS_Id : Invocation_Signature_Id) return Bucket_Range_Type
is
begin
pragma Assert (Present (IS_Id));
return Bucket_Range_Type (IS_Id);
end Hash_Invocation_Signature;
---------------
-- 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;
----------------------
-- Initialize_Units --
----------------------
procedure Initialize_Units is
begin
Elaborable_Constructs := Signature_Sets.Create (Number_Of_Units);
Elaborable_Units := Unit_Sets.Create (Number_Of_Units);
end Initialize_Units;
-------------------------------
-- Invocation_Graph_Encoding --
-------------------------------
function Invocation_Graph_Encoding
(U_Id : Unit_Id) return Invocation_Graph_Encoding_Kind
is
pragma Assert (Present (U_Id));
U_Rec : Unit_Record renames ALI.Units.Table (U_Id);
U_ALI : ALIs_Record renames ALI.ALIs.Table (U_Rec.My_ALI);
begin
return U_ALI.Invocation_Graph_Encoding;
end Invocation_Graph_Encoding;
-------------------------------
-- Is_Dynamically_Elaborated --
-------------------------------
function Is_Dynamically_Elaborated (U_Id : Unit_Id) return Boolean is
pragma Assert (Present (U_Id));
U_Rec : Unit_Record renames ALI.Units.Table (U_Id);
begin
return U_Rec.Dynamic_Elab;
end Is_Dynamically_Elaborated;
----------------------
-- Is_Internal_Unit --
----------------------
function Is_Internal_Unit (U_Id : Unit_Id) return Boolean is
pragma Assert (Present (U_Id));
U_Rec : Unit_Record renames ALI.Units.Table (U_Id);
begin
return U_Rec.Internal;
end Is_Internal_Unit;
------------------------
-- Is_Predefined_Unit --
------------------------
function Is_Predefined_Unit (U_Id : Unit_Id) return Boolean is
pragma Assert (Present (U_Id));
U_Rec : Unit_Record renames ALI.Units.Table (U_Id);
begin
return U_Rec.Predefined;
end Is_Predefined_Unit;
---------------------------------
-- Is_Stand_Alone_Library_Unit --
---------------------------------
function Is_Stand_Alone_Library_Unit (U_Id : Unit_Id) return Boolean is
pragma Assert (Present (U_Id));
U_Rec : Unit_Record renames ALI.Units.Table (U_Id);
begin
return U_Rec.SAL_Interface;
end Is_Stand_Alone_Library_Unit;
------------------------------
-- Iterate_Elaborable_Units --
------------------------------
function Iterate_Elaborable_Units return Elaborable_Units_Iterator is
begin
return Elaborable_Units_Iterator (Unit_Sets.Iterate (Elaborable_Units));
end Iterate_Elaborable_Units;
----------
-- Name --
----------
function Name (U_Id : Unit_Id) return Unit_Name_Type is
pragma Assert (Present (U_Id));
U_Rec : Unit_Record renames ALI.Units.Table (U_Id);
begin
return U_Rec.Uname;
end Name;
-----------------------
-- Needs_Elaboration --
-----------------------
function Needs_Elaboration
(IS_Id : Invocation_Signature_Id) return Boolean
is
begin
pragma Assert (Present (IS_Id));
return Signature_Sets.Contains (Elaborable_Constructs, IS_Id);
end Needs_Elaboration;
-----------------------
-- Needs_Elaboration --
-----------------------
function Needs_Elaboration (U_Id : Unit_Id) return Boolean is
begin
pragma Assert (Present (U_Id));
return Unit_Sets.Contains (Elaborable_Units, U_Id);
end Needs_Elaboration;
----------
-- Next --
----------
procedure Next
(Iter : in out Elaborable_Units_Iterator;
U_Id : out Unit_Id)
is
begin
Unit_Sets.Next (Unit_Sets.Iterator (Iter), U_Id);
end Next;
--------------------------------
-- Number_Of_Elaborable_Units --
--------------------------------
function Number_Of_Elaborable_Units return Natural is
begin
return Unit_Sets.Size (Elaborable_Units);
end Number_Of_Elaborable_Units;
---------------------
-- Number_Of_Units --
---------------------
function Number_Of_Units return Natural is
begin
return Natural (ALI.Units.Last) - Natural (ALI.Units.First) + 1;
end Number_Of_Units;
----------------------------------
-- Process_Invocation_Construct --
----------------------------------
procedure Process_Invocation_Construct (IC_Id : Invocation_Construct_Id) is
pragma Assert (Present (IC_Id));
IS_Id : constant Invocation_Signature_Id := Signature (IC_Id);
pragma Assert (Present (IS_Id));
begin
Signature_Sets.Insert (Elaborable_Constructs, IS_Id);
end Process_Invocation_Construct;
-----------------------------------
-- Process_Invocation_Constructs --
-----------------------------------
procedure Process_Invocation_Constructs (U_Id : Unit_Id) is
pragma Assert (Present (U_Id));
U_Rec : Unit_Record renames ALI.Units.Table (U_Id);
begin
for IC_Id in U_Rec.First_Invocation_Construct ..
U_Rec.Last_Invocation_Construct
loop
Process_Invocation_Construct (IC_Id);
end loop;
end Process_Invocation_Constructs;
------------------
-- Process_Unit --
------------------
procedure Process_Unit (U_Id : Unit_Id) is
begin
pragma Assert (Present (U_Id));
-- A stand-alone library unit must not be elaborated as part of the
-- current compilation because the library already carries its own
-- elaboration code.
if Is_Stand_Alone_Library_Unit (U_Id) then
null;
-- Otherwise the unit needs to be elaborated. Add it to the set
-- of units that require elaboration, as well as all invocation
-- signatures of constructs it declares.
else
Unit_Sets.Insert (Elaborable_Units, U_Id);
Process_Invocation_Constructs (U_Id);
end if;
end Process_Unit;
end Bindo.Units;