------------------------------------------------------------------------------ -- -- -- GNAT COMPILER COMPONENTS -- -- -- -- B I N D O . U N I T S -- -- -- -- B o d y -- -- -- -- Copyright (C) 2019, 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. -- -- -- ------------------------------------------------------------------------------ package body Bindo.Units is ------------------- -- Signature set -- ------------------- package SS 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 : SS.Membership_Set := SS.Nil; -- The following set stores all units the need to be elaborated Elaborable_Units : US.Membership_Set := US.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 for U_Id in ALI.Units.First .. ALI.Units.Last loop Process_Unit (U_Id); end loop; 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; -------------------- -- Finalize_Units -- -------------------- procedure Finalize_Units is begin SS.Destroy (Elaborable_Constructs); US.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 US.Has_Next (US.Iterator (Iter)); end Has_Next; ------------------------------- -- 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 := SS.Create (Number_Of_Units); Elaborable_Units := US.Create (Number_Of_Units); end Initialize_Units; ------------------------------- -- 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 (US.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 SS.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 US.Contains (Elaborable_Units, U_Id); end Needs_Elaboration; ---------- -- Next -- ---------- procedure Next (Iter : in out Elaborable_Units_Iterator; U_Id : out Unit_Id) is begin US.Next (US.Iterator (Iter), U_Id); end Next; -------------------------------- -- Number_Of_Elaborable_Units -- -------------------------------- function Number_Of_Elaborable_Units return Natural is begin return US.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)); IC_Rec : Invocation_Construct_Record renames Invocation_Constructs.Table (IC_Id); IC_Sig : constant Invocation_Signature_Id := IC_Rec.Signature; pragma Assert (Present (IC_Sig)); begin SS.Insert (Elaborable_Constructs, IC_Sig); 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 US.Insert (Elaborable_Units, U_Id); Process_Invocation_Constructs (U_Id); end if; end Process_Unit; end Bindo.Units;