| ------------------------------------------------------------------------------ |
| -- -- |
| -- GNAT COMPILER COMPONENTS -- |
| -- -- |
| -- B I N D O . W R I T 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 Fname; use Fname; |
| with Opt; use Opt; |
| with Output; use Output; |
| |
| with Bindo.Units; |
| use Bindo.Units; |
| |
| with GNAT; use GNAT; |
| with GNAT.Graphs; use GNAT.Graphs; |
| with GNAT.Sets; use GNAT.Sets; |
| |
| package body Bindo.Writers is |
| |
| ----------------- |
| -- ALI_Writers -- |
| ----------------- |
| |
| package body ALI_Writers is |
| |
| ----------------------- |
| -- Local subprograms -- |
| ----------------------- |
| |
| procedure Write_All_Units; |
| pragma Inline (Write_All_Units); |
| -- Write the common form of units to standard output |
| |
| procedure Write_Invocation_Construct (IC_Id : Invocation_Construct_Id); |
| pragma Inline (Write_Invocation_Construct); |
| -- Write invocation construct IC_Id to standard output |
| |
| procedure Write_Invocation_Relation (IR_Id : Invocation_Relation_Id); |
| pragma Inline (Write_Invocation_Relation); |
| -- Write invocation relation IR_Id to standard output |
| |
| procedure Write_Invocation_Signature (IS_Id : Invocation_Signature_Id); |
| pragma Inline (Write_Invocation_Signature); |
| -- Write invocation signature IS_Id to standard output |
| |
| procedure Write_Statistics; |
| pragma Inline (Write_Statistics); |
| -- Write the statistical information of units to standard output |
| |
| procedure Write_Unit (U_Id : Unit_Id); |
| pragma Inline (Write_Unit); |
| -- Write the invocation constructs and relations of unit U_Id to |
| -- standard output. |
| |
| procedure Write_Unit_Common (U_Id : Unit_Id); |
| pragma Inline (Write_Unit_Common); |
| -- Write the common form of unit U_Id to standard output |
| |
| ----------- |
| -- Debug -- |
| ----------- |
| |
| procedure pau renames Write_All_Units; |
| pragma Unreferenced (pau); |
| |
| procedure pu (U_Id : Unit_Id) renames Write_Unit_Common; |
| pragma Unreferenced (pu); |
| |
| ---------------------- |
| -- Write_ALI_Tables -- |
| ---------------------- |
| |
| procedure Write_ALI_Tables is |
| begin |
| -- Nothing to do when switch -d_A (output invocation tables) is not |
| -- in effect. |
| |
| if not Debug_Flag_Underscore_AA then |
| return; |
| end if; |
| |
| Write_Str ("ALI Tables"); |
| Write_Eol; |
| Write_Eol; |
| |
| Write_Statistics; |
| For_Each_Unit (Write_Unit'Access); |
| |
| Write_Str ("ALI Tables end"); |
| Write_Eol; |
| Write_Eol; |
| end Write_ALI_Tables; |
| |
| --------------------- |
| -- Write_All_Units -- |
| --------------------- |
| |
| procedure Write_All_Units is |
| begin |
| For_Each_Unit (Write_Unit_Common'Access); |
| end Write_All_Units; |
| |
| -------------------------------- |
| -- Write_Invocation_Construct -- |
| -------------------------------- |
| |
| procedure Write_Invocation_Construct (IC_Id : Invocation_Construct_Id) is |
| begin |
| pragma Assert (Present (IC_Id)); |
| |
| Write_Str (" invocation construct (IC_Id_"); |
| Write_Int (Int (IC_Id)); |
| Write_Str (")"); |
| Write_Eol; |
| |
| Write_Str (" Body_Placement = "); |
| Write_Str (Body_Placement (IC_Id)'Img); |
| Write_Eol; |
| |
| Write_Str (" Kind = "); |
| Write_Str (Kind (IC_Id)'Img); |
| Write_Eol; |
| |
| Write_Str (" Spec_Placement = "); |
| Write_Str (Spec_Placement (IC_Id)'Img); |
| Write_Eol; |
| |
| Write_Invocation_Signature (Signature (IC_Id)); |
| Write_Eol; |
| end Write_Invocation_Construct; |
| |
| ------------------------------- |
| -- Write_Invocation_Relation -- |
| ------------------------------- |
| |
| procedure Write_Invocation_Relation (IR_Id : Invocation_Relation_Id) is |
| begin |
| pragma Assert (Present (IR_Id)); |
| |
| Write_Str (" invocation relation (IR_Id_"); |
| Write_Int (Int (IR_Id)); |
| Write_Str (")"); |
| Write_Eol; |
| |
| if Present (Extra (IR_Id)) then |
| Write_Str (" Extra = "); |
| Write_Name (Extra (IR_Id)); |
| else |
| Write_Str (" Extra = none"); |
| end if; |
| |
| Write_Eol; |
| Write_Str (" Invoker"); |
| Write_Eol; |
| |
| Write_Invocation_Signature (Invoker (IR_Id)); |
| |
| Write_Str (" Kind = "); |
| Write_Str (Kind (IR_Id)'Img); |
| Write_Eol; |
| |
| Write_Str (" Target"); |
| Write_Eol; |
| |
| Write_Invocation_Signature (Target (IR_Id)); |
| Write_Eol; |
| end Write_Invocation_Relation; |
| |
| -------------------------------- |
| -- Write_Invocation_Signature -- |
| -------------------------------- |
| |
| procedure Write_Invocation_Signature (IS_Id : Invocation_Signature_Id) is |
| begin |
| pragma Assert (Present (IS_Id)); |
| |
| Write_Str (" Signature (IS_Id_"); |
| Write_Int (Int (IS_Id)); |
| Write_Str (")"); |
| Write_Eol; |
| |
| Write_Str (" Column = "); |
| Write_Int (Int (Column (IS_Id))); |
| Write_Eol; |
| |
| Write_Str (" Line = "); |
| Write_Int (Int (Line (IS_Id))); |
| Write_Eol; |
| |
| if Present (Locations (IS_Id)) then |
| Write_Str (" Locations = "); |
| Write_Name (Locations (IS_Id)); |
| else |
| Write_Str (" Locations = none"); |
| end if; |
| |
| Write_Eol; |
| Write_Str (" Name = "); |
| Write_Name (Name (IS_Id)); |
| Write_Eol; |
| |
| Write_Str (" Scope = "); |
| Write_Name (IS_Scope (IS_Id)); |
| Write_Eol; |
| end Write_Invocation_Signature; |
| |
| ---------------------- |
| -- Write_Statistics -- |
| ---------------------- |
| |
| procedure Write_Statistics is |
| begin |
| Write_Str ("Units : "); |
| Write_Num (Int (Number_Of_Units)); |
| Write_Eol; |
| |
| Write_Str ("Units to elaborate: "); |
| Write_Num (Int (Number_Of_Elaborable_Units)); |
| Write_Eol; |
| Write_Eol; |
| end Write_Statistics; |
| |
| ---------------- |
| -- Write_Unit -- |
| ---------------- |
| |
| procedure Write_Unit (U_Id : Unit_Id) is |
| pragma Assert (Present (U_Id)); |
| |
| U_Rec : Unit_Record renames ALI.Units.Table (U_Id); |
| |
| begin |
| Write_Unit_Common (U_Id); |
| |
| Write_Str (" First_Invocation_Construct (IC_Id_"); |
| Write_Int (Int (U_Rec.First_Invocation_Construct)); |
| Write_Str (")"); |
| Write_Eol; |
| |
| Write_Str (" Last_Invocation_Construct (IC_Id_"); |
| Write_Int (Int (U_Rec.Last_Invocation_Construct)); |
| Write_Str (")"); |
| Write_Eol; |
| |
| Write_Str (" First_Invocation_Relation (IR_Id_"); |
| Write_Int (Int (U_Rec.First_Invocation_Relation)); |
| Write_Str (")"); |
| Write_Eol; |
| |
| Write_Str (" Last_Invocation_Relation (IR_Id_"); |
| Write_Int (Int (U_Rec.Last_Invocation_Relation)); |
| Write_Str (")"); |
| Write_Eol; |
| |
| Write_Str (" Invocation_Graph_Encoding = "); |
| Write_Str (Invocation_Graph_Encoding (U_Id)'Img); |
| Write_Eol; |
| Write_Eol; |
| |
| For_Each_Invocation_Construct |
| (U_Id => U_Id, |
| Processor => Write_Invocation_Construct'Access); |
| |
| For_Each_Invocation_Relation |
| (U_Id => U_Id, |
| Processor => Write_Invocation_Relation'Access); |
| end Write_Unit; |
| |
| ----------------------- |
| -- Write_Unit_Common -- |
| ----------------------- |
| |
| procedure Write_Unit_Common (U_Id : Unit_Id) is |
| pragma Assert (Present (U_Id)); |
| |
| U_Rec : Unit_Record renames ALI.Units.Table (U_Id); |
| |
| begin |
| Write_Str ("unit (U_Id_"); |
| Write_Int (Int (U_Id)); |
| Write_Str (") name = "); |
| Write_Name (U_Rec.Uname); |
| Write_Eol; |
| |
| if U_Rec.SAL_Interface then |
| Write_Str (" SAL_Interface = True"); |
| Write_Eol; |
| end if; |
| end Write_Unit_Common; |
| end ALI_Writers; |
| |
| ------------------- |
| -- Cycle_Writers -- |
| ------------------- |
| |
| package body Cycle_Writers is |
| |
| ----------------------- |
| -- Local subprograms -- |
| ----------------------- |
| |
| procedure Write_Cycle |
| (G : Library_Graph; |
| Cycle : Library_Graph_Cycle_Id); |
| pragma Inline (Write_Cycle); |
| -- Write the path of cycle Cycle found in library graph G to standard |
| -- output. |
| |
| procedure Write_Cyclic_Edge |
| (G : Library_Graph; |
| Edge : Library_Graph_Edge_Id); |
| pragma Inline (Write_Cyclic_Edge); |
| -- Write cyclic edge Edge of library graph G to standard |
| |
| ----------- |
| -- Debug -- |
| ----------- |
| |
| procedure palgc (G : Library_Graph) renames Write_Cycles; |
| pragma Unreferenced (palgc); |
| |
| procedure plgc |
| (G : Library_Graph; |
| Cycle : Library_Graph_Cycle_Id) renames Write_Cycle; |
| pragma Unreferenced (plgc); |
| |
| ----------------- |
| -- Write_Cycle -- |
| ----------------- |
| |
| procedure Write_Cycle |
| (G : Library_Graph; |
| Cycle : Library_Graph_Cycle_Id) |
| is |
| Edge : Library_Graph_Edge_Id; |
| Iter : Edges_Of_Cycle_Iterator; |
| |
| begin |
| pragma Assert (Present (G)); |
| pragma Assert (Present (Cycle)); |
| |
| -- Nothing to do when switch -d_P (output cycle paths) is not in |
| -- effect. |
| |
| if not Debug_Flag_Underscore_PP then |
| return; |
| end if; |
| |
| Write_Str ("cycle (LGC_Id_"); |
| Write_Int (Int (Cycle)); |
| Write_Str (")"); |
| Write_Eol; |
| |
| Iter := Iterate_Edges_Of_Cycle (G, Cycle); |
| while Has_Next (Iter) loop |
| Next (Iter, Edge); |
| |
| Write_Cyclic_Edge (G, Edge); |
| end loop; |
| |
| Write_Eol; |
| end Write_Cycle; |
| |
| ------------------ |
| -- Write_Cycles -- |
| ------------------ |
| |
| procedure Write_Cycles (G : Library_Graph) is |
| Cycle : Library_Graph_Cycle_Id; |
| Iter : All_Cycle_Iterator; |
| |
| begin |
| pragma Assert (Present (G)); |
| |
| Iter := Iterate_All_Cycles (G); |
| while Has_Next (Iter) loop |
| Next (Iter, Cycle); |
| |
| Write_Cycle (G, Cycle); |
| end loop; |
| end Write_Cycles; |
| |
| ----------------------- |
| -- Write_Cyclic_Edge -- |
| ----------------------- |
| |
| procedure Write_Cyclic_Edge |
| (G : Library_Graph; |
| Edge : Library_Graph_Edge_Id) |
| is |
| pragma Assert (Present (G)); |
| pragma Assert (Present (Edge)); |
| |
| Pred : constant Library_Graph_Vertex_Id := Predecessor (G, Edge); |
| Succ : constant Library_Graph_Vertex_Id := Successor (G, Edge); |
| |
| begin |
| Indent_By (Nested_Indentation); |
| Write_Name (Name (G, Succ)); |
| Write_Str (" --> "); |
| Write_Name (Name (G, Pred)); |
| Write_Str (" "); |
| |
| if Is_Elaborate_All_Edge (G, Edge) then |
| Write_Str ("Elaborate_All edge"); |
| |
| elsif Is_Elaborate_Body_Edge (G, Edge) then |
| Write_Str ("Elaborate_Body edge"); |
| |
| elsif Is_Elaborate_Edge (G, Edge) then |
| Write_Str ("Elaborate edge"); |
| |
| elsif Is_Forced_Edge (G, Edge) then |
| Write_Str ("forced edge"); |
| |
| elsif Is_Invocation_Edge (G, Edge) then |
| Write_Str ("invocation edge"); |
| |
| else |
| pragma Assert (Is_With_Edge (G, Edge)); |
| |
| Write_Str ("with edge"); |
| end if; |
| |
| Write_Eol; |
| end Write_Cyclic_Edge; |
| end Cycle_Writers; |
| |
| ------------------------ |
| -- Dependency_Writers -- |
| ------------------------ |
| |
| package body Dependency_Writers is |
| |
| ----------------------- |
| -- Local subprograms -- |
| ----------------------- |
| |
| procedure Write_Dependencies_Of_Vertex |
| (G : Library_Graph; |
| Vertex : Library_Graph_Vertex_Id); |
| pragma Inline (Write_Dependencies_Of_Vertex); |
| -- Write the dependencies of vertex Vertex of library graph G to |
| -- standard output. |
| |
| procedure Write_Dependency_Edge |
| (G : Library_Graph; |
| Edge : Library_Graph_Edge_Id); |
| pragma Inline (Write_Dependency_Edge); |
| -- Write the dependency described by edge Edge of library graph G to |
| -- standard output. |
| |
| ------------------------ |
| -- Write_Dependencies -- |
| ------------------------ |
| |
| procedure Write_Dependencies (G : Library_Graph) is |
| Use_Formatting : constant Boolean := not Zero_Formatting; |
| |
| Iter : Library_Graphs.All_Vertex_Iterator; |
| Vertex : Library_Graph_Vertex_Id; |
| |
| begin |
| pragma Assert (Present (G)); |
| |
| -- Nothing to do when switch -e (output complete list of elaboration |
| -- order dependencies) is not in effect. |
| |
| if not Elab_Dependency_Output then |
| return; |
| end if; |
| |
| if Use_Formatting then |
| Write_Eol; |
| Write_Line ("ELABORATION ORDER DEPENDENCIES"); |
| Write_Eol; |
| end if; |
| |
| Info_Prefix_Suppress := True; |
| |
| Iter := Iterate_All_Vertices (G); |
| while Has_Next (Iter) loop |
| Next (Iter, Vertex); |
| |
| Write_Dependencies_Of_Vertex (G, Vertex); |
| end loop; |
| |
| Info_Prefix_Suppress := False; |
| |
| if Use_Formatting then |
| Write_Eol; |
| end if; |
| end Write_Dependencies; |
| |
| ---------------------------------- |
| -- Write_Dependencies_Of_Vertex -- |
| ---------------------------------- |
| |
| procedure Write_Dependencies_Of_Vertex |
| (G : Library_Graph; |
| Vertex : Library_Graph_Vertex_Id) |
| is |
| Edge : Library_Graph_Edge_Id; |
| Iter : Edges_To_Successors_Iterator; |
| |
| begin |
| pragma Assert (Present (G)); |
| pragma Assert (Present (Vertex)); |
| |
| -- Nothing to do for internal and predefined units |
| |
| if Is_Internal_Unit (G, Vertex) |
| or else Is_Predefined_Unit (G, Vertex) |
| then |
| return; |
| end if; |
| |
| Iter := Iterate_Edges_To_Successors (G, Vertex); |
| while Has_Next (Iter) loop |
| Next (Iter, Edge); |
| |
| Write_Dependency_Edge (G, Edge); |
| end loop; |
| end Write_Dependencies_Of_Vertex; |
| |
| --------------------------- |
| -- Write_Dependency_Edge -- |
| --------------------------- |
| |
| procedure Write_Dependency_Edge |
| (G : Library_Graph; |
| Edge : Library_Graph_Edge_Id) |
| is |
| pragma Assert (Present (G)); |
| pragma Assert (Present (Edge)); |
| |
| Pred : constant Library_Graph_Vertex_Id := Predecessor (G, Edge); |
| Succ : constant Library_Graph_Vertex_Id := Successor (G, Edge); |
| |
| begin |
| -- Nothing to do for internal and predefined units |
| |
| if Is_Internal_Unit (G, Succ) |
| or else Is_Predefined_Unit (G, Succ) |
| then |
| return; |
| end if; |
| |
| Error_Msg_Unit_1 := Name (G, Pred); |
| Error_Msg_Unit_2 := Name (G, Succ); |
| Error_Msg_Output |
| (Msg => " unit $ must be elaborated before unit $", |
| Info => True); |
| |
| Error_Msg_Unit_1 := Name (G, Succ); |
| Error_Msg_Unit_2 := Name (G, Pred); |
| |
| if Is_Elaborate_All_Edge (G, Edge) then |
| Error_Msg_Output |
| (Msg => |
| " reason: unit $ has with clause and pragma " |
| & "Elaborate_All for unit $", |
| Info => True); |
| |
| elsif Is_Elaborate_Body_Edge (G, Edge) then |
| Error_Msg_Output |
| (Msg => " reason: unit $ has with clause for unit $", |
| Info => True); |
| |
| elsif Is_Elaborate_Edge (G, Edge) then |
| Error_Msg_Output |
| (Msg => |
| " reason: unit $ has with clause and pragma Elaborate " |
| & "for unit $", |
| Info => True); |
| |
| elsif Is_Forced_Edge (G, Edge) then |
| Error_Msg_Output |
| (Msg => |
| " reason: unit $ has a dependency on unit $ forced by -f " |
| & "switch", |
| Info => True); |
| |
| elsif Is_Invocation_Edge (G, Edge) then |
| Error_Msg_Output |
| (Msg => |
| " reason: unit $ invokes a construct of unit $ at " |
| & "elaboration time", |
| Info => True); |
| |
| elsif Is_Spec_Before_Body_Edge (G, Edge) then |
| Error_Msg_Output |
| (Msg => " reason: spec must be elaborated before body", |
| Info => True); |
| |
| else |
| pragma Assert (Is_With_Edge (G, Edge)); |
| |
| Error_Msg_Output |
| (Msg => " reason: unit $ has with clause for unit $", |
| Info => True); |
| end if; |
| end Write_Dependency_Edge; |
| end Dependency_Writers; |
| |
| ------------------------------- |
| -- Elaboration_Order_Writers -- |
| ------------------------------- |
| |
| package body Elaboration_Order_Writers is |
| |
| ----------------------- |
| -- Local subprograms -- |
| ----------------------- |
| |
| procedure Write_Unit (U_Id : Unit_Id); |
| pragma Inline (Write_Unit); |
| -- Write unit U_Id to standard output |
| |
| procedure Write_Units (Order : Unit_Id_Table); |
| pragma Inline (Write_Units); |
| -- Write all units found in elaboration order Order to standard output |
| |
| ----------------------------- |
| -- Write_Elaboration_Order -- |
| ----------------------------- |
| |
| procedure Write_Elaboration_Order (Order : Unit_Id_Table) is |
| Use_Formatting : constant Boolean := not Zero_Formatting; |
| |
| begin |
| -- Nothing to do when switch -l (output chosen elaboration order) is |
| -- not in effect. |
| |
| if not Elab_Order_Output then |
| return; |
| end if; |
| |
| if Use_Formatting then |
| Write_Eol; |
| Write_Str ("ELABORATION ORDER"); |
| Write_Eol; |
| end if; |
| |
| Write_Units (Order); |
| |
| if Use_Formatting then |
| Write_Eol; |
| end if; |
| end Write_Elaboration_Order; |
| |
| ---------------- |
| -- Write_Unit -- |
| ---------------- |
| |
| procedure Write_Unit (U_Id : Unit_Id) is |
| Use_Formatting : constant Boolean := not Zero_Formatting; |
| |
| begin |
| pragma Assert (Present (U_Id)); |
| |
| if Use_Formatting then |
| Write_Str (" "); |
| end if; |
| |
| Write_Unit_Name (Name (U_Id)); |
| Write_Eol; |
| end Write_Unit; |
| |
| ----------------- |
| -- Write_Units -- |
| ----------------- |
| |
| procedure Write_Units (Order : Unit_Id_Table) is |
| begin |
| for Index in Unit_Id_Tables.First .. Unit_Id_Tables.Last (Order) loop |
| Write_Unit (Order.Table (Index)); |
| end loop; |
| end Write_Units; |
| end Elaboration_Order_Writers; |
| |
| --------------- |
| -- Indent_By -- |
| --------------- |
| |
| procedure Indent_By (Indent : Indentation_Level) is |
| begin |
| for Count in 1 .. Indent loop |
| Write_Char (' '); |
| end loop; |
| end Indent_By; |
| |
| ------------------------------ |
| -- Invocation_Graph_Writers -- |
| ------------------------------ |
| |
| package body Invocation_Graph_Writers is |
| |
| ----------------------- |
| -- Local subprograms -- |
| ----------------------- |
| |
| procedure Write_Elaboration_Root |
| (G : Invocation_Graph; |
| Root : Invocation_Graph_Vertex_Id); |
| pragma Inline (Write_Elaboration_Root); |
| -- Write elaboration root Root of invocation graph G to standard output |
| |
| procedure Write_Elaboration_Roots (G : Invocation_Graph); |
| pragma Inline (Write_Elaboration_Roots); |
| -- Write all elaboration roots of invocation graph G to standard output |
| |
| procedure Write_Invocation_Graph_Edge |
| (G : Invocation_Graph; |
| Edge : Invocation_Graph_Edge_Id); |
| pragma Inline (Write_Invocation_Graph_Edge); |
| -- Write edge Edge of invocation graph G to standard output |
| |
| procedure Write_Invocation_Graph_Edges |
| (G : Invocation_Graph; |
| Vertex : Invocation_Graph_Vertex_Id); |
| pragma Inline (Write_Invocation_Graph_Edges); |
| -- Write all edges to targets of vertex Vertex of invocation graph G to |
| -- standard output. |
| |
| procedure Write_Invocation_Graph_Vertex |
| (G : Invocation_Graph; |
| Vertex : Invocation_Graph_Vertex_Id); |
| pragma Inline (Write_Invocation_Graph_Vertex); |
| -- Write vertex Vertex of invocation graph G to standard output |
| |
| procedure Write_Invocation_Graph_Vertices (G : Invocation_Graph); |
| pragma Inline (Write_Invocation_Graph_Vertices); |
| -- Write all vertices of invocation graph G to standard output |
| |
| procedure Write_Statistics (G : Invocation_Graph); |
| pragma Inline (Write_Statistics); |
| -- Write the statistical information of invocation graph G to standard |
| -- output. |
| |
| ----------- |
| -- Debug -- |
| ----------- |
| |
| procedure pige |
| (G : Invocation_Graph; |
| Edge : Invocation_Graph_Edge_Id) renames Write_Invocation_Graph_Edge; |
| pragma Unreferenced (pige); |
| |
| procedure pigv |
| (G : Invocation_Graph; |
| Vertex : Invocation_Graph_Vertex_Id) |
| renames Write_Invocation_Graph_Vertex; |
| pragma Unreferenced (pigv); |
| |
| ---------------------------- |
| -- Write_Elaboration_Root -- |
| ---------------------------- |
| |
| procedure Write_Elaboration_Root |
| (G : Invocation_Graph; |
| Root : Invocation_Graph_Vertex_Id) |
| is |
| begin |
| pragma Assert (Present (G)); |
| pragma Assert (Present (Root)); |
| |
| Write_Str ("elaboration root (IGV_Id_"); |
| Write_Int (Int (Root)); |
| Write_Str (") name = "); |
| Write_Name (Name (G, Root)); |
| Write_Eol; |
| end Write_Elaboration_Root; |
| |
| ----------------------------- |
| -- Write_Elaboration_Roots -- |
| ----------------------------- |
| |
| procedure Write_Elaboration_Roots (G : Invocation_Graph) is |
| pragma Assert (Present (G)); |
| |
| Num_Of_Roots : constant Natural := Number_Of_Elaboration_Roots (G); |
| |
| Iter : Elaboration_Root_Iterator; |
| Root : Invocation_Graph_Vertex_Id; |
| |
| begin |
| Write_Str ("Elaboration roots: "); |
| Write_Int (Int (Num_Of_Roots)); |
| Write_Eol; |
| |
| if Num_Of_Roots > 0 then |
| Iter := Iterate_Elaboration_Roots (G); |
| while Has_Next (Iter) loop |
| Next (Iter, Root); |
| |
| Write_Elaboration_Root (G, Root); |
| end loop; |
| else |
| Write_Eol; |
| end if; |
| end Write_Elaboration_Roots; |
| |
| ---------------------------- |
| -- Write_Invocation_Graph -- |
| ---------------------------- |
| |
| procedure Write_Invocation_Graph (G : Invocation_Graph) is |
| begin |
| pragma Assert (Present (G)); |
| |
| -- Nothing to do when switch -d_I (output invocation graph) is not in |
| -- effect. |
| |
| if not Debug_Flag_Underscore_II then |
| return; |
| end if; |
| |
| Write_Str ("Invocation Graph"); |
| Write_Eol; |
| Write_Eol; |
| |
| Write_Statistics (G); |
| Write_Invocation_Graph_Vertices (G); |
| Write_Elaboration_Roots (G); |
| |
| Write_Str ("Invocation Graph end"); |
| Write_Eol; |
| |
| Write_Eol; |
| end Write_Invocation_Graph; |
| |
| --------------------------------- |
| -- Write_Invocation_Graph_Edge -- |
| --------------------------------- |
| |
| procedure Write_Invocation_Graph_Edge |
| (G : Invocation_Graph; |
| Edge : Invocation_Graph_Edge_Id) |
| is |
| pragma Assert (Present (G)); |
| pragma Assert (Present (Edge)); |
| |
| Targ : constant Invocation_Graph_Vertex_Id := Target (G, Edge); |
| |
| begin |
| Write_Str (" invocation graph edge (IGE_Id_"); |
| Write_Int (Int (Edge)); |
| Write_Str (")"); |
| Write_Eol; |
| |
| Write_Str (" Relation (IR_Id_"); |
| Write_Int (Int (Relation (G, Edge))); |
| Write_Str (")"); |
| Write_Eol; |
| |
| Write_Str (" Target (IGV_Id_"); |
| Write_Int (Int (Targ)); |
| Write_Str (") name = "); |
| Write_Name (Name (G, Targ)); |
| Write_Eol; |
| |
| Write_Eol; |
| end Write_Invocation_Graph_Edge; |
| |
| ---------------------------------- |
| -- Write_Invocation_Graph_Edges -- |
| ---------------------------------- |
| |
| procedure Write_Invocation_Graph_Edges |
| (G : Invocation_Graph; |
| Vertex : Invocation_Graph_Vertex_Id) |
| is |
| pragma Assert (Present (G)); |
| pragma Assert (Present (Vertex)); |
| |
| Num_Of_Edges : constant Natural := |
| Number_Of_Edges_To_Targets (G, Vertex); |
| |
| Edge : Invocation_Graph_Edge_Id; |
| Iter : Invocation_Graphs.Edges_To_Targets_Iterator; |
| |
| begin |
| Write_Str (" Edges to targets: "); |
| Write_Int (Int (Num_Of_Edges)); |
| Write_Eol; |
| |
| if Num_Of_Edges > 0 then |
| Iter := Iterate_Edges_To_Targets (G, Vertex); |
| while Has_Next (Iter) loop |
| Next (Iter, Edge); |
| |
| Write_Invocation_Graph_Edge (G, Edge); |
| end loop; |
| else |
| Write_Eol; |
| end if; |
| end Write_Invocation_Graph_Edges; |
| |
| ----------------------------------- |
| -- Write_Invocation_Graph_Vertex -- |
| ----------------------------------- |
| |
| procedure Write_Invocation_Graph_Vertex |
| (G : Invocation_Graph; |
| Vertex : Invocation_Graph_Vertex_Id) |
| is |
| Lib_Graph : constant Library_Graph := Get_Lib_Graph (G); |
| |
| B : constant Library_Graph_Vertex_Id := Body_Vertex (G, Vertex); |
| S : constant Library_Graph_Vertex_Id := Spec_Vertex (G, Vertex); |
| begin |
| pragma Assert (Present (G)); |
| pragma Assert (Present (Vertex)); |
| |
| Write_Str ("invocation graph vertex (IGV_Id_"); |
| Write_Int (Int (Vertex)); |
| Write_Str (") name = "); |
| Write_Name (Name (G, Vertex)); |
| Write_Eol; |
| |
| Write_Str (" Body_Vertex (LGV_Id_"); |
| Write_Int (Int (B)); |
| Write_Str (") name = "); |
| Write_Name (Name (Lib_Graph, B)); |
| Write_Eol; |
| |
| Write_Str (" Construct (IC_Id_"); |
| Write_Int (Int (Construct (G, Vertex))); |
| Write_Str (")"); |
| Write_Eol; |
| |
| Write_Str (" Spec_Vertex (LGV_Id_"); |
| Write_Int (Int (S)); |
| Write_Str (") name = "); |
| Write_Name (Name (Lib_Graph, S)); |
| Write_Eol; |
| |
| Write_Invocation_Graph_Edges (G, Vertex); |
| end Write_Invocation_Graph_Vertex; |
| |
| ------------------------------------- |
| -- Write_Invocation_Graph_Vertices -- |
| ------------------------------------- |
| |
| procedure Write_Invocation_Graph_Vertices (G : Invocation_Graph) is |
| Iter : Invocation_Graphs.All_Vertex_Iterator; |
| Vertex : Invocation_Graph_Vertex_Id; |
| |
| begin |
| pragma Assert (Present (G)); |
| |
| Iter := Iterate_All_Vertices (G); |
| while Has_Next (Iter) loop |
| Next (Iter, Vertex); |
| |
| Write_Invocation_Graph_Vertex (G, Vertex); |
| end loop; |
| end Write_Invocation_Graph_Vertices; |
| |
| ---------------------- |
| -- Write_Statistics -- |
| ---------------------- |
| |
| procedure Write_Statistics (G : Invocation_Graph) is |
| begin |
| pragma Assert (Present (G)); |
| |
| Write_Str ("Edges : "); |
| Write_Num (Int (Number_Of_Edges (G))); |
| Write_Eol; |
| |
| Write_Str ("Roots : "); |
| Write_Num (Int (Number_Of_Elaboration_Roots (G))); |
| Write_Eol; |
| |
| Write_Str ("Vertices: "); |
| Write_Num (Int (Number_Of_Vertices (G))); |
| Write_Eol; |
| Write_Eol; |
| |
| for Kind in Invocation_Kind'Range loop |
| Write_Str (" "); |
| Write_Num (Int (Invocation_Graph_Edge_Count (G, Kind))); |
| Write_Str (" - "); |
| Write_Str (Kind'Img); |
| Write_Eol; |
| end loop; |
| |
| Write_Eol; |
| end Write_Statistics; |
| end Invocation_Graph_Writers; |
| |
| --------------------------- |
| -- Library_Graph_Writers -- |
| --------------------------- |
| |
| package body Library_Graph_Writers is |
| |
| ----------------------- |
| -- Local subprograms -- |
| ----------------------- |
| |
| procedure Write_Component |
| (G : Library_Graph; |
| Comp : Component_Id); |
| pragma Inline (Write_Component); |
| -- Write component Comp of library graph G to standard output |
| |
| procedure Write_Component_Vertices |
| (G : Library_Graph; |
| Comp : Component_Id); |
| pragma Inline (Write_Component_Vertices); |
| -- Write all vertices of component Comp of library graph G to standard |
| -- output. |
| |
| procedure Write_Components (G : Library_Graph); |
| pragma Inline (Write_Components); |
| -- Write all components of library graph G to standard output |
| |
| procedure Write_Edges_To_Successors |
| (G : Library_Graph; |
| Vertex : Library_Graph_Vertex_Id); |
| pragma Inline (Write_Edges_To_Successors); |
| -- Write all edges to successors of predecessor Vertex of library graph |
| -- G to standard output. |
| |
| procedure Write_Library_Graph_Edge |
| (G : Library_Graph; |
| Edge : Library_Graph_Edge_Id); |
| pragma Inline (Write_Library_Graph_Edge); |
| -- Write edge Edge of library graph G to standard output |
| |
| procedure Write_Library_Graph_Vertex |
| (G : Library_Graph; |
| Vertex : Library_Graph_Vertex_Id); |
| pragma Inline (Write_Library_Graph_Vertex); |
| -- Write vertex Vertex of library graph G to standard output |
| |
| procedure Write_Library_Graph_Vertices (G : Library_Graph); |
| pragma Inline (Write_Library_Graph_Vertices); |
| -- Write all vertices of library graph G to standard output |
| |
| procedure Write_Statistics (G : Library_Graph); |
| pragma Inline (Write_Statistics); |
| -- Write the statistical information of library graph G to standard |
| -- output. |
| |
| ----------- |
| -- Debug -- |
| ----------- |
| |
| procedure pc |
| (G : Library_Graph; |
| Comp : Component_Id) renames Write_Component; |
| pragma Unreferenced (pc); |
| |
| procedure plge |
| (G : Library_Graph; |
| Edge : Library_Graph_Edge_Id) renames Write_Library_Graph_Edge; |
| pragma Unreferenced (plge); |
| |
| procedure plgv |
| (G : Library_Graph; |
| Vertex : Library_Graph_Vertex_Id) renames Write_Library_Graph_Vertex; |
| pragma Unreferenced (plgv); |
| |
| --------------------- |
| -- Write_Component -- |
| --------------------- |
| |
| procedure Write_Component |
| (G : Library_Graph; |
| Comp : Component_Id) |
| is |
| begin |
| pragma Assert (Present (G)); |
| pragma Assert (Present (Comp)); |
| |
| Write_Str ("component (Comp_"); |
| Write_Int (Int (Comp)); |
| Write_Str (")"); |
| Write_Eol; |
| |
| Write_Str (" Pending_Strong_Predecessors = "); |
| Write_Int (Int (Pending_Strong_Predecessors (G, Comp))); |
| Write_Eol; |
| |
| Write_Str (" Pending_Weak_Predecessors = "); |
| Write_Int (Int (Pending_Weak_Predecessors (G, Comp))); |
| Write_Eol; |
| |
| Write_Component_Vertices (G, Comp); |
| |
| Write_Eol; |
| end Write_Component; |
| |
| ------------------------------ |
| -- Write_Component_Vertices -- |
| ------------------------------ |
| |
| procedure Write_Component_Vertices |
| (G : Library_Graph; |
| Comp : Component_Id) |
| is |
| pragma Assert (Present (G)); |
| pragma Assert (Present (Comp)); |
| |
| Num_Of_Vertices : constant Natural := |
| Number_Of_Component_Vertices (G, Comp); |
| |
| Iter : Component_Vertex_Iterator; |
| Vertex : Library_Graph_Vertex_Id; |
| |
| begin |
| Write_Str (" Vertices: "); |
| Write_Int (Int (Num_Of_Vertices)); |
| Write_Eol; |
| |
| if Num_Of_Vertices > 0 then |
| Iter := Iterate_Component_Vertices (G, Comp); |
| while Has_Next (Iter) loop |
| Next (Iter, Vertex); |
| |
| Write_Str (" library graph vertex (LGV_Id_"); |
| Write_Int (Int (Vertex)); |
| Write_Str (") name = "); |
| Write_Name (Name (G, Vertex)); |
| Write_Eol; |
| end loop; |
| else |
| Write_Eol; |
| end if; |
| end Write_Component_Vertices; |
| |
| ---------------------- |
| -- Write_Components -- |
| ---------------------- |
| |
| procedure Write_Components (G : Library_Graph) is |
| pragma Assert (Present (G)); |
| |
| Num_Of_Comps : constant Natural := Number_Of_Components (G); |
| |
| Comp : Component_Id; |
| Iter : Component_Iterator; |
| |
| begin |
| -- Nothing to do when switch -d_L (output library item graph) is not |
| -- in effect. |
| |
| if not Debug_Flag_Underscore_LL then |
| return; |
| end if; |
| |
| Write_Str ("Library Graph components"); |
| Write_Eol; |
| Write_Eol; |
| |
| if Num_Of_Comps > 0 then |
| Write_Str ("Components: "); |
| Write_Num (Int (Num_Of_Comps)); |
| Write_Eol; |
| |
| Iter := Iterate_Components (G); |
| while Has_Next (Iter) loop |
| Next (Iter, Comp); |
| |
| Write_Component (G, Comp); |
| end loop; |
| else |
| Write_Eol; |
| end if; |
| |
| Write_Str ("Library Graph components end"); |
| Write_Eol; |
| |
| Write_Eol; |
| end Write_Components; |
| |
| ------------------------------- |
| -- Write_Edges_To_Successors -- |
| ------------------------------- |
| |
| procedure Write_Edges_To_Successors |
| (G : Library_Graph; |
| Vertex : Library_Graph_Vertex_Id) |
| is |
| pragma Assert (Present (G)); |
| pragma Assert (Present (Vertex)); |
| |
| Num_Of_Edges : constant Natural := |
| Number_Of_Edges_To_Successors (G, Vertex); |
| |
| Edge : Library_Graph_Edge_Id; |
| Iter : Edges_To_Successors_Iterator; |
| |
| begin |
| Write_Str (" Edges to successors: "); |
| Write_Int (Int (Num_Of_Edges)); |
| Write_Eol; |
| |
| if Num_Of_Edges > 0 then |
| Iter := Iterate_Edges_To_Successors (G, Vertex); |
| while Has_Next (Iter) loop |
| Next (Iter, Edge); |
| |
| Write_Library_Graph_Edge (G, Edge); |
| end loop; |
| else |
| Write_Eol; |
| end if; |
| end Write_Edges_To_Successors; |
| |
| ------------------------- |
| -- Write_Library_Graph -- |
| ------------------------- |
| |
| procedure Write_Library_Graph (G : Library_Graph) is |
| begin |
| pragma Assert (Present (G)); |
| |
| -- Nothing to do when switch -d_L (output library item graph) is not |
| -- in effect. |
| |
| if not Debug_Flag_Underscore_LL then |
| return; |
| end if; |
| |
| Write_Str ("Library Graph"); |
| Write_Eol; |
| Write_Eol; |
| |
| Write_Statistics (G); |
| Write_Library_Graph_Vertices (G); |
| Write_Components (G); |
| |
| Write_Str ("Library Graph end"); |
| Write_Eol; |
| |
| Write_Eol; |
| end Write_Library_Graph; |
| |
| ------------------------------ |
| -- Write_Library_Graph_Edge -- |
| ------------------------------ |
| |
| procedure Write_Library_Graph_Edge |
| (G : Library_Graph; |
| Edge : Library_Graph_Edge_Id) |
| is |
| pragma Assert (Present (G)); |
| pragma Assert (Present (Edge)); |
| |
| Pred : constant Library_Graph_Vertex_Id := Predecessor (G, Edge); |
| Succ : constant Library_Graph_Vertex_Id := Successor (G, Edge); |
| |
| begin |
| Write_Str (" library graph edge (LGE_Id_"); |
| Write_Int (Int (Edge)); |
| Write_Str (")"); |
| Write_Eol; |
| |
| Write_Str (" Kind = "); |
| Write_Str (Kind (G, Edge)'Img); |
| Write_Eol; |
| |
| Write_Str (" Predecessor (LGV_Id_"); |
| Write_Int (Int (Pred)); |
| Write_Str (") name = "); |
| Write_Name (Name (G, Pred)); |
| Write_Eol; |
| |
| Write_Str (" Successor (LGV_Id_"); |
| Write_Int (Int (Succ)); |
| Write_Str (") name = "); |
| Write_Name (Name (G, Succ)); |
| Write_Eol; |
| |
| Write_Eol; |
| end Write_Library_Graph_Edge; |
| |
| -------------------------------- |
| -- Write_Library_Graph_Vertex -- |
| -------------------------------- |
| |
| procedure Write_Library_Graph_Vertex |
| (G : Library_Graph; |
| Vertex : Library_Graph_Vertex_Id) |
| is |
| pragma Assert (Present (G)); |
| pragma Assert (Present (Vertex)); |
| |
| Item : constant Library_Graph_Vertex_Id := |
| Corresponding_Item (G, Vertex); |
| U_Id : constant Unit_Id := Unit (G, Vertex); |
| |
| begin |
| Write_Str ("library graph vertex (LGV_Id_"); |
| Write_Int (Int (Vertex)); |
| Write_Str (") name = "); |
| Write_Name (Name (G, Vertex)); |
| Write_Eol; |
| |
| if Present (Item) then |
| Write_Str (" Corresponding_Item (LGV_Id_"); |
| Write_Int (Int (Item)); |
| Write_Str (") name = "); |
| Write_Name (Name (G, Item)); |
| else |
| Write_Str (" Corresponding_Item = none"); |
| end if; |
| |
| Write_Eol; |
| Write_Str (" In_Elaboration_Order = "); |
| |
| if In_Elaboration_Order (G, Vertex) then |
| Write_Str ("True"); |
| else |
| Write_Str ("False"); |
| end if; |
| |
| Write_Eol; |
| Write_Str (" Pending_Strong_Predecessors = "); |
| Write_Int (Int (Pending_Strong_Predecessors (G, Vertex))); |
| Write_Eol; |
| |
| Write_Str (" Pending_Weak_Predecessors = "); |
| Write_Int (Int (Pending_Weak_Predecessors (G, Vertex))); |
| Write_Eol; |
| |
| Write_Str (" Component (Comp_Id_"); |
| Write_Int (Int (Component (G, Vertex))); |
| Write_Str (")"); |
| Write_Eol; |
| |
| Write_Str (" Unit (U_Id_"); |
| Write_Int (Int (U_Id)); |
| Write_Str (") name = "); |
| Write_Name (Name (U_Id)); |
| Write_Eol; |
| |
| Write_Edges_To_Successors (G, Vertex); |
| end Write_Library_Graph_Vertex; |
| |
| ---------------------------------- |
| -- Write_Library_Graph_Vertices -- |
| ---------------------------------- |
| |
| procedure Write_Library_Graph_Vertices (G : Library_Graph) is |
| Iter : Library_Graphs.All_Vertex_Iterator; |
| Vertex : Library_Graph_Vertex_Id; |
| |
| begin |
| pragma Assert (Present (G)); |
| |
| Iter := Iterate_All_Vertices (G); |
| while Has_Next (Iter) loop |
| Next (Iter, Vertex); |
| |
| Write_Library_Graph_Vertex (G, Vertex); |
| end loop; |
| end Write_Library_Graph_Vertices; |
| |
| ---------------------- |
| -- Write_Statistics -- |
| ---------------------- |
| |
| procedure Write_Statistics (G : Library_Graph) is |
| begin |
| Write_Str ("Components: "); |
| Write_Num (Int (Number_Of_Components (G))); |
| Write_Eol; |
| |
| Write_Str ("Edges : "); |
| Write_Num (Int (Number_Of_Edges (G))); |
| Write_Eol; |
| |
| Write_Str ("Vertices : "); |
| Write_Num (Int (Number_Of_Vertices (G))); |
| Write_Eol; |
| Write_Eol; |
| |
| for Kind in Library_Graph_Edge_Kind'Range loop |
| Write_Str (" "); |
| Write_Num (Int (Library_Graph_Edge_Count (G, Kind))); |
| Write_Str (" - "); |
| Write_Str (Kind'Img); |
| Write_Eol; |
| end loop; |
| |
| Write_Eol; |
| end Write_Statistics; |
| end Library_Graph_Writers; |
| |
| ------------------- |
| -- Phase_Writers -- |
| ------------------- |
| |
| package body Phase_Writers is |
| |
| subtype Phase_Message is String (1 .. 32); |
| |
| -- The following table contains the phase-specific messages for phase |
| -- completion. |
| |
| End_Messages : constant array (Elaboration_Phase) of Phase_Message := |
| (Component_Discovery => "components discovered. ", |
| Cycle_Diagnostics => "cycle diagnosed. ", |
| Cycle_Discovery => "cycles discovered. ", |
| Cycle_Validation => "cycles validated. ", |
| Elaboration_Order_Validation => "elaboration order validated. ", |
| Invocation_Graph_Construction => "invocation graph constructed. ", |
| Invocation_Graph_Validation => "invocation graph validated. ", |
| Library_Graph_Augmentation => "library graph augmented. ", |
| Library_Graph_Construction => "library graph constructed. ", |
| Library_Graph_Elaboration => "library graph elaborated. ", |
| Library_Graph_Validation => "library graph validated. ", |
| Unit_Collection => "units collected. ", |
| Unit_Elaboration => "units elaborated. "); |
| |
| -- The following table contains the phase-specific messages for phase |
| -- commencement. |
| |
| Start_Messages : constant array (Elaboration_Phase) of Phase_Message := |
| (Component_Discovery => "discovering components... ", |
| Cycle_Diagnostics => "diagnosing cycle... ", |
| Cycle_Discovery => "discovering cycles... ", |
| Cycle_Validation => "validating cycles... ", |
| Elaboration_Order_Validation => "validating elaboration order... ", |
| Invocation_Graph_Construction => "constructing invocation graph...", |
| Invocation_Graph_Validation => "validating invocation graph... ", |
| Library_Graph_Augmentation => "augmenting library graph... ", |
| Library_Graph_Construction => "constructing library graph... ", |
| Library_Graph_Elaboration => "elaborating library graph... ", |
| Library_Graph_Validation => "validating library graph... ", |
| Unit_Collection => "collecting units... ", |
| Unit_Elaboration => "elaborating units... "); |
| |
| ----------------------- |
| -- Local subprograms -- |
| ----------------------- |
| |
| procedure Write_Phase_Message (Msg : Phase_Message); |
| pragma Inline (Write_Phase_Message); |
| -- Write elaboration phase-related message Msg to standard output |
| |
| --------------- |
| -- End_Phase -- |
| --------------- |
| |
| procedure End_Phase (Phase : Elaboration_Phase) is |
| begin |
| Write_Phase_Message (End_Messages (Phase)); |
| end End_Phase; |
| |
| ----------------- |
| -- Start_Phase -- |
| ----------------- |
| |
| procedure Start_Phase (Phase : Elaboration_Phase) is |
| begin |
| Write_Phase_Message (Start_Messages (Phase)); |
| end Start_Phase; |
| |
| ------------------------- |
| -- Write_Phase_Message -- |
| ------------------------- |
| |
| procedure Write_Phase_Message (Msg : Phase_Message) is |
| begin |
| -- Nothing to do when switch -d_S (output elaboration order status) |
| -- is not in effect. |
| |
| if not Debug_Flag_Underscore_SS then |
| return; |
| end if; |
| |
| Write_Str (Msg); |
| Write_Eol; |
| end Write_Phase_Message; |
| end Phase_Writers; |
| |
| -------------------------- |
| -- Unit_Closure_Writers -- |
| -------------------------- |
| |
| package body Unit_Closure_Writers is |
| function Hash_File_Name (Nam : File_Name_Type) return Bucket_Range_Type; |
| pragma Inline (Hash_File_Name); |
| -- Obtain the hash value of key Nam |
| |
| package File_Name_Tables is new Membership_Sets |
| (Element_Type => File_Name_Type, |
| "=" => "=", |
| Hash => Hash_File_Name); |
| use File_Name_Tables; |
| |
| ----------------------- |
| -- Local subprograms -- |
| ----------------------- |
| |
| procedure Write_File_Name (Nam : File_Name_Type); |
| pragma Inline (Write_File_Name); |
| -- Write file name Nam to standard output |
| |
| procedure Write_Subunit_Closure |
| (Dep : Sdep_Id; |
| Set : Membership_Set); |
| pragma Inline (Write_Subunit_Closure); |
| -- Write the subunit which corresponds to dependency Dep to standard |
| -- output if it does not appear in set Set. |
| |
| procedure Write_Subunits_Closure (Set : Membership_Set); |
| pragma Inline (Write_Subunits_Closure); |
| -- Write all subunits to standard output if they do not appear in set |
| -- Set. |
| |
| procedure Write_Unit_Closure |
| (U_Id : Unit_Id; |
| Set : Membership_Set); |
| pragma Inline (Write_Unit_Closure); |
| -- Write unit U_Id to standard output if it does not appear in set Set |
| |
| procedure Write_Units_Closure |
| (Order : Unit_Id_Table; |
| Set : Membership_Set); |
| pragma Inline (Write_Units_Closure); |
| -- Write all units of elaboration order Order to standard output if they |
| -- do not appear in set Set. |
| |
| -------------------- |
| -- Hash_File_Name -- |
| -------------------- |
| |
| function Hash_File_Name |
| (Nam : File_Name_Type) return Bucket_Range_Type |
| is |
| begin |
| pragma Assert (Present (Nam)); |
| |
| return Bucket_Range_Type (abs Nam); |
| end Hash_File_Name; |
| |
| --------------------- |
| -- Write_File_Name -- |
| --------------------- |
| |
| procedure Write_File_Name (Nam : File_Name_Type) is |
| Use_Formatting : constant Boolean := not Zero_Formatting; |
| |
| begin |
| pragma Assert (Present (Nam)); |
| |
| if Use_Formatting then |
| Write_Str (" "); |
| end if; |
| |
| Write_Line (Get_Name_String (Nam)); |
| end Write_File_Name; |
| |
| --------------------------- |
| -- Write_Subunit_Closure -- |
| --------------------------- |
| |
| procedure Write_Subunit_Closure |
| (Dep : Sdep_Id; |
| Set : Membership_Set) |
| is |
| pragma Assert (Present (Dep)); |
| pragma Assert (Present (Set)); |
| |
| Dep_Rec : Sdep_Record renames Sdep.Table (Dep); |
| Source : constant File_Name_Type := Dep_Rec.Sfile; |
| |
| pragma Assert (Present (Source)); |
| |
| begin |
| -- Nothing to do when the source file has already been written |
| |
| if Contains (Set, Source) then |
| return; |
| |
| -- Nothing to do when the source file does not denote a non-internal |
| -- subunit. |
| |
| elsif not Present (Dep_Rec.Subunit_Name) |
| or else Is_Internal_File_Name (Source) |
| then |
| return; |
| end if; |
| |
| -- Mark the subunit as written |
| |
| Insert (Set, Source); |
| Write_File_Name (Source); |
| end Write_Subunit_Closure; |
| |
| ---------------------------- |
| -- Write_Subunits_Closure -- |
| ---------------------------- |
| |
| procedure Write_Subunits_Closure (Set : Membership_Set) is |
| begin |
| pragma Assert (Present (Set)); |
| |
| for Dep in Sdep.First .. Sdep.Last loop |
| Write_Subunit_Closure (Dep, Set); |
| end loop; |
| end Write_Subunits_Closure; |
| |
| ------------------------ |
| -- Write_Unit_Closure -- |
| ------------------------ |
| |
| procedure Write_Unit_Closure (Order : Unit_Id_Table) is |
| Use_Formatting : constant Boolean := not Zero_Formatting; |
| |
| Set : Membership_Set; |
| |
| begin |
| -- Nothing to do when switch -R (list sources referenced in closure) |
| -- is not in effect. |
| |
| if not List_Closure then |
| return; |
| end if; |
| |
| if Use_Formatting then |
| Write_Eol; |
| Write_Line ("REFERENCED SOURCES"); |
| end if; |
| |
| -- Use a set to avoid writing duplicate units and subunits |
| |
| Set := Create (Number_Of_Elaborable_Units); |
| |
| Write_Units_Closure (Order, Set); |
| Write_Subunits_Closure (Set); |
| |
| Destroy (Set); |
| |
| if Use_Formatting then |
| Write_Eol; |
| end if; |
| end Write_Unit_Closure; |
| |
| ------------------------ |
| -- Write_Unit_Closure -- |
| ------------------------ |
| |
| procedure Write_Unit_Closure |
| (U_Id : Unit_Id; |
| Set : Membership_Set) |
| is |
| pragma Assert (Present (U_Id)); |
| pragma Assert (Present (Set)); |
| |
| U_Rec : Unit_Record renames ALI.Units.Table (U_Id); |
| Source : constant File_Name_Type := U_Rec.Sfile; |
| |
| pragma Assert (Present (Source)); |
| |
| begin |
| -- Nothing to do when the source file has already been written |
| |
| if Contains (Set, Source) then |
| return; |
| |
| -- Nothing to do for internal source files unless switch -Ra is in |
| -- effect. |
| |
| elsif Is_Internal_File_Name (Source) |
| and then not List_Closure_All |
| then |
| return; |
| end if; |
| |
| -- Mark the source file as written |
| |
| Insert (Set, Source); |
| Write_File_Name (Source); |
| end Write_Unit_Closure; |
| |
| ------------------------- |
| -- Write_Units_Closure -- |
| ------------------------- |
| |
| procedure Write_Units_Closure |
| (Order : Unit_Id_Table; |
| Set : Membership_Set) |
| is |
| begin |
| pragma Assert (Present (Set)); |
| |
| for Index in reverse Unit_Id_Tables.First .. |
| Unit_Id_Tables.Last (Order) |
| loop |
| Write_Unit_Closure |
| (U_Id => Order.Table (Index), |
| Set => Set); |
| end loop; |
| end Write_Units_Closure; |
| end Unit_Closure_Writers; |
| |
| --------------- |
| -- Write_Num -- |
| --------------- |
| |
| procedure Write_Num |
| (Val : Int; |
| Val_Indent : Indentation_Level := Number_Column) |
| is |
| function Digits_Indentation return Indentation_Level; |
| pragma Inline (Digits_Indentation); |
| -- Determine the level of indentation the number requires in order to |
| -- be right-justified by Val_Indent. |
| |
| ------------------------ |
| -- Digits_Indentation -- |
| ------------------------ |
| |
| function Digits_Indentation return Indentation_Level is |
| Indent : Indentation_Level; |
| Num : Int; |
| |
| begin |
| -- Treat zero as a single digit |
| |
| if Val = 0 then |
| Indent := 1; |
| |
| else |
| Indent := 0; |
| Num := Val; |
| |
| -- Shrink the input value by dividing it until all of its digits |
| -- are exhausted. |
| |
| while Num /= 0 loop |
| Indent := Indent + 1; |
| Num := Num / 10; |
| end loop; |
| end if; |
| |
| return Val_Indent - Indent; |
| end Digits_Indentation; |
| |
| -- Start of processing for Write_Num |
| |
| begin |
| Indent_By (Digits_Indentation); |
| Write_Int (Val); |
| end Write_Num; |
| |
| end Bindo.Writers; |
