| ------------------------------------------------------------------------------ |
| -- -- |
| -- 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; |
