This changes adds circuitry to the front-end that allows the code generated
for different instances of the same generic to be identified in debugging
information. This will subsequently be used to allow per-instance coverage
analysis.
Tested on x86_64-pc-linux-gnu, committed on trunk
2012-10-01 Thomas Quinot <[email protected]>
* sinput.ads, sinput.adb, sinput-l.adb sinput-c.adb (Sinput): New
Instances table, tracking all generic instantiations. Source file
attribute Instance replaces previous Instantiation attribute with an
index into the Instances table.
(Iterate_On_Instances): New generic procedure.
(Create_Instantiation_Source): Record instantiations in Instances.
(Tree_Read, Tree_Write): Read/write the instance table.
* scils.ads, scos.adb (SCO_Instance_Table): New table, contains
information copied from Sinput.Instance_Table, but self-contained
within the SCO data structures.
* par_sco.ads, par_sco.adb (To_Source_Location): Move to library level.
(Record_Instance): New subprogram, used by...
(Populate_SCO_Instance_Table): New subprogram to fill
the SCO instance table from the Sinput one (called by SCO_Output).
* opt.ads (Generate_SCO_Instance_Table): New option.
* put_scos.adb (Write_Instance_Table): New subprogram, used by...
(Put_SCOs): Dump the instance table at the end of SCO information
if requested.
* get_scos.adb (Get_SCOs): Read SCO_Instance_Table.
* types.h: Add declaration for Instance_Id.
* back_end.adb (Call_Back_End): Pass instance ids in source file
information table.
(Scan_Back_End_Switches): -fdebug-instances sets
Opt.Generate_SCO_Instance_Table.
* gcc-interface/gigi.h: File_Info_Type includes instance id.
* gcc-interface/trans.c: Under -fdebug-instances, set instance
id in line map from same in file info.
Index: par_sco.adb
===================================================================
--- par_sco.adb (revision 191888)
+++ par_sco.adb (working copy)
@@ -102,6 +102,9 @@
-- excluding OR and AND) and returns True if so, False otherwise, it does
-- no other processing.
+ function To_Source_Location (S : Source_Ptr) return Source_Location;
+ -- Converts Source_Ptr value to Source_Location (line/col) format
+
procedure Process_Decisions
(N : Node_Id;
T : Character;
@@ -138,6 +141,9 @@
end record;
No_Dominant : constant Dominant_Info := (' ', Empty);
+ procedure Record_Instance (Id : Instance_Id; Inst_Sloc : Source_Ptr);
+ -- Add one entry from the instance table to the corresponding SCO table
+
procedure Traverse_Declarations_Or_Statements
(L : List_Id;
D : Dominant_Info := No_Dominant;
@@ -696,16 +702,37 @@
Debug_Put_SCOs;
end pscos;
+ ---------------------
+ -- Record_Instance --
+ ---------------------
+
+ procedure Record_Instance (Id : Instance_Id; Inst_Sloc : Source_Ptr) is
+ Inst_Src : constant Source_File_Index :=
+ Get_Source_File_Index (Inst_Sloc);
+ begin
+ SCO_Instance_Table.Append
+ ((Inst_Dep_Num => Dependency_Num (Unit (Inst_Src)),
+ Inst_Loc => To_Source_Location (Inst_Sloc),
+ Enclosing_Instance => SCO_Instance_Index (Instance (Inst_Src))));
+ pragma Assert
+ (SCO_Instance_Table.Last = SCO_Instance_Index (Id));
+ end Record_Instance;
+
----------------
-- SCO_Output --
----------------
procedure SCO_Output is
+ procedure Populate_SCO_Instance_Table is
+ new Sinput.Iterate_On_Instances (Record_Instance);
+
begin
if Debug_Flag_Dot_OO then
dsco;
end if;
+ Populate_SCO_Instance_Table;
+
-- Sort the unit tables based on dependency numbers
Unit_Table_Sort : declare
@@ -949,26 +976,6 @@
Pragma_Sloc : Source_Ptr := No_Location;
Pragma_Name : Pragma_Id := Unknown_Pragma)
is
- function To_Source_Location (S : Source_Ptr) return Source_Location;
- -- Converts Source_Ptr value to Source_Location (line/col) format
-
- ------------------------
- -- To_Source_Location --
- ------------------------
-
- function To_Source_Location (S : Source_Ptr) return Source_Location is
- begin
- if S = No_Location then
- return No_Source_Location;
- else
- return
- (Line => Get_Logical_Line_Number (S),
- Col => Get_Column_Number (S));
- end if;
- end To_Source_Location;
-
- -- Start of processing for Set_Table_Entry
-
begin
SCO_Table.Append
((C1 => C1,
@@ -980,6 +987,21 @@
Pragma_Name => Pragma_Name));
end Set_Table_Entry;
+ ------------------------
+ -- To_Source_Location --
+ ------------------------
+
+ function To_Source_Location (S : Source_Ptr) return Source_Location is
+ begin
+ if S = No_Location then
+ return No_Source_Location;
+ else
+ return
+ (Line => Get_Logical_Line_Number (S),
+ Col => Get_Column_Number (S));
+ end if;
+ end To_Source_Location;
+
-----------------------------------------
-- Traverse_Declarations_Or_Statements --
-----------------------------------------
Index: par_sco.ads
===================================================================
--- par_sco.ads (revision 191888)
+++ par_sco.ads (working copy)
@@ -61,9 +61,9 @@
-- True if Loc is the source location of a disabled pragma
procedure SCO_Output;
- -- Outputs SCO lines for all units, with appropriate section headers, for
- -- unit U in the ALI file, as recorded by previous calls to SCO_Record,
- -- possibly modified by calls to Set_SCO_Condition.
+ -- Outputs SCO lines for all units, with appropriate section headers, as
+ -- recorded by previous calls to SCO_Record, possibly modified by calls to
+ -- Set_SCO_Condition.
procedure dsco;
-- Debug routine to dump internal SCO table. This is a raw format dump
Index: scos.adb
===================================================================
--- scos.adb (revision 191888)
+++ scos.adb (working copy)
@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
--- Copyright (C) 2009-2011, Free Software Foundation, Inc. --
+-- Copyright (C) 2009-2012, 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- --
@@ -33,6 +33,7 @@
begin
SCO_Table.Init;
SCO_Unit_Table.Init;
+ SCO_Instance_Table.Init;
-- Set dummy zeroth entry for sort routine, real entries start at 1
Index: scos.ads
===================================================================
--- scos.ads (revision 191888)
+++ scos.ads (working copy)
@@ -246,7 +246,7 @@
-- For each decision, a decision line is generated with the form:
- -- C* sloc expression [chaining]
+ -- C* sloc expression
-- Here * is one of the following characters:
@@ -308,35 +308,6 @@
-- condition, and that is true even if the Ada 2005 set membership
-- form is used, e.g. A in (2,7,11.15).
- -- The expression can be followed by chaining indicators of the form
- -- Tsloc-range or Fsloc-range, where the sloc-range is that of some
- -- entry on a CS line.
-
- -- T* is present when the statement with the given sloc range is executed
- -- if, and only if, the decision evaluates to TRUE.
-
- -- F* is present when the statement with the given sloc range is executed
- -- if, and only if, the decision evaluates to FALSE.
-
- -- For an IF statement or ELSIF part, a T chaining indicator is always
- -- present, with the sloc range of the first statement in the
- -- corresponding sequence.
-
- -- For an ELSE part, the last decision in the IF statement (that of the
- -- last ELSIF part, if any, or that of the IF statement if there is no
- -- ELSIF part) has an F chaining indicator with the sloc range of the
- -- first statement in the sequence of the ELSE part.
-
- -- For a WHILE loop, a T chaining indicator is always present, with the
- -- sloc range of the first statement in the loop, but no F chaining
- -- indicator is ever present.
-
- -- For an EXIT WHEN statement, an F chaining indicator is present if
- -- there is an immediately following sequence in the same sequence of
- -- statements.
-
- -- In all other cases, chaining indicators are omitted
-
-- Implementation permission: a SCO generator is permitted to emit a
-- narrower SLOC range for a condition if the corresponding code
-- generation circuitry ensures that all debug information for the code
@@ -360,6 +331,19 @@
-- entries appear in one logical statement sequence, continuation lines
-- are marked by Cc and appear immediately after the CC line.
+ -- Generic instances
+
+ -- A table of all generic instantiations in the compilation is generated
+ -- whose entries have the form:
+
+ -- C i index dependency-number|sloc [enclosing]
+
+ -- Where index is the 1-based index of the entry in the table,
+ -- dependency-number and sloc indicate the source location of the
+ -- instantiation, and enclosing is the index of the enclosing
+ -- instantiation in the table (for a nested instantiation), or is
+ -- omitted for an outer instantiation.
+
-- Disabled pragmas
-- No SCO is generated for disabled pragmas
@@ -471,12 +455,6 @@
-- To = ending source location
-- Last = False for all but the last entry, True for last entry
- -- Element (chaining indicator)
- -- C1 = 'H' (cHain)
- -- C2 = 'T' or 'F' (chaining on decision true/false)
- -- From = starting source location of chained statement
- -- To = ending source location of chained statement
-
-- Note: the sequence starting with a decision, and continuing with
-- operators and elements up to and including the first one labeled with
-- Last = True, indicate the sequence to be output on one decision line.
@@ -515,6 +493,27 @@
Table_Initial => 20,
Table_Increment => 200);
+ -----------------------
+ -- Generic instances --
+ -----------------------
+
+ type SCO_Instance_Index is new Nat;
+
+ type SCO_Instance_Table_Entry is record
+ Inst_Dep_Num : Nat;
+ Inst_Loc : Source_Location;
+ -- File and source location of instantiation
+
+ Enclosing_Instance : SCO_Instance_Index;
+ end record;
+
+ package SCO_Instance_Table is new GNAT.Table (
+ Table_Component_Type => SCO_Instance_Table_Entry,
+ Table_Index_Type => SCO_Instance_Index,
+ Table_Low_Bound => 1,
+ Table_Initial => 20,
+ Table_Increment => 200);
+
-----------------
-- Subprograms --
-----------------
Index: types.h
===================================================================
--- types.h (revision 191888)
+++ types.h (working copy)
@@ -6,7 +6,7 @@
* *
* C Header File *
* *
- * Copyright (C) 1992-2011, Free Software Foundation, Inc. *
+ * Copyright (C) 1992-2012, 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- *
@@ -130,6 +130,9 @@
/* Used for Sloc in all nodes in the representation of package Standard. */
#define Standard_Location -2
+/* Instance identifiers */
+typedef Nat Instance_Id;
+
/* Type used for union of all possible ID values covering all ranges */
typedef int Union_Id;
Index: put_scos.adb
===================================================================
--- put_scos.adb (revision 191888)
+++ put_scos.adb (working copy)
@@ -23,6 +23,7 @@
-- --
------------------------------------------------------------------------------
+with Opt; use Opt;
with Par_SCO; use Par_SCO;
with SCOs; use SCOs;
with Snames; use Snames;
@@ -34,6 +35,9 @@
procedure Write_SCO_Initiate (SU : SCO_Unit_Index);
-- Start SCO line for unit SU, also emitting SCO unit header if necessary
+ procedure Write_Instance_Table;
+ -- Output the SCO table of instances
+
procedure Output_Range (T : SCO_Table_Entry);
-- Outputs T.From and T.To in line:col-line:col format
@@ -76,6 +80,33 @@
end loop;
end Output_String;
+ --------------------------
+ -- Write_Instance_Table --
+ --------------------------
+
+ procedure Write_Instance_Table is
+ begin
+ for J in 1 .. SCO_Instance_Table.Last loop
+ declare
+ SIE : SCO_Instance_Table_Entry
+ renames SCO_Instance_Table.Table (J);
+ begin
+ Output_String ("C i ");
+ Write_Info_Nat (Nat (J));
+ Write_Info_Char (' ');
+ Write_Info_Nat (SIE.Inst_Dep_Num);
+ Write_Info_Char ('|');
+ Output_Source_Location (SIE.Inst_Loc);
+
+ if SIE.Enclosing_Instance > 0 then
+ Write_Info_Char (' ');
+ Write_Info_Nat (Nat (SIE.Enclosing_Instance));
+ end if;
+ Write_Info_Terminate;
+ end;
+ end loop;
+ end Write_Instance_Table;
+
------------------------
-- Write_SCO_Initiate --
------------------------
@@ -270,4 +301,8 @@
end loop;
end;
end loop;
+
+ if Opt.Generate_SCO_Instance_Table then
+ Write_Instance_Table;
+ end if;
end Put_SCOs;
Index: sinput-l.adb
===================================================================
--- sinput-l.adb (revision 191888)
+++ sinput-l.adb (working copy)
@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
--- Copyright (C) 1992-2010, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2012, 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- --
@@ -38,6 +38,8 @@
with Prepcomp; use Prepcomp;
with Scans; use Scans;
with Scn; use Scn;
+with Sem_Aux; use Sem_Aux;
+with Sem_Util; use Sem_Util;
with Sinfo; use Sinfo;
with Snames; use Snames;
with System; use System;
@@ -138,127 +140,191 @@
Source_File.Append (Source_File.Table (Xold));
Xnew := Source_File.Last;
- Source_File.Table (Xnew).Inlined_Body := Inlined_Body;
- Source_File.Table (Xnew).Instantiation := Sloc (Inst_Node);
- Source_File.Table (Xnew).Template := Xold;
+ declare
+ Sold : Source_File_Record renames Source_File.Table (Xold);
+ Snew : Source_File_Record renames Source_File.Table (Xnew);
- -- Now we need to compute the new values of Source_First, Source_Last
- -- and adjust the source file pointer to have the correct virtual
- -- origin for the new range of values.
+ Inst_Spec : Node_Id;
- Source_File.Table (Xnew).Source_First :=
- Source_File.Table (Xnew - 1).Source_Last + 1;
- A.Adjust := Source_File.Table (Xnew).Source_First - A.Lo;
- Source_File.Table (Xnew).Source_Last := A.Hi + A.Adjust;
+ begin
+ Snew.Inlined_Body := Inlined_Body;
+ Snew.Template := Xold;
- Set_Source_File_Index_Table (Xnew);
+ -- For a genuine generic instantiation, assign new instance id.
+ -- For inlined bodies, we retain that of the template, but we
+ -- save the call location.
- Source_File.Table (Xnew).Sloc_Adjust :=
- Source_File.Table (Xold).Sloc_Adjust - A.Adjust;
+ if Inlined_Body then
+ Snew.Inlined_Call := Sloc (Inst_Node);
- if Debug_Flag_L then
- Write_Eol;
- Write_Str ("*** Create instantiation source for ");
+ else
- if Nkind (Dnod) in N_Proper_Body
- and then Was_Originally_Stub (Dnod)
- then
- Write_Str ("subunit ");
+ -- If the spec has been instantiated already, and we are now
+ -- creating the instance source for the corresponding body now,
+ -- retrieve the instance id that was assigned to the spec, which
+ -- corresponds to the same instantiation sloc.
- elsif Ekind (Template_Id) = E_Generic_Package then
- if Nkind (Dnod) = N_Package_Body then
- Write_Str ("body of package ");
+ Inst_Spec := Instance_Spec (Inst_Node);
+ if Present (Inst_Spec) then
+ declare
+ Inst_Spec_Ent : Entity_Id;
+ -- Instance spec entity
+
+ Inst_Spec_Sloc : Source_Ptr;
+ -- Virtual sloc of the spec instance source
+
+ Inst_Spec_Inst_Id : Instance_Id;
+ -- Instance id assigned to the instance spec
+
+ begin
+ Inst_Spec_Ent := Defining_Entity (Inst_Spec);
+
+ -- For a subprogram instantiation, we want the subprogram
+ -- instance, not the wrapper package.
+
+ if Present (Related_Instance (Inst_Spec_Ent)) then
+ Inst_Spec_Ent := Related_Instance (Inst_Spec_Ent);
+ end if;
+
+ -- The specification of the instance entity has a virtual
+ -- sloc within the instance sloc range.
+ -- ??? But the Unit_Declaration_Node has the sloc of the
+ -- instantiation, which is somewhat of an oddity.
+
+ Inst_Spec_Sloc :=
+ Sloc (Specification (Unit_Declaration_Node
+ (Inst_Spec_Ent)));
+ Inst_Spec_Inst_Id :=
+ Source_File.Table
+ (Get_Source_File_Index (Inst_Spec_Sloc)).Instance;
+
+ pragma Assert
+ (Sloc (Inst_Node) = Instances.Table (Inst_Spec_Inst_Id));
+ Snew.Instance := Inst_Spec_Inst_Id;
+ end;
+
else
- Write_Str ("spec of package ");
+ Instances.Append (Sloc (Inst_Node));
+ Snew.Instance := Instances.Last;
end if;
+ end if;
- elsif Ekind (Template_Id) = E_Function then
- Write_Str ("body of function ");
+ -- Now we need to compute the new values of Source_First,
+ -- Source_Last and adjust the source file pointer to have the
+ -- correct virtual origin for the new range of values.
- elsif Ekind (Template_Id) = E_Procedure then
- Write_Str ("body of procedure ");
+ Snew.Source_First := Source_File.Table (Xnew - 1).Source_Last + 1;
+ A.Adjust := Snew.Source_First - A.Lo;
+ Snew.Source_Last := A.Hi + A.Adjust;
- elsif Ekind (Template_Id) = E_Generic_Function then
- Write_Str ("spec of function ");
+ Set_Source_File_Index_Table (Xnew);
- elsif Ekind (Template_Id) = E_Generic_Procedure then
- Write_Str ("spec of procedure ");
+ Snew.Sloc_Adjust := Sold.Sloc_Adjust - A.Adjust;
- elsif Ekind (Template_Id) = E_Package_Body then
- Write_Str ("body of package ");
+ if Debug_Flag_L then
+ Write_Eol;
+ Write_Str ("*** Create instantiation source for ");
- else pragma Assert (Ekind (Template_Id) = E_Subprogram_Body);
+ if Nkind (Dnod) in N_Proper_Body
+ and then Was_Originally_Stub (Dnod)
+ then
+ Write_Str ("subunit ");
- if Nkind (Dnod) = N_Procedure_Specification then
+ elsif Ekind (Template_Id) = E_Generic_Package then
+ if Nkind (Dnod) = N_Package_Body then
+ Write_Str ("body of package ");
+ else
+ Write_Str ("spec of package ");
+ end if;
+
+ elsif Ekind (Template_Id) = E_Function then
+ Write_Str ("body of function ");
+
+ elsif Ekind (Template_Id) = E_Procedure then
Write_Str ("body of procedure ");
- else
- Write_Str ("body of function ");
+
+ elsif Ekind (Template_Id) = E_Generic_Function then
+ Write_Str ("spec of function ");
+
+ elsif Ekind (Template_Id) = E_Generic_Procedure then
+ Write_Str ("spec of procedure ");
+
+ elsif Ekind (Template_Id) = E_Package_Body then
+ Write_Str ("body of package ");
+
+ else pragma Assert (Ekind (Template_Id) = E_Subprogram_Body);
+
+ if Nkind (Dnod) = N_Procedure_Specification then
+ Write_Str ("body of procedure ");
+ else
+ Write_Str ("body of function ");
+ end if;
end if;
- end if;
- Write_Name (Chars (Template_Id));
- Write_Eol;
+ Write_Name (Chars (Template_Id));
+ Write_Eol;
- Write_Str (" new source index = ");
- Write_Int (Int (Xnew));
- Write_Eol;
+ Write_Str (" new source index = ");
+ Write_Int (Int (Xnew));
+ Write_Eol;
- Write_Str (" copying from file name = ");
- Write_Name (File_Name (Xold));
- Write_Eol;
+ Write_Str (" copying from file name = ");
+ Write_Name (File_Name (Xold));
+ Write_Eol;
- Write_Str (" old source index = ");
- Write_Int (Int (Xold));
- Write_Eol;
+ Write_Str (" old source index = ");
+ Write_Int (Int (Xold));
+ Write_Eol;
- Write_Str (" old lo = ");
- Write_Int (Int (A.Lo));
- Write_Eol;
+ Write_Str (" old lo = ");
+ Write_Int (Int (A.Lo));
+ Write_Eol;
- Write_Str (" old hi = ");
- Write_Int (Int (A.Hi));
- Write_Eol;
+ Write_Str (" old hi = ");
+ Write_Int (Int (A.Hi));
+ Write_Eol;
- Write_Str (" new lo = ");
- Write_Int (Int (Source_File.Table (Xnew).Source_First));
- Write_Eol;
+ Write_Str (" new lo = ");
+ Write_Int (Int (Snew.Source_First));
+ Write_Eol;
- Write_Str (" new hi = ");
- Write_Int (Int (Source_File.Table (Xnew).Source_Last));
- Write_Eol;
+ Write_Str (" new hi = ");
+ Write_Int (Int (Snew.Source_Last));
+ Write_Eol;
- Write_Str (" adjustment factor = ");
- Write_Int (Int (A.Adjust));
- Write_Eol;
+ Write_Str (" adjustment factor = ");
+ Write_Int (Int (A.Adjust));
+ Write_Eol;
- Write_Str (" instantiation location: ");
- Write_Location (Sloc (Inst_Node));
- Write_Eol;
- end if;
+ Write_Str (" instantiation location: ");
+ Write_Location (Sloc (Inst_Node));
+ Write_Eol;
+ end if;
- -- For a given character in the source, a higher subscript will be used
- -- to access the instantiation, which means that the virtual origin must
- -- have a corresponding lower value. We compute this new origin by
- -- taking the address of the appropriate adjusted element in the old
- -- array. Since this adjusted element will be at a negative subscript,
- -- we must suppress checks.
+ -- For a given character in the source, a higher subscript will be
+ -- used to access the instantiation, which means that the virtual
+ -- origin must have a corresponding lower value. We compute this new
+ -- origin by taking the address of the appropriate adjusted element
+ -- in the old array. Since this adjusted element will be at a
+ -- negative subscript, we must suppress checks.
- declare
- pragma Suppress (All_Checks);
+ declare
+ pragma Suppress (All_Checks);
- pragma Warnings (Off);
- -- This unchecked conversion is aliasing safe, since it is never used
- -- to create improperly aliased pointer values.
+ pragma Warnings (Off);
+ -- This unchecked conversion is aliasing safe, since it is never
+ -- used to create improperly aliased pointer values.
- function To_Source_Buffer_Ptr is new
- Unchecked_Conversion (Address, Source_Buffer_Ptr);
+ function To_Source_Buffer_Ptr is new
+ Unchecked_Conversion (Address, Source_Buffer_Ptr);
- pragma Warnings (On);
+ pragma Warnings (On);
- begin
- Source_File.Table (Xnew).Source_Text :=
- To_Source_Buffer_Ptr
- (Source_File.Table (Xold).Source_Text (-A.Adjust)'Address);
+ begin
+ Snew.Source_Text :=
+ To_Source_Buffer_Ptr
+ (Sold.Source_Text (-A.Adjust)'Address);
+ end;
end;
end Create_Instantiation_Source;
@@ -433,9 +499,10 @@
Full_Debug_Name => Osint.Full_Source_Name,
Full_File_Name => Osint.Full_Source_Name,
Full_Ref_Name => Osint.Full_Source_Name,
+ Instance => No_Instance_Id,
Identifier_Casing => Unknown,
+ Inlined_Call => No_Location,
Inlined_Body => False,
- Instantiation => No_Location,
Keyword_Casing => Unknown,
Last_Source_Line => 1,
License => Unknown,
Index: sinput.adb
===================================================================
--- sinput.adb (revision 191888)
+++ sinput.adb (working copy)
@@ -477,8 +477,26 @@
First_Time_Around := True;
Source_File.Init;
+
+ Instances.Init;
+ Instances.Append (No_Location);
+ pragma Assert (Instances.Last = No_Instance_Id);
end Initialize;
+ -------------------
+ -- Instantiation --
+ -------------------
+
+ function Instantiation (S : SFI) return Source_Ptr is
+ SIE : Source_File_Record renames Source_File.Table (S);
+ begin
+ if SIE.Inlined_Body then
+ return SIE.Inlined_Call;
+ else
+ return Instances.Table (SIE.Instance);
+ end if;
+ end Instantiation;
+
-------------------------
-- Instantiation_Depth --
-------------------------
@@ -511,6 +529,17 @@
return Instantiation (Get_Source_File_Index (S));
end Instantiation_Location;
+ --------------------------
+ -- Iterate_On_Instances --
+ --------------------------
+
+ procedure Iterate_On_Instances is
+ begin
+ for J in 1 .. Instances.Last loop
+ Process (J, Instances.Table (J));
+ end loop;
+ end Iterate_On_Instances;
+
----------------------
-- Last_Source_File --
----------------------
@@ -852,7 +881,7 @@
Tmp1 : Source_Buffer_Ptr;
begin
- if S.Instantiation /= No_Location then
+ if S.Instance /= No_Instance_Id then
null;
else
@@ -887,9 +916,10 @@
Source_Cache_First := 1;
Source_Cache_Last := 0;
- -- Read in source file table
+ -- Read in source file table and instance table
Source_File.Tree_Read;
+ Instances.Tree_Read;
-- The pointers we read in there for the source buffer and lines
-- table pointers are junk. We now read in the actual data that
@@ -904,7 +934,7 @@
-- we share the data for the generic template entry. Since the
-- template always occurs first, we can safely refer to its data.
- if S.Instantiation /= No_Location then
+ if S.Instance /= No_Instance_Id then
declare
ST : Source_File_Record renames
Source_File.Table (S.Template);
@@ -1004,6 +1034,7 @@
procedure Tree_Write is
begin
Source_File.Tree_Write;
+ Instances.Tree_Write;
-- The pointers we wrote out there for the source buffer and lines
-- table pointers are junk, we now write out the actual data that
@@ -1018,7 +1049,7 @@
-- shared with the generic template. When the tree is read, the
-- pointers must be set, but no extra data needs to be written.
- if S.Instantiation /= No_Location then
+ if S.Instance /= No_Instance_Id then
null;
-- For the normal case, write out the data of the tables
@@ -1131,6 +1162,11 @@
return Source_File.Table (S).Debug_Source_Name;
end Debug_Source_Name;
+ function Instance (S : SFI) return Instance_Id is
+ begin
+ return Source_File.Table (S).Instance;
+ end Instance;
+
function File_Name (S : SFI) return File_Name_Type is
begin
return Source_File.Table (S).File_Name;
@@ -1171,10 +1207,10 @@
return Source_File.Table (S).Inlined_Body;
end Inlined_Body;
- function Instantiation (S : SFI) return Source_Ptr is
+ function Inlined_Call (S : SFI) return Source_Ptr is
begin
- return Source_File.Table (S).Instantiation;
- end Instantiation;
+ return Source_File.Table (S).Inlined_Call;
+ end Inlined_Call;
function Keyword_Casing (S : SFI) return Casing_Type is
begin
Index: sinput.ads
===================================================================
--- sinput.ads (revision 191888)
+++ sinput.ads (working copy)
@@ -83,6 +83,9 @@
Preproc);
-- Source file with preprocessing commands to be preprocessed
+ type Instance_Id is new Nat;
+ No_Instance_Id : constant Instance_Id;
+
----------------------------
-- Source License Control --
----------------------------
@@ -198,6 +201,12 @@
-- Only processing in Sprint that generates this file is permitted to
-- set this field.
+ -- Instance : Instance_Id (read-only)
+ -- For entries corresponding to a generic instantiation, unique
+ -- identifier denoting the full chain of nested instantiations. Set to
+ -- No_Instance_Id for the case of a normal, non-instantiation entry.
+ -- See below for details on the handling of generic instantiations.
+
-- License : License_Type;
-- License status of source file
@@ -249,16 +258,16 @@
-- This value is used for formatting of error messages, and also is used
-- in the detection of keywords misused as identifiers.
- -- Instantiation : Source_Ptr;
- -- Source file location of the instantiation if this source file entry
- -- represents a generic instantiation. Set to No_Location for the case
- -- of a normal non-instantiation entry. See section below for details.
+ -- Inlined_Call : Source_Ptr;
+ -- Source file location of the subprogram call if this source file entry
+ -- represents an inlined body. Set to No_Location otherwise.
-- This field is read-only for clients.
-- Inlined_Body : Boolean;
-- This can only be set True if Instantiation has a value other than
-- No_Location. If true it indicates that the instantiation is actually
-- an instance of an inlined body.
+ -- ??? Redundant, always equal to (Inlined_Call /= No_Location)
-- Template : Source_File_Index; (read-only)
-- Source file index of the source file containing the template if this
@@ -289,7 +298,8 @@
function Full_Ref_Name (S : SFI) return File_Name_Type;
function Identifier_Casing (S : SFI) return Casing_Type;
function Inlined_Body (S : SFI) return Boolean;
- function Instantiation (S : SFI) return Source_Ptr;
+ function Inlined_Call (S : SFI) return Source_Ptr;
+ function Instance (S : SFI) return Instance_Id;
function Keyword_Casing (S : SFI) return Casing_Type;
function Last_Source_Line (S : SFI) return Physical_Line_Number;
function License (S : SFI) return License_Type;
@@ -408,17 +418,31 @@
-- to point to the same text, because of the virtual origin pointers used
-- in the source table.
- -- The Instantiation field of this source file index entry, usually set
- -- to No_Source_File, instead contains the Sloc of the instantiation. In
- -- the case of nested instantiations, this Sloc may itself refer to an
- -- instantiation, so the complete chain can be traced.
+ -- The Instantiation_Id field of this source file index entry, set
+ -- to No_Instance_Id for normal entries, instead contains a value that
+ -- uniquely identifies a particular instantiation, and the associated
+ -- entry in the Instances table. The source location of the instantiation
+ -- can be retrieved using function Instantiation below. In the case of
+ -- nested instantiations, the Instances table can be used to trace the
+ -- complete chain of nested instantiations.
- -- Two routines are used to build these special entries in the source
- -- file table. Create_Instantiation_Source is first called to build
+ -- Two routines are used to build the special instance entries in the
+ -- source file table. Create_Instantiation_Source is first called to build
-- the virtual source table entry for the instantiation, and then the
-- Sloc values in the copy are adjusted using Adjust_Instantiation_Sloc.
-- See child unit Sinput.L for details on these two routines.
+ generic
+ with procedure Process (Id : Instance_Id; Inst_Sloc : Source_Ptr);
+ procedure Iterate_On_Instances;
+ -- Execute Process for each entry in the instance table
+
+ function Instantiation (S : SFI) return Source_Ptr;
+ -- For a source file entry that represents an inlined body, source location
+ -- of the inlined call. Otherwise, for a source file entry that represents
+ -- a generic instantiation, source location of the instantiation. Returns
+ -- No_Location in all other cases.
+
-----------------
-- Global Data --
-----------------
@@ -722,26 +746,38 @@
private
pragma Inline (File_Name);
- pragma Inline (First_Mapped_Line);
pragma Inline (Full_File_Name);
- pragma Inline (Identifier_Casing);
- pragma Inline (Instantiation);
- pragma Inline (Keyword_Casing);
- pragma Inline (Last_Source_Line);
- pragma Inline (Last_Source_File);
+ pragma Inline (File_Type);
+ pragma Inline (Reference_Name);
+ pragma Inline (Full_Ref_Name);
+ pragma Inline (Debug_Source_Name);
+ pragma Inline (Full_Debug_Name);
+ pragma Inline (Instance);
pragma Inline (License);
pragma Inline (Num_SRef_Pragmas);
- pragma Inline (Num_Source_Files);
- pragma Inline (Num_Source_Lines);
- pragma Inline (Reference_Name);
- pragma Inline (Set_Keyword_Casing);
- pragma Inline (Set_Identifier_Casing);
+ pragma Inline (First_Mapped_Line);
+ pragma Inline (Source_Text);
pragma Inline (Source_First);
pragma Inline (Source_Last);
- pragma Inline (Source_Text);
+ pragma Inline (Time_Stamp);
+ pragma Inline (Source_Checksum);
+ pragma Inline (Last_Source_Line);
+ pragma Inline (Keyword_Casing);
+ pragma Inline (Identifier_Casing);
+ pragma Inline (Inlined_Call);
+ pragma Inline (Inlined_Body);
pragma Inline (Template);
- pragma Inline (Time_Stamp);
+ pragma Inline (Unit);
+ pragma Inline (Set_Keyword_Casing);
+ pragma Inline (Set_Identifier_Casing);
+
+ pragma Inline (Last_Source_File);
+ pragma Inline (Num_Source_Files);
+ pragma Inline (Num_Source_Lines);
+
+ No_Instance_Id : constant Instance_Id := 0;
+
-------------------------
-- Source_Lines Tables --
-------------------------
@@ -781,6 +817,7 @@
Full_Debug_Name : File_Name_Type;
Full_File_Name : File_Name_Type;
Full_Ref_Name : File_Name_Type;
+ Instance : Instance_Id;
Num_SRef_Pragmas : Nat;
First_Mapped_Line : Logical_Line_Number;
Source_Text : Source_Buffer_Ptr;
@@ -788,11 +825,11 @@
Source_Last : Source_Ptr;
Source_Checksum : Word;
Last_Source_Line : Physical_Line_Number;
- Instantiation : Source_Ptr;
Template : Source_File_Index;
Unit : Unit_Number_Type;
Time_Stamp : Time_Stamp_Type;
File_Type : Type_Of_File;
+ Inlined_Call : Source_Ptr;
Inlined_Body : Boolean;
License : License_Type;
Keyword_Casing : Casing_Type;
@@ -839,17 +876,18 @@
Full_Debug_Name at 12 range 0 .. 31;
Full_File_Name at 16 range 0 .. 31;
Full_Ref_Name at 20 range 0 .. 31;
+ Instance at 48 range 0 .. 31;
Num_SRef_Pragmas at 24 range 0 .. 31;
First_Mapped_Line at 28 range 0 .. 31;
Source_First at 32 range 0 .. 31;
Source_Last at 36 range 0 .. 31;
Source_Checksum at 40 range 0 .. 31;
Last_Source_Line at 44 range 0 .. 31;
- Instantiation at 48 range 0 .. 31;
Template at 52 range 0 .. 31;
Unit at 56 range 0 .. 31;
Time_Stamp at 60 range 0 .. 8 * Time_Stamp_Length - 1;
File_Type at 74 range 0 .. 7;
+ Inlined_Call at 88 range 0 .. 31;
Inlined_Body at 75 range 0 .. 7;
License at 76 range 0 .. 7;
Keyword_Casing at 77 range 0 .. 7;
@@ -860,12 +898,12 @@
-- The following fields are pointers, so we have to specialize their
-- lengths using pointer size, obtained above as Standard'Address_Size.
- Source_Text at 88 range 0 .. AS - 1;
- Lines_Table at 88 range AS .. AS * 2 - 1;
- Logical_Lines_Table at 88 range AS * 2 .. AS * 3 - 1;
+ Source_Text at 92 range 0 .. AS - 1;
+ Lines_Table at 92 range AS .. AS * 2 - 1;
+ Logical_Lines_Table at 92 range AS * 2 .. AS * 3 - 1;
end record;
- for Source_File_Record'Size use 88 * 8 + AS * 3;
+ for Source_File_Record'Size use 92 * 8 + AS * 3;
-- This ensures that we did not leave out any fields
package Source_File is new Table.Table (
@@ -876,6 +914,17 @@
Table_Increment => Alloc.Source_File_Increment,
Table_Name => "Source_File");
+ -- Auxiliary table containing source location of instantiations. Index 0
+ -- is used for code that does not come from an instance.
+
+ package Instances is new Table.Table (
+ Table_Component_Type => Source_Ptr,
+ Table_Index_Type => Instance_Id,
+ Table_Low_Bound => 0,
+ Table_Initial => Alloc.Source_File_Initial,
+ Table_Increment => Alloc.Source_File_Increment,
+ Table_Name => "Instances");
+
-----------------
-- Subprograms --
-----------------
Index: get_scos.adb
===================================================================
--- get_scos.adb (revision 191888)
+++ get_scos.adb (working copy)
@@ -225,7 +225,7 @@
case C is
- -- Header entry
+ -- Header or instance table entry
when ' ' =>
@@ -236,27 +236,72 @@
SCO_Table.Last;
end if;
- -- Scan out dependency number and file name
-
Skip_Spaces;
- Dnum := Get_Int;
- Skip_Spaces;
+ case Nextc is
- N := 0;
- while Nextc > ' ' loop
- N := N + 1;
- Buf (N) := Getc;
- end loop;
+ -- Instance table entry
- -- Make new unit table entry (will fill in To later)
+ when 'i' =>
+ declare
+ Inum : SCO_Instance_Index;
+ begin
+ Skipc;
+ Skip_Spaces;
- SCO_Unit_Table.Append (
- (File_Name => new String'(Buf (1 .. N)),
- Dep_Num => Dnum,
- From => SCO_Table.Last + 1,
- To => 0));
+ Inum := SCO_Instance_Index (Get_Int);
+ SCO_Instance_Table.Increment_Last;
+ pragma Assert (SCO_Instance_Table.Last = Inum);
+ Skip_Spaces;
+ declare
+ SIE : SCO_Instance_Table_Entry
+ renames SCO_Instance_Table.Table (Inum);
+ begin
+ SIE.Inst_Dep_Num := Get_Int;
+ C := Getc;
+ pragma Assert (C = '|');
+ Get_Source_Location (SIE.Inst_Loc);
+
+ if not At_EOL then
+ Skip_Spaces;
+ SIE.Enclosing_Instance :=
+ SCO_Instance_Index (Get_Int);
+ pragma Assert (SIE.Enclosing_Instance in
+ SCO_Instance_Table.First
+ .. SCO_Instance_Table.Last);
+ end if;
+ end;
+ end;
+
+ -- Unit header
+
+ when '0' .. '9' =>
+ -- Scan out dependency number and file name
+
+ Dnum := Get_Int;
+
+ Skip_Spaces;
+
+ N := 0;
+ while Nextc > ' ' loop
+ N := N + 1;
+ Buf (N) := Getc;
+ end loop;
+
+ -- Make new unit table entry (will fill in To later)
+
+ SCO_Unit_Table.Append (
+ (File_Name => new String'(Buf (1 .. N)),
+ Dep_Num => Dnum,
+ From => SCO_Table.Last + 1,
+ To => 0));
+
+ when others =>
+ raise Program_Error;
+
+ end case;
+
-- Statement entry
when 'S' | 's' =>
Index: back_end.adb
===================================================================
--- back_end.adb (revision 191888)
+++ back_end.adb (working copy)
@@ -76,6 +76,7 @@
type File_Info_Type is record
File_Name : File_Name_Type;
+ Instance : Instance_Id;
Num_Source_Lines : Nat;
end record;
@@ -119,6 +120,7 @@
for J in 1 .. Last_Source_File loop
File_Info_Array (J).File_Name := Full_Debug_Name (J);
+ File_Info_Array (J).Instance := Instance (J);
File_Info_Array (J).Num_Source_Lines :=
Nat (Physical_To_Logical (Last_Source_Line (J), J));
end loop;
@@ -243,6 +245,12 @@
elsif Switch_Chars (First .. Last) = "fdump-scos" then
Opt.Generate_SCO := True;
+ -- Back end switch -fdebug-instances also enables instance table
+ -- SCO generation.
+
+ elsif Switch_Chars (First .. Last) = "fdebug-instances" then
+ Opt.Generate_SCO_Instance_Table := True;
+
end if;
end if;
end Scan_Back_End_Switches;
Index: sinput-c.adb
===================================================================
--- sinput-c.adb (revision 191888)
+++ sinput-c.adb (working copy)
@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
--- Copyright (C) 1992-2010, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2012, 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- --
@@ -178,9 +178,10 @@
Full_Debug_Name => Path_Id,
Full_File_Name => Path_Id,
Full_Ref_Name => Path_Id,
+ Instance => No_Instance_Id,
Identifier_Casing => Unknown,
+ Inlined_Call => No_Location,
Inlined_Body => False,
- Instantiation => No_Location,
Keyword_Casing => Unknown,
Last_Source_Line => 1,
License => Unknown,
Index: opt.ads
===================================================================
--- opt.ads (revision 191902)
+++ opt.ads (working copy)
@@ -648,10 +648,15 @@
Generate_SCO : Boolean := False;
-- GNAT
- -- True when switch -gnateS is used. When True, Source Coverage Obligation
- -- (SCO) information is generated and output in the ALI file. See unit
- -- Par_SCO for full details.
+ -- True when switch -fdump-scos (or -gnateS) is used. When True, Source
+ -- Coverage Obligation (SCO) information is generated and output in the ALI
+ -- file. See unit Par_SCO for full details.
+ Generate_SCO_Instance_Table : Boolean := False;
+ -- GNAT
+ -- True when switch -fdebug-instances is used. When True, a table of
+ -- instances is included in SCOs.
+
Generating_Code : Boolean := False;
-- GNAT
-- True if the frontend finished its work and has called the backend to
Index: gcc-interface/gigi.h
===================================================================
--- gcc-interface/gigi.h (revision 191888)
+++ gcc-interface/gigi.h (working copy)
@@ -228,7 +228,8 @@
struct File_Info_Type
{
File_Name_Type File_Name;
- Nat Num_Source_Lines;
+ Instance_Id Instance;
+ Nat Num_Source_Lines;
};
#ifdef __cplusplus
Index: gcc-interface/trans.c
===================================================================
--- gcc-interface/trans.c (revision 191888)
+++ gcc-interface/trans.c (working copy)
@@ -293,6 +293,7 @@
tree int64_type = gnat_type_for_size (64, 0);
struct elab_info *info;
int i;
+ struct line_map *map;
max_gnat_nodes = max_gnat_node;
@@ -325,7 +326,12 @@
/* We create the line map for a source file at once, with a fixed number
of columns chosen to avoid jumping over the next power of 2. */
- linemap_add (line_table, LC_ENTER, 0, filename, 1);
+ map = (struct line_map *) linemap_add
+ (line_table, LC_ENTER, 0, filename, 1);
+#ifdef ORDINARY_MAP_INSTANCE
+ if (flag_debug_instances)
+ ORDINARY_MAP_INSTANCE(map) = file_info_ptr[i].Instance;
+#endif
linemap_line_start (line_table, file_info_ptr[i].Num_Source_Lines, 252);
linemap_position_for_column (line_table, 252 - 1);
linemap_add (line_table, LC_LEAVE, 0, NULL, 0);
