Mercurial > hg > CbC > CbC_gcc
diff gcc/ada/ali.adb @ 145:1830386684a0
gcc-9.2.0
| author | anatofuz |
|---|---|
| date | Thu, 13 Feb 2020 11:34:05 +0900 |
| parents | 84e7813d76e9 |
| children |
line wrap: on
line diff
--- a/gcc/ada/ali.adb Thu Oct 25 07:37:49 2018 +0900 +++ b/gcc/ada/ali.adb Thu Feb 13 11:34:05 2020 +0900 @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2018, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-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- -- @@ -29,39 +29,584 @@ with Opt; use Opt; with Osint; use Osint; with Output; use Output; +with Snames; use Snames; + +with GNAT; use GNAT; +with GNAT.Dynamic_HTables; use GNAT.Dynamic_HTables; package body ALI is use ASCII; -- Make control characters visible + ----------- + -- Types -- + ----------- + + -- The following type represents an invocation construct + + type Invocation_Construct_Record is record + Body_Placement : Declaration_Placement_Kind := No_Declaration_Placement; + -- The location of the invocation construct's body with respect to the + -- unit where it is declared. + + Kind : Invocation_Construct_Kind := Regular_Construct; + -- The nature of the invocation construct + + Signature : Invocation_Signature_Id := No_Invocation_Signature; + -- The invocation signature that uniquely identifies the invocation + -- construct in the ALI space. + + Spec_Placement : Declaration_Placement_Kind := No_Declaration_Placement; + -- The location of the invocation construct's spec with respect to the + -- unit where it is declared. + end record; + + -- The following type represents an invocation relation. It associates an + -- invoker that activates/calls/instantiates with a target. + + type Invocation_Relation_Record is record + Extra : Name_Id := No_Name; + -- The name of an additional entity used in error diagnostics + + Invoker : Invocation_Signature_Id := No_Invocation_Signature; + -- The invocation signature that uniquely identifies the invoker within + -- the ALI space. + + Kind : Invocation_Kind := No_Invocation; + -- The nature of the invocation + + Target : Invocation_Signature_Id := No_Invocation_Signature; + -- The invocation signature that uniquely identifies the target within + -- the ALI space. + end record; + + -- The following type represents an invocation signature. Its purpose is + -- to uniquely identify an invocation construct within the ALI space. The + -- signature comprises several pieces, some of which are used in error + -- diagnostics by the binder. Identification issues are resolved as + -- follows: + -- + -- * The Column, Line, and Locations attributes together differentiate + -- between homonyms. In most cases, the Column and Line are sufficient + -- except when generic instantiations are involved. Together, the three + -- attributes offer a sequence of column-line pairs that eventually + -- reflect the location within the generic template. + -- + -- * The Name attribute differentiates between invocation constructs at + -- the scope level. Since it is illegal for two entities with the same + -- name to coexist in the same scope, the Name attribute is sufficient + -- to distinguish them. Overloaded entities are already handled by the + -- Column, Line, and Locations attributes. + -- + -- * The Scope attribute differentiates between invocation constructs at + -- various levels of nesting. + + type Invocation_Signature_Record is record + Column : Nat := 0; + -- The column number where the invocation construct is declared + + Line : Nat := 0; + -- The line number where the invocation construct is declared + + Locations : Name_Id := No_Name; + -- Sequence of column and line numbers within nested instantiations + + Name : Name_Id := No_Name; + -- The name of the invocation construct + + Scope : Name_Id := No_Name; + -- The qualified name of the scope where the invocation construct is + -- declared. + end record; + + --------------------- + -- Data structures -- + --------------------- + + package Invocation_Constructs is new Table.Table + (Table_Index_Type => Invocation_Construct_Id, + Table_Component_Type => Invocation_Construct_Record, + Table_Low_Bound => First_Invocation_Construct, + Table_Initial => 2500, + Table_Increment => 200, + Table_Name => "Invocation_Constructs"); + + package Invocation_Relations is new Table.Table + (Table_Index_Type => Invocation_Relation_Id, + Table_Component_Type => Invocation_Relation_Record, + Table_Low_Bound => First_Invocation_Relation, + Table_Initial => 2500, + Table_Increment => 200, + Table_Name => "Invocation_Relation"); + + package Invocation_Signatures is new Table.Table + (Table_Index_Type => Invocation_Signature_Id, + Table_Component_Type => Invocation_Signature_Record, + Table_Low_Bound => First_Invocation_Signature, + Table_Initial => 2500, + Table_Increment => 200, + Table_Name => "Invocation_Signatures"); + + procedure Destroy (IS_Id : in out Invocation_Signature_Id); + -- Destroy an invocation signature with id IS_Id + + function Hash + (IS_Rec : Invocation_Signature_Record) return Bucket_Range_Type; + -- Obtain the hash of key IS_Rec + + package Sig_Map is new Dynamic_Hash_Tables + (Key_Type => Invocation_Signature_Record, + Value_Type => Invocation_Signature_Id, + No_Value => No_Invocation_Signature, + Expansion_Threshold => 1.5, + Expansion_Factor => 2, + Compression_Threshold => 0.3, + Compression_Factor => 2, + "=" => "=", + Destroy_Value => Destroy, + Hash => Hash); + + -- The following map relates invocation signature records to invocation + -- signature ids. + + Sig_To_Sig_Map : constant Sig_Map.Dynamic_Hash_Table := + Sig_Map.Create (500); + + -- The folowing table maps declaration placement kinds to character codes + -- for invocation construct encoding in ALI files. + + Declaration_Placement_Codes : + constant array (Declaration_Placement_Kind) of Character := + (In_Body => 'b', + In_Spec => 's', + No_Declaration_Placement => 'Z'); + + Compile_Time_Invocation_Graph_Encoding : Invocation_Graph_Encoding_Kind := + No_Encoding; + -- The invocation-graph encoding format as specified at compile time. Do + -- not manipulate this value directly. + + -- The following table maps invocation kinds to character codes for + -- invocation relation encoding in ALI files. + + Invocation_Codes : + constant array (Invocation_Kind) of Character := + (Accept_Alternative => 'a', + Access_Taken => 'b', + Call => 'c', + Controlled_Adjustment => 'd', + Controlled_Finalization => 'e', + Controlled_Initialization => 'f', + Default_Initial_Condition_Verification => 'g', + Initial_Condition_Verification => 'h', + Instantiation => 'i', + Internal_Controlled_Adjustment => 'j', + Internal_Controlled_Finalization => 'k', + Internal_Controlled_Initialization => 'l', + Invariant_Verification => 'm', + Postcondition_Verification => 'n', + Protected_Entry_Call => 'o', + Protected_Subprogram_Call => 'p', + Task_Activation => 'q', + Task_Entry_Call => 'r', + Type_Initialization => 's', + No_Invocation => 'Z'); + + -- The following table maps invocation construct kinds to character codes + -- for invocation construct encoding in ALI files. + + Invocation_Construct_Codes : + constant array (Invocation_Construct_Kind) of Character := + (Elaborate_Body_Procedure => 'b', + Elaborate_Spec_Procedure => 's', + Regular_Construct => 'Z'); + + -- The following table maps invocation-graph encoding kinds to character + -- codes for invocation-graph encoding in ALI files. + + Invocation_Graph_Encoding_Codes : + constant array (Invocation_Graph_Encoding_Kind) of Character := + (Full_Path_Encoding => 'f', + Endpoints_Encoding => 'e', + No_Encoding => 'Z'); + + -- The following table maps invocation-graph line kinds to character codes + -- used in ALI files. + + Invocation_Graph_Line_Codes : + constant array (Invocation_Graph_Line_Kind) of Character := + (Invocation_Construct_Line => 'c', + Invocation_Graph_Attributes_Line => 'a', + Invocation_Relation_Line => 'r'); + -- The following variable records which characters currently are used as -- line type markers in the ALI file. This is used in Scan_ALI to detect -- (or skip) invalid lines. The following letters are still available: -- - -- B F G H J K O Q Z + -- B F H J K O Q Z Known_ALI_Lines : constant array (Character range 'A' .. 'Z') of Boolean := - ('V' => True, -- version - 'M' => True, -- main program - 'A' => True, -- argument - 'P' => True, -- program - 'R' => True, -- restriction - 'I' => True, -- interrupt - 'U' => True, -- unit - 'W' => True, -- with - 'L' => True, -- linker option - 'N' => True, -- notes - 'E' => True, -- external - 'D' => True, -- dependency - 'X' => True, -- xref - 'S' => True, -- specific dispatching - 'Y' => True, -- limited_with - 'Z' => True, -- implicit with from instantiation - 'C' => True, -- SCO information - 'T' => True, -- task stack information + ('A' => True, -- argument + 'C' => True, -- SCO information + 'D' => True, -- dependency + 'E' => True, -- external + 'G' => True, -- invocation graph + 'I' => True, -- interrupt + 'L' => True, -- linker option + 'M' => True, -- main program + 'N' => True, -- notes + 'P' => True, -- program + 'R' => True, -- restriction + 'S' => True, -- specific dispatching + 'T' => True, -- task stack information + 'U' => True, -- unit + 'V' => True, -- version + 'W' => True, -- with + 'X' => True, -- xref + 'Y' => True, -- limited_with + 'Z' => True, -- implicit with from instantiation others => False); + ------------------------------ + -- Add_Invocation_Construct -- + ------------------------------ + + procedure Add_Invocation_Construct + (Body_Placement : Declaration_Placement_Kind; + Kind : Invocation_Construct_Kind; + Signature : Invocation_Signature_Id; + Spec_Placement : Declaration_Placement_Kind; + Update_Units : Boolean := True) + is + begin + pragma Assert (Present (Signature)); + + -- Create a invocation construct from the scanned attributes + + Invocation_Constructs.Append + ((Body_Placement => Body_Placement, + Kind => Kind, + Signature => Signature, + Spec_Placement => Spec_Placement)); + + -- Update the invocation construct counter of the current unit only when + -- requested by the caller. + + if Update_Units then + declare + Curr_Unit : Unit_Record renames Units.Table (Units.Last); + + begin + Curr_Unit.Last_Invocation_Construct := Invocation_Constructs.Last; + end; + end if; + end Add_Invocation_Construct; + + ----------------------------- + -- Add_Invocation_Relation -- + ----------------------------- + + procedure Add_Invocation_Relation + (Extra : Name_Id; + Invoker : Invocation_Signature_Id; + Kind : Invocation_Kind; + Target : Invocation_Signature_Id; + Update_Units : Boolean := True) + is + begin + pragma Assert (Present (Invoker)); + pragma Assert (Kind /= No_Invocation); + pragma Assert (Present (Target)); + + -- Create an invocation relation from the scanned attributes + + Invocation_Relations.Append + ((Extra => Extra, + Invoker => Invoker, + Kind => Kind, + Target => Target)); + + -- Update the invocation relation counter of the current unit only when + -- requested by the caller. + + if Update_Units then + declare + Curr_Unit : Unit_Record renames Units.Table (Units.Last); + + begin + Curr_Unit.Last_Invocation_Relation := Invocation_Relations.Last; + end; + end if; + end Add_Invocation_Relation; + + -------------------- + -- Body_Placement -- + -------------------- + + function Body_Placement + (IC_Id : Invocation_Construct_Id) return Declaration_Placement_Kind + is + begin + pragma Assert (Present (IC_Id)); + return Invocation_Constructs.Table (IC_Id).Body_Placement; + end Body_Placement; + + ---------------------------------------- + -- Code_To_Declaration_Placement_Kind -- + ---------------------------------------- + + function Code_To_Declaration_Placement_Kind + (Code : Character) return Declaration_Placement_Kind + is + begin + -- Determine which placement kind corresponds to the character code by + -- traversing the contents of the mapping table. + + for Kind in Declaration_Placement_Kind loop + if Declaration_Placement_Codes (Kind) = Code then + return Kind; + end if; + end loop; + + raise Program_Error; + end Code_To_Declaration_Placement_Kind; + + --------------------------------------- + -- Code_To_Invocation_Construct_Kind -- + --------------------------------------- + + function Code_To_Invocation_Construct_Kind + (Code : Character) return Invocation_Construct_Kind + is + begin + -- Determine which invocation construct kind matches the character code + -- by traversing the contents of the mapping table. + + for Kind in Invocation_Construct_Kind loop + if Invocation_Construct_Codes (Kind) = Code then + return Kind; + end if; + end loop; + + raise Program_Error; + end Code_To_Invocation_Construct_Kind; + + -------------------------------------------- + -- Code_To_Invocation_Graph_Encoding_Kind -- + -------------------------------------------- + + function Code_To_Invocation_Graph_Encoding_Kind + (Code : Character) return Invocation_Graph_Encoding_Kind + is + begin + -- Determine which invocation-graph encoding kind matches the character + -- code by traversing the contents of the mapping table. + + for Kind in Invocation_Graph_Encoding_Kind loop + if Invocation_Graph_Encoding_Codes (Kind) = Code then + return Kind; + end if; + end loop; + + raise Program_Error; + end Code_To_Invocation_Graph_Encoding_Kind; + + ----------------------------- + -- Code_To_Invocation_Kind -- + ----------------------------- + + function Code_To_Invocation_Kind + (Code : Character) return Invocation_Kind + is + begin + -- Determine which invocation kind corresponds to the character code by + -- traversing the contents of the mapping table. + + for Kind in Invocation_Kind loop + if Invocation_Codes (Kind) = Code then + return Kind; + end if; + end loop; + + raise Program_Error; + end Code_To_Invocation_Kind; + + ---------------------------------------- + -- Code_To_Invocation_Graph_Line_Kind -- + ---------------------------------------- + + function Code_To_Invocation_Graph_Line_Kind + (Code : Character) return Invocation_Graph_Line_Kind + is + begin + -- Determine which invocation-graph line kind matches the character + -- code by traversing the contents of the mapping table. + + for Kind in Invocation_Graph_Line_Kind loop + if Invocation_Graph_Line_Codes (Kind) = Code then + return Kind; + end if; + end loop; + + raise Program_Error; + end Code_To_Invocation_Graph_Line_Kind; + + ------------ + -- Column -- + ------------ + + function Column (IS_Id : Invocation_Signature_Id) return Nat is + begin + pragma Assert (Present (IS_Id)); + return Invocation_Signatures.Table (IS_Id).Column; + end Column; + + ---------------------------------------- + -- Declaration_Placement_Kind_To_Code -- + ---------------------------------------- + + function Declaration_Placement_Kind_To_Code + (Kind : Declaration_Placement_Kind) return Character + is + begin + return Declaration_Placement_Codes (Kind); + end Declaration_Placement_Kind_To_Code; + + ------------- + -- Destroy -- + ------------- + + procedure Destroy (IS_Id : in out Invocation_Signature_Id) is + pragma Unreferenced (IS_Id); + begin + null; + end Destroy; + + ----------- + -- Extra -- + ----------- + + function Extra (IR_Id : Invocation_Relation_Id) return Name_Id is + begin + pragma Assert (Present (IR_Id)); + return Invocation_Relations.Table (IR_Id).Extra; + end Extra; + + ----------------------------------- + -- For_Each_Invocation_Construct -- + ----------------------------------- + + procedure For_Each_Invocation_Construct + (Processor : Invocation_Construct_Processor_Ptr) + is + begin + pragma Assert (Processor /= null); + + for IC_Id in Invocation_Constructs.First .. + Invocation_Constructs.Last + loop + Processor.all (IC_Id); + end loop; + end For_Each_Invocation_Construct; + + ----------------------------------- + -- For_Each_Invocation_Construct -- + ----------------------------------- + + procedure For_Each_Invocation_Construct + (U_Id : Unit_Id; + Processor : Invocation_Construct_Processor_Ptr) + is + pragma Assert (Present (U_Id)); + pragma Assert (Processor /= null); + + U_Rec : Unit_Record renames Units.Table (U_Id); + + begin + for IC_Id in U_Rec.First_Invocation_Construct .. + U_Rec.Last_Invocation_Construct + loop + Processor.all (IC_Id); + end loop; + end For_Each_Invocation_Construct; + + ---------------------------------- + -- For_Each_Invocation_Relation -- + ---------------------------------- + + procedure For_Each_Invocation_Relation + (Processor : Invocation_Relation_Processor_Ptr) + is + begin + pragma Assert (Processor /= null); + + for IR_Id in Invocation_Relations.First .. + Invocation_Relations.Last + loop + Processor.all (IR_Id); + end loop; + end For_Each_Invocation_Relation; + + ---------------------------------- + -- For_Each_Invocation_Relation -- + ---------------------------------- + + procedure For_Each_Invocation_Relation + (U_Id : Unit_Id; + Processor : Invocation_Relation_Processor_Ptr) + is + pragma Assert (Present (U_Id)); + pragma Assert (Processor /= null); + + U_Rec : Unit_Record renames Units.Table (U_Id); + + begin + for IR_Id in U_Rec.First_Invocation_Relation .. + U_Rec.Last_Invocation_Relation + loop + Processor.all (IR_Id); + end loop; + end For_Each_Invocation_Relation; + + ---------- + -- Hash -- + ---------- + + function Hash + (IS_Rec : Invocation_Signature_Record) return Bucket_Range_Type + is + Buffer : Bounded_String (2052); + IS_Nam : Name_Id; + + begin + -- The hash is obtained in the following manner: + -- + -- * A String signature based on the scope, name, line number, column + -- number, and locations, in the following format: + -- + -- scope__name__line_column__locations + -- + -- * The String is converted into a Name_Id + -- * The Name_Id is used as the hash + + Append (Buffer, IS_Rec.Scope); + Append (Buffer, "__"); + Append (Buffer, IS_Rec.Name); + Append (Buffer, "__"); + Append (Buffer, IS_Rec.Line); + Append (Buffer, '_'); + Append (Buffer, IS_Rec.Column); + + if IS_Rec.Locations /= No_Name then + Append (Buffer, "__"); + Append (Buffer, IS_Rec.Locations); + end if; + + IS_Nam := Name_Find (Buffer); + return Bucket_Range_Type (IS_Nam); + end Hash; + -------------------- -- Initialize_ALI -- -------------------- @@ -90,18 +635,21 @@ -- Initialize all tables ALIs.Init; + Invocation_Constructs.Init; + Invocation_Relations.Init; + Invocation_Signatures.Init; + Linker_Options.Init; No_Deps.Init; - Units.Init; - Withs.Init; + Notes.Init; Sdep.Init; - Linker_Options.Init; - Notes.Init; - Xref_Section.Init; + Units.Init; + Version_Ref.Reset; + Withs.Init; Xref_Entity.Init; Xref.Init; - Version_Ref.Reset; - - -- Add dummy zero'th item in Linker_Options and Notes for sort calls + Xref_Section.Init; + + -- Add dummy zeroth item in Linker_Options and Notes for sort calls Linker_Options.Increment_Last; Notes.Increment_Last; @@ -125,6 +673,215 @@ Zero_Cost_Exceptions_Specified := False; end Initialize_ALI; + --------------------------------------- + -- Invocation_Construct_Kind_To_Code -- + --------------------------------------- + + function Invocation_Construct_Kind_To_Code + (Kind : Invocation_Construct_Kind) return Character + is + begin + return Invocation_Construct_Codes (Kind); + end Invocation_Construct_Kind_To_Code; + + ------------------------------- + -- Invocation_Graph_Encoding -- + ------------------------------- + + function Invocation_Graph_Encoding return Invocation_Graph_Encoding_Kind is + begin + return Compile_Time_Invocation_Graph_Encoding; + end Invocation_Graph_Encoding; + + -------------------------------------------- + -- Invocation_Graph_Encoding_Kind_To_Code -- + -------------------------------------------- + + function Invocation_Graph_Encoding_Kind_To_Code + (Kind : Invocation_Graph_Encoding_Kind) return Character + is + begin + return Invocation_Graph_Encoding_Codes (Kind); + end Invocation_Graph_Encoding_Kind_To_Code; + + ---------------------------------------- + -- Invocation_Graph_Line_Kind_To_Code -- + ---------------------------------------- + + function Invocation_Graph_Line_Kind_To_Code + (Kind : Invocation_Graph_Line_Kind) return Character + is + begin + return Invocation_Graph_Line_Codes (Kind); + end Invocation_Graph_Line_Kind_To_Code; + + ----------------------------- + -- Invocation_Kind_To_Code -- + ----------------------------- + + function Invocation_Kind_To_Code + (Kind : Invocation_Kind) return Character + is + begin + return Invocation_Codes (Kind); + end Invocation_Kind_To_Code; + + ----------------------------- + -- Invocation_Signature_Of -- + ----------------------------- + + function Invocation_Signature_Of + (Column : Nat; + Line : Nat; + Locations : Name_Id; + Name : Name_Id; + Scope : Name_Id) return Invocation_Signature_Id + is + IS_Rec : constant Invocation_Signature_Record := + (Column => Column, + Line => Line, + Locations => Locations, + Name => Name, + Scope => Scope); + IS_Id : Invocation_Signature_Id; + + begin + IS_Id := Sig_Map.Get (Sig_To_Sig_Map, IS_Rec); + + -- The invocation signature lacks an id. This indicates that it + -- is encountered for the first time during the construction of + -- the graph. + + if not Present (IS_Id) then + Invocation_Signatures.Append (IS_Rec); + IS_Id := Invocation_Signatures.Last; + + -- Map the invocation signature record to its corresponding id + + Sig_Map.Put (Sig_To_Sig_Map, IS_Rec, IS_Id); + end if; + + return IS_Id; + end Invocation_Signature_Of; + + ------------- + -- Invoker -- + ------------- + + function Invoker + (IR_Id : Invocation_Relation_Id) return Invocation_Signature_Id + is + begin + pragma Assert (Present (IR_Id)); + return Invocation_Relations.Table (IR_Id).Invoker; + end Invoker; + + ---------- + -- Kind -- + ---------- + + function Kind + (IC_Id : Invocation_Construct_Id) return Invocation_Construct_Kind + is + begin + pragma Assert (Present (IC_Id)); + return Invocation_Constructs.Table (IC_Id).Kind; + end Kind; + + ---------- + -- Kind -- + ---------- + + function Kind (IR_Id : Invocation_Relation_Id) return Invocation_Kind is + begin + pragma Assert (Present (IR_Id)); + return Invocation_Relations.Table (IR_Id).Kind; + end Kind; + + ---------- + -- Line -- + ---------- + + function Line (IS_Id : Invocation_Signature_Id) return Nat is + begin + pragma Assert (Present (IS_Id)); + return Invocation_Signatures.Table (IS_Id).Line; + end Line; + + --------------- + -- Locations -- + --------------- + + function Locations (IS_Id : Invocation_Signature_Id) return Name_Id is + begin + pragma Assert (Present (IS_Id)); + return Invocation_Signatures.Table (IS_Id).Locations; + end Locations; + + ---------- + -- Name -- + ---------- + + function Name (IS_Id : Invocation_Signature_Id) return Name_Id is + begin + pragma Assert (Present (IS_Id)); + return Invocation_Signatures.Table (IS_Id).Name; + end Name; + + ------------- + -- Present -- + ------------- + + function Present (IC_Id : Invocation_Construct_Id) return Boolean is + begin + return IC_Id /= No_Invocation_Construct; + end Present; + + ------------- + -- Present -- + ------------- + + function Present (IR_Id : Invocation_Relation_Id) return Boolean is + begin + return IR_Id /= No_Invocation_Relation; + end Present; + + ------------- + -- Present -- + ------------- + + function Present (IS_Id : Invocation_Signature_Id) return Boolean is + begin + return IS_Id /= No_Invocation_Signature; + end Present; + + ------------- + -- Present -- + ------------- + + function Present (Dep : Sdep_Id) return Boolean is + begin + return Dep /= No_Sdep_Id; + end Present; + + ------------- + -- Present -- + ------------- + + function Present (U_Id : Unit_Id) return Boolean is + begin + return U_Id /= No_Unit_Id; + end Present; + + ------------- + -- Present -- + ------------- + + function Present (W_Id : With_Id) return Boolean is + begin + return W_Id /= No_With_Id; + end Present; + -------------- -- Scan_ALI -- -------------- @@ -221,7 +978,7 @@ -- -- If Ignore_Special is False (normal case), the scan is terminated by -- a typeref bracket or an equal sign except for the special case of - -- an operator name starting with a double quote which is terminated + -- an operator name starting with a double quote that is terminated -- by another double quote. -- -- If May_Be_Quoted is True and the first non blank character is '"' @@ -256,6 +1013,9 @@ Standard_Entity : out Name_Id); -- Parse the definition of a typeref (<...>, {...} or (...)) + procedure Scan_Invocation_Graph_Line; + -- Parse a single line that encodes a piece of the invocation graph + procedure Skip_Eol; -- Skip past spaces, then skip past end of line (fatal error if not -- at end of line). Also skips past any following blank lines. @@ -771,6 +1531,239 @@ return T (P); end Nextc; + -------------------------------- + -- Scan_Invocation_Graph_Line -- + -------------------------------- + + procedure Scan_Invocation_Graph_Line is + procedure Scan_Invocation_Construct_Line; + pragma Inline (Scan_Invocation_Construct_Line); + -- Parse an invocation construct line and construct the corresponding + -- construct. The following data structures are updated: + -- + -- * Invocation_Constructs + -- * Units + + procedure Scan_Invocation_Graph_Attributes_Line; + pragma Inline (Scan_Invocation_Graph_Attributes_Line); + -- Parse an invocation-graph attributes line. The following data + -- structures are updated: + -- + -- * Units + + procedure Scan_Invocation_Relation_Line; + pragma Inline (Scan_Invocation_Relation_Line); + -- Parse an invocation relation line and construct the corresponding + -- relation. The following data structures are updated: + -- + -- * Invocation_Relations + -- * Units + + function Scan_Invocation_Signature return Invocation_Signature_Id; + pragma Inline (Scan_Invocation_Signature); + -- Parse a single invocation signature while populating the following + -- data structures: + -- + -- * Invocation_Signatures + -- * Sig_To_Sig_Map + + ------------------------------------ + -- Scan_Invocation_Construct_Line -- + ------------------------------------ + + procedure Scan_Invocation_Construct_Line is + Body_Placement : Declaration_Placement_Kind; + Kind : Invocation_Construct_Kind; + Signature : Invocation_Signature_Id; + Spec_Placement : Declaration_Placement_Kind; + + begin + -- construct-kind + + Kind := Code_To_Invocation_Construct_Kind (Getc); + Checkc (' '); + Skip_Space; + + -- construct-spec-placement + + Spec_Placement := Code_To_Declaration_Placement_Kind (Getc); + Checkc (' '); + Skip_Space; + + -- construct-body-placement + + Body_Placement := Code_To_Declaration_Placement_Kind (Getc); + Checkc (' '); + Skip_Space; + + -- construct-signature + + Signature := Scan_Invocation_Signature; + Skip_Eol; + + Add_Invocation_Construct + (Body_Placement => Body_Placement, + Kind => Kind, + Signature => Signature, + Spec_Placement => Spec_Placement); + end Scan_Invocation_Construct_Line; + + ------------------------------------------- + -- Scan_Invocation_Graph_Attributes_Line -- + ------------------------------------------- + + procedure Scan_Invocation_Graph_Attributes_Line is + begin + -- encoding-kind + + Set_Invocation_Graph_Encoding + (Code_To_Invocation_Graph_Encoding_Kind (Getc)); + Skip_Eol; + end Scan_Invocation_Graph_Attributes_Line; + + ----------------------------------- + -- Scan_Invocation_Relation_Line -- + ----------------------------------- + + procedure Scan_Invocation_Relation_Line is + Extra : Name_Id; + Invoker : Invocation_Signature_Id; + Kind : Invocation_Kind; + Target : Invocation_Signature_Id; + + begin + -- relation-kind + + Kind := Code_To_Invocation_Kind (Getc); + Checkc (' '); + Skip_Space; + + -- (extra-name | "none") + + Extra := Get_Name; + + if Extra = Name_None then + Extra := No_Name; + end if; + + Checkc (' '); + Skip_Space; + + -- invoker-signature + + Invoker := Scan_Invocation_Signature; + Checkc (' '); + Skip_Space; + + -- target-signature + + Target := Scan_Invocation_Signature; + Skip_Eol; + + Add_Invocation_Relation + (Extra => Extra, + Invoker => Invoker, + Kind => Kind, + Target => Target); + end Scan_Invocation_Relation_Line; + + ------------------------------- + -- Scan_Invocation_Signature -- + ------------------------------- + + function Scan_Invocation_Signature return Invocation_Signature_Id is + Column : Nat; + Line : Nat; + Locations : Name_Id; + Name : Name_Id; + Scope : Name_Id; + + begin + -- [ + + Checkc ('['); + + -- name + + Name := Get_Name; + Checkc (' '); + Skip_Space; + + -- scope + + Scope := Get_Name; + Checkc (' '); + Skip_Space; + + -- line + + Line := Get_Nat; + Checkc (' '); + Skip_Space; + + -- column + + Column := Get_Nat; + Checkc (' '); + Skip_Space; + + -- (locations | "none") + + Locations := Get_Name; + + if Locations = Name_None then + Locations := No_Name; + end if; + + -- ] + + Checkc (']'); + + -- Create an invocation signature from the scanned attributes + + return + Invocation_Signature_Of + (Column => Column, + Line => Line, + Locations => Locations, + Name => Name, + Scope => Scope); + end Scan_Invocation_Signature; + + -- Local variables + + Line : Invocation_Graph_Line_Kind; + + -- Start of processing for Scan_Invocation_Graph_Line + + begin + if Ignore ('G') then + return; + end if; + + Checkc (' '); + Skip_Space; + + -- line-kind + + Line := Code_To_Invocation_Graph_Line_Kind (Getc); + Checkc (' '); + Skip_Space; + + -- line-attributes + + case Line is + when Invocation_Construct_Line => + Scan_Invocation_Construct_Line; + + when Invocation_Graph_Attributes_Line => + Scan_Invocation_Graph_Attributes_Line; + + when Invocation_Relation_Line => + Scan_Invocation_Relation_Line; + end case; + end Scan_Invocation_Graph_Line; + -------------- -- Skip_Eol -- -------------- @@ -880,6 +1873,7 @@ First_Specific_Dispatching => Specific_Dispatching.Last + 1, First_Unit => No_Unit_Id, GNATprove_Mode => False, + Invocation_Graph_Encoding => No_Encoding, Last_Interrupt_State => Interrupt_States.Last, Last_Sdep => No_Sdep_Id, Last_Specific_Dispatching => Specific_Dispatching.Last, @@ -1716,38 +2710,42 @@ UL : Unit_Record renames Units.Table (Units.Last); begin - UL.Uname := Get_Unit_Name; - UL.Predefined := Is_Predefined_Unit; - UL.Internal := Is_Internal_Unit; - UL.My_ALI := Id; - UL.Sfile := Get_File_Name (Lower => True); - UL.Pure := False; - UL.Preelab := False; - UL.No_Elab := False; - UL.Shared_Passive := False; - UL.RCI := False; - UL.Remote_Types := False; - UL.Serious_Errors := False; - UL.Has_RACW := False; - UL.Init_Scalars := False; - UL.Is_Generic := False; - UL.Icasing := Mixed_Case; - UL.Kcasing := All_Lower_Case; - UL.Dynamic_Elab := False; - UL.Elaborate_Body := False; - UL.Set_Elab_Entity := False; - UL.Version := "00000000"; - UL.First_With := Withs.Last + 1; - UL.First_Arg := First_Arg; - UL.Elab_Position := 0; - UL.SAL_Interface := ALIs.Table (Id).SAL_Interface; - UL.Directly_Scanned := Directly_Scanned; - UL.Body_Needed_For_SAL := False; - UL.Elaborate_Body_Desirable := False; - UL.Optimize_Alignment := 'O'; - UL.Has_Finalizer := False; - UL.Primary_Stack_Count := 0; - UL.Sec_Stack_Count := 0; + UL.Uname := Get_Unit_Name; + UL.Predefined := Is_Predefined_Unit; + UL.Internal := Is_Internal_Unit; + UL.My_ALI := Id; + UL.Sfile := Get_File_Name (Lower => True); + UL.Pure := False; + UL.Preelab := False; + UL.No_Elab := False; + UL.Shared_Passive := False; + UL.RCI := False; + UL.Remote_Types := False; + UL.Serious_Errors := False; + UL.Has_RACW := False; + UL.Init_Scalars := False; + UL.Is_Generic := False; + UL.Icasing := Mixed_Case; + UL.Kcasing := All_Lower_Case; + UL.Dynamic_Elab := False; + UL.Elaborate_Body := False; + UL.Set_Elab_Entity := False; + UL.Version := "00000000"; + UL.First_With := Withs.Last + 1; + UL.First_Arg := First_Arg; + UL.First_Invocation_Construct := Invocation_Constructs.Last + 1; + UL.Last_Invocation_Construct := No_Invocation_Construct; + UL.First_Invocation_Relation := Invocation_Relations.Last + 1; + UL.Last_Invocation_Relation := No_Invocation_Relation; + UL.Elab_Position := 0; + UL.SAL_Interface := ALIs.Table (Id).SAL_Interface; + UL.Directly_Scanned := Directly_Scanned; + UL.Body_Needed_For_SAL := False; + UL.Elaborate_Body_Desirable := False; + UL.Optimize_Alignment := 'O'; + UL.Has_Finalizer := False; + UL.Primary_Stack_Count := 0; + UL.Sec_Stack_Count := 0; if Debug_Flag_U then Write_Str (" ----> reading unit "); @@ -2206,9 +3204,6 @@ Linker_Options.Table (Linker_Options.Last).Internal_File := Is_Internal_File_Name (F); - - Linker_Options.Table (Linker_Options.Last).Original_Pos := - Linker_Options.Last; end if; -- If there are notes present, scan them @@ -2444,6 +3439,17 @@ ALIs.Table (Id).Last_Sdep := Sdep.Last; + -- Loop through invocation-graph lines + + G_Loop : loop + Check_Unknown_Line; + exit G_Loop when C /= 'G'; + + Scan_Invocation_Graph_Line; + + C := Getc; + end loop G_Loop; + -- We must at this stage be at an Xref line or the end of file if C = EOF then @@ -2786,7 +3792,6 @@ -- Record last entity XS.Last_Entity := Xref_Entity.Last; - end Read_Refs_For_One_File; C := Getc; @@ -2806,6 +3811,16 @@ return No_ALI_Id; end Scan_ALI; + ----------- + -- Scope -- + ----------- + + function Scope (IS_Id : Invocation_Signature_Id) return Name_Id is + begin + pragma Assert (Present (IS_Id)); + return Invocation_Signatures.Table (IS_Id).Scope; + end Scope; + --------- -- SEq -- --------- @@ -2815,6 +3830,31 @@ return F1.all = F2.all; end SEq; + ----------------------------------- + -- Set_Invocation_Graph_Encoding -- + ----------------------------------- + + procedure Set_Invocation_Graph_Encoding + (Kind : Invocation_Graph_Encoding_Kind; + Update_Units : Boolean := True) + is + begin + Compile_Time_Invocation_Graph_Encoding := Kind; + + -- Update the invocation-graph encoding of the current unit only when + -- requested by the caller. + + if Update_Units then + declare + Curr_Unit : Unit_Record renames Units.Table (Units.Last); + Curr_ALI : ALIs_Record renames ALIs.Table (Curr_Unit.My_ALI); + + begin + Curr_ALI.Invocation_Graph_Encoding := Kind; + end; + end if; + end Set_Invocation_Graph_Encoding; + ----------- -- SHash -- ----------- @@ -2831,4 +3871,40 @@ return Vindex (Vindex'First + Vindex (H mod Vindex'Range_Length)); end SHash; + --------------- + -- Signature -- + --------------- + + function Signature + (IC_Id : Invocation_Construct_Id) return Invocation_Signature_Id + is + begin + pragma Assert (Present (IC_Id)); + return Invocation_Constructs.Table (IC_Id).Signature; + end Signature; + + -------------------- + -- Spec_Placement -- + -------------------- + + function Spec_Placement + (IC_Id : Invocation_Construct_Id) return Declaration_Placement_Kind + is + begin + pragma Assert (Present (IC_Id)); + return Invocation_Constructs.Table (IC_Id).Spec_Placement; + end Spec_Placement; + + ------------ + -- Target -- + ------------ + + function Target + (IR_Id : Invocation_Relation_Id) return Invocation_Signature_Id + is + begin + pragma Assert (Present (IR_Id)); + return Invocation_Relations.Table (IR_Id).Target; + end Target; + end ALI;