-- --
-- B o d y --
-- --
--- Copyright (C) 1992-2013, 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- --
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
- -- 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.
+ -----------
+ -- 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 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
- 'F' => True, -- SPARK cross-reference 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 --
--------------------
-- These two loops are empty and harmless the first time in.
for J in ALIs.First .. ALIs.Last loop
- Set_Name_Table_Info (ALIs.Table (J).Afile, 0);
+ Set_Name_Table_Int (ALIs.Table (J).Afile, 0);
end loop;
for J in Units.First .. Units.Last loop
- Set_Name_Table_Info (Units.Table (J).Uname, 0);
+ Set_Name_Table_Int (Units.Table (J).Uname, 0);
end loop;
-- Free argument table strings
-- Initialize all tables
ALIs.Init;
+ Invocation_Constructs.Init;
+ Invocation_Relations.Init;
+ Invocation_Signatures.Init;
+ Linker_Options.Init;
No_Deps.Init;
+ Notes.Init;
+ Sdep.Init;
Units.Init;
+ Version_Ref.Reset;
Withs.Init;
- Sdep.Init;
- Linker_Options.Init;
- Notes.Init;
- Xref_Section.Init;
Xref_Entity.Init;
Xref.Init;
- Version_Ref.Reset;
+ Xref_Section.Init;
- -- Add dummy zero'th item in Linker_Options and Notes for sort calls
+ -- Add dummy zeroth item in Linker_Options and Notes for sort calls
Linker_Options.Increment_Last;
Notes.Increment_Last;
-- ALI files that are read for a given processing run in gnatbind.
Dynamic_Elaboration_Checks_Specified := False;
- Float_Format_Specified := ' ';
Locking_Policy_Specified := ' ';
No_Normalize_Scalars_Specified := False;
No_Object_Specified := False;
+ No_Component_Reordering_Specified := False;
+ GNATprove_Mode_Specified := False;
Normalize_Scalars_Specified := False;
Partition_Elaboration_Policy_Specified := ' ';
Queuing_Policy_Specified := ' ';
- Static_Elaboration_Model_Used := False;
+ SSO_Default_Specified := False;
Task_Dispatching_Policy_Specified := ' ';
Unreserve_All_Interrupts_Specified := False;
+ Frontend_Exceptions_Specified := False;
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 --
--------------
--
-- 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 '"'
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.
Write_Str ("make sure you are using consistent versions " &
-- Split the following line so that it can easily be transformed for
- -- e.g. JVM/.NET back-ends where the compiler has a different name.
+ -- other back-ends where the compiler might have a different name.
"of gcc/gnatbind");
begin
loop
case Nextc is
- when '[' =>
+ when '[' =>
Nested_Brackets := Nested_Brackets + 1;
when ']' =>
Nested_Brackets := Nested_Brackets - 1;
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 --
--------------
if Read_Xref then
Ignore :=
- ('U' | 'W' | 'Y' | 'Z' | 'D' | 'X' => False, others => True);
+ ('T' | 'U' | 'W' | 'Y' | 'Z' | 'D' | 'X' => False, others => True);
-- Read_Lines parameter given
ALIs.Increment_Last;
Id := ALIs.Last;
- Set_Name_Table_Info (F, Int (Id));
+ Set_Name_Table_Int (F, Int (Id));
ALIs.Table (Id) := (
Afile => F,
First_Sdep => No_Sdep_Id,
First_Specific_Dispatching => Specific_Dispatching.Last + 1,
First_Unit => No_Unit_Id,
- Float_Format => 'I',
+ 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,
Main_Priority => -1,
Main_CPU => -1,
Main_Program => None,
+ No_Component_Reordering => False,
No_Object => False,
Normalize_Scalars => False,
Ofile_Full_Name => Full_Object_File_Name,
Restrictions => No_Restrictions,
SAL_Interface => False,
Sfile => No_File,
+ SSO_Default => ' ',
Task_Dispatching_Policy => ' ',
Time_Slice_Value => -1,
- Allocator_In_Body => False,
WC_Encoding => 'b',
Unit_Exception_Table => False,
Ver => (others => ' '),
Ver_Len => 0,
+ Frontend_Exceptions => False,
Zero_Cost_Exceptions => False);
-- Now we acquire the input lines from the ALI file. Note that the
Skip_Space;
- if Nextc = 'A' then
- P := P + 1;
- Checkc ('B');
- ALIs.Table (Id).Allocator_In_Body := True;
- end if;
-
- Skip_Space;
-
if Nextc = 'C' then
P := P + 1;
Checkc ('=');
ALIs.Table (Id).Partition_Elaboration_Policy :=
Partition_Elaboration_Policy_Specified;
- -- Processing for FD/FG/FI
+ -- Processing for FX
elsif C = 'F' then
- Float_Format_Specified := Getc;
- ALIs.Table (Id).Float_Format := Float_Format_Specified;
+ C := Getc;
+
+ if C = 'X' then
+ ALIs.Table (Id).Frontend_Exceptions := True;
+ Frontend_Exceptions_Specified := True;
+ else
+ Fatal_Error_Ignore;
+ end if;
+
+ -- Processing for GP
+
+ elsif C = 'G' then
+ Checkc ('P');
+ GNATprove_Mode_Specified := True;
+ ALIs.Table (Id).GNATprove_Mode := True;
-- Processing for Lx
elsif C = 'N' then
C := Getc;
+ -- Processing for NC
+
+ if C = 'C' then
+ ALIs.Table (Id).No_Component_Reordering := True;
+ No_Component_Reordering_Specified := True;
+
-- Processing for NO
- if C = 'O' then
+ elsif C = 'O' then
ALIs.Table (Id).No_Object := True;
No_Object_Specified := True;
Fatal_Error_Ignore;
end if;
+ -- Processing for OH/OL
+
+ elsif C = 'O' then
+ C := Getc;
+
+ if C = 'L' or else C = 'H' then
+ ALIs.Table (Id).SSO_Default := C;
+ SSO_Default_Specified := True;
+
+ else
+ Fatal_Error_Ignore;
+ end if;
+
-- Processing for Qx
elsif C = 'Q' then
C := Getc;
case C is
- when 'v' =>
- ALIs.Table (Id).Restrictions.Violated (R) := True;
- Cumulative_Restrictions.Violated (R) := True;
+ when 'v' =>
+ ALIs.Table (Id).Restrictions.Violated (R) := True;
+ Cumulative_Restrictions.Violated (R) := True;
- when 'r' =>
- ALIs.Table (Id).Restrictions.Set (R) := True;
- Cumulative_Restrictions.Set (R) := True;
+ when 'r' =>
+ ALIs.Table (Id).Restrictions.Set (R) := True;
+ Cumulative_Restrictions.Set (R) := True;
- when 'n' =>
- null;
+ when 'n' =>
+ null;
- when others =>
- raise Bad_R_Line;
+ when others =>
+ raise Bad_R_Line;
end case;
end loop;
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.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.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 ");
-- Check for duplicated unit in different files
declare
- Info : constant Int := Get_Name_Table_Info
+ Info : constant Int := Get_Name_Table_Int
(Units.Table (Units.Last).Uname);
begin
if Info /= 0
end if;
end;
- Set_Name_Table_Info
+ Set_Name_Table_Int
(Units.Table (Units.Last).Uname, Int (Units.Last));
-- Scan out possible version and other parameters
Check_At_End_Of_Field;
+ -- SE/SP/SU parameters
+
elsif C = 'S' then
C := Getc;
- if C = 'P' then
+ if C = 'E' then
+ Units.Table (Units.Last).Serious_Errors := True;
+ elsif C = 'P' then
Units.Table (Units.Last).Shared_Passive := True;
elsif C = 'U' then
Units.Table (Units.Last).Unit_Kind := 's';
Skip_Eol;
- -- Check if static elaboration model used
-
- if not Units.Table (Units.Last).Dynamic_Elab
- and then not Units.Table (Units.Last).Internal
- then
- Static_Elaboration_Model_Used := True;
- end if;
-
C := Getc;
-- Scan out With lines for this unit
Withs.Table (Withs.Last).Elab_All_Desirable := False;
Withs.Table (Withs.Last).SAL_Interface := False;
Withs.Table (Withs.Last).Limited_With := (C = 'Y');
- Withs.Table (Withs.Last).Implicit_With_From_Instantiation
- := (C = 'Z');
+ Withs.Table (Withs.Last).Implicit_With := (C = 'Z');
-- Generic case with no object file available
-- Store AD indication unless ignore required
if not Ignore_ED then
- Withs.Table (Withs.Last).Elab_All_Desirable :=
- True;
+ Withs.Table (Withs.Last).Elab_All_Desirable := True;
end if;
elsif Nextc = 'E' then
Units.Table (Units.Last).Last_With := Withs.Last;
Units.Table (Units.Last).Last_Arg := Args.Last;
+ -- Scan out task stack information for the unit if present
+
+ Check_Unknown_Line;
+
+ if C = 'T' then
+ if Ignore ('T') then
+ Skip_Line;
+
+ else
+ Checkc (' ');
+ Skip_Space;
+
+ Units.Table (Units.Last).Primary_Stack_Count := Get_Nat;
+ Skip_Space;
+ Units.Table (Units.Last).Sec_Stack_Count := Get_Nat;
+ Skip_Space;
+ Skip_Eol;
+ end if;
+
+ C := Getc;
+ end if;
+
-- If there are linker options lines present, scan them
Name_Len := 0;
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
Notes.Table (Notes.Last).Pragma_Line := Get_Nat;
Checkc (':');
Notes.Table (Notes.Last).Pragma_Col := Get_Nat;
- Notes.Table (Notes.Last).Unit := Units.Last;
+
+ if not At_Eol and then Nextc = ':' then
+ Checkc (':');
+ Notes.Table (Notes.Last).Pragma_Source_File :=
+ Get_File_Name (Lower => True);
+ else
+ Notes.Table (Notes.Last).Pragma_Source_File :=
+ Units.Table (Units.Last).Sfile;
+ end if;
if At_Eol then
Notes.Table (Notes.Last).Pragma_Args := No_Name;
else
+ -- Note: can't use Get_Name here as the remainder of the
+ -- line is unstructured text whose syntax depends on the
+ -- particular pragma used.
+
Checkc (' ');
Name_Len := 0;
while not At_Eol loop
Add_Char_To_Name_Buffer (Getc);
end loop;
-
- Notes.Table (Notes.Last).Pragma_Args := Name_Enter;
end if;
Skip_Eol;
else
-- Deal with body only and spec only cases, note that the reason we
-- do our own checking of the name (rather than using Is_Body_Name)
- -- is that Uname drags in far too much compiler junk!
+ -- is that Uname drags in far too much compiler junk.
Get_Name_String (Units.Table (Units.Last).Uname);
-- The file/path name may be quoted
Sdep.Table (Sdep.Last).Sfile :=
- Get_File_Name (May_Be_Quoted => True);
+ Get_File_Name (May_Be_Quoted => True);
Sdep.Table (Sdep.Last).Stamp := Get_Stamp;
Sdep.Table (Sdep.Last).Dummy_Entry :=
end if;
end;
- -- Acquire subunit and reference file name entries
+ -- Acquire (sub)unit and reference file name entries
Sdep.Table (Sdep.Last).Subunit_Name := No_Name;
+ Sdep.Table (Sdep.Last).Unit_Name := No_Name;
Sdep.Table (Sdep.Last).Rfile :=
Sdep.Table (Sdep.Last).Sfile;
Sdep.Table (Sdep.Last).Start_Line := 1;
if not At_Eol then
Skip_Space;
- -- Here for subunit name
+ -- Here for (sub)unit name
if Nextc not in '0' .. '9' then
Name_Len := 0;
Add_Char_To_Name_Buffer (Getc);
end loop;
- -- Set the subunit name. Note that we use Name_Find rather
+ -- Set the (sub)unit name. Note that we use Name_Find rather
-- than Name_Enter here as the subunit name may already
-- have been put in the name table by the Project Manager.
- Sdep.Table (Sdep.Last).Subunit_Name := Name_Find;
+ if Name_Len <= 2
+ or else Name_Buffer (Name_Len - 1) /= '%'
+ then
+ Sdep.Table (Sdep.Last).Subunit_Name := Name_Find;
+ else
+ Name_Len := Name_Len - 2;
+ Sdep.Table (Sdep.Last).Unit_Name := Name_Find;
+ end if;
Skip_Space;
end if;
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
-- Record last entity
XS.Last_Entity := Xref_Entity.Last;
-
end Read_Refs_For_One_File;
C := Getc;
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 --
---------
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 --
-----------
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;