path: root/gcc/ada/bindo-units.adb

------------------------------------------------------------------------------
--                                                                          --
--                         GNAT COMPILER COMPONENTS                         --
--                                                                          --
--                          B I N D O . U N I T S                           --
--                                                                          --
--                                 B o d y                                  --
--                                                                          --
--             Copyright (C) 2019-2023, 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;