Patchwork [Ada] Front-end support for per-instance coverage analysis

login
register
mail settings
Submitter Arnaud Charlet
Date Oct. 1, 2012, 9:22 a.m.
Message ID <20121001092226.GA24542@adacore.com>
Download mbox | patch
Permalink /patch/188247/
State New
Headers show

Comments

Arnaud Charlet - Oct. 1, 2012, 9:22 a.m.
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  <quinot@adacore.com>

	* 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.

Patch

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