Patchwork [Ada] Add a link between body and spec scopes in ALFA section of ALI file

login
register
mail settings
Submitter Arnaud Charlet
Date Aug. 3, 2011, 10 a.m.
Message ID <20110803100006.GA27782@adacore.com>
Download mbox | patch
Permalink /patch/108084/
State New
Headers show

Comments

Arnaud Charlet - Aug. 3, 2011, 10 a.m.
In order to be able to reconstruct the information in back-ends which do not
have access to all the code, it is necessary that body scopes refer to their
spec scope when different. This has been added to the ALFA scope section of the
ALI file.

Tested on x86_64-pc-linux-gnu, committed on trunk

2011-08-03  Yannick Moy  <moy@adacore.com>

	* alfa.ads Update format of ALFA section in ALI file in order to add a
	mapping from bodies to specs when both are present
	(ALFA_Scope_Record): add components for spec file/scope
	* get_alfa.adb (Get_ALFA): read the new file/scope for spec when present
	* lib-xref-alfa.adb
	(Collect_ALFA): after all scopes have been collected, fill in the spec
	 information when relevant
	* put_alfa.adb (Put_ALFA): write the new file/scope for spec when
	present.

Patch

Index: alfa.ads
===================================================================
--- alfa.ads	(revision 177239)
+++ alfa.ads	(working copy)
@@ -89,7 +89,7 @@ 
    --      reading of the ALFA information, and means that the ALFA information
    --      can stand on its own without needing other parts of the ALI file.
 
-   --    FS . scope line type col entity
+   --    FS . scope line type col entity (-> spec-file . spec-scope)?
 
    --      scope is the ones-origin scope number for the current file (e.g. 2 =
    --      reference to the second FS line in this FD block).
@@ -113,6 +113,9 @@ 
    --      entity is the name of the scope entity, with casing in the canonical
    --      casing for the source file where it is defined.
 
+   --      spec-file and spec-scope are respectively the file and scope for the
+   --      spec corresponding to the current body scope, when they differ.
+
    --  ------------------
    --  -- Xref Section --
    --  ------------------
@@ -234,6 +237,14 @@ 
       Scope_Num : Nat;
       --  Set to the scope number for the scope
 
+      Spec_File_Num : Nat;
+      --  Set to the file dependency number for the scope corresponding to the
+      --  spec of the current scope entity, if different, or else 0.
+
+      Spec_Scope_Num : Nat;
+      --  Set to the scope number for the scope corresponding to the spec of
+      --  the current scope entity, if different, or else 0.
+
       Line : Nat;
       --  Line number for the scope
 
Index: put_alfa.adb
===================================================================
--- put_alfa.adb	(revision 177255)
+++ put_alfa.adb	(working copy)
@@ -78,6 +78,16 @@ 
                   Write_Info_Char (S.Scope_Name (N));
                end loop;
 
+               if S.Spec_File_Num /= 0 then
+                  Write_Info_Char (' ');
+                  Write_Info_Char ('-');
+                  Write_Info_Char ('>');
+                  Write_Info_Char (' ');
+                  Write_Info_Nat (S.Spec_File_Num);
+                  Write_Info_Char ('.');
+                  Write_Info_Nat (S.Spec_Scope_Num);
+               end if;
+
                Write_Info_Terminate;
             end;
 
Index: lib-xref-alfa.adb
===================================================================
--- lib-xref-alfa.adb	(revision 177255)
+++ lib-xref-alfa.adb	(working copy)
@@ -140,6 +140,9 @@ 
       's' => True,
       others => False);
 
+   type Entity_Hashed_Range is range 0 .. 255;
+   --  Size of hash table headers
+
    -----------------------
    -- Local Subprograms --
    -----------------------
@@ -155,6 +158,9 @@ 
    --  Filter table Xrefs to add all references used in ALFA to the table
    --  ALFA_Xref_Table.
 
+   function Entity_Hash (E : Entity_Id) return Entity_Hashed_Range;
+   --  Hash function for hash table
+
    procedure Traverse_Declarations_Or_Statements  (L : List_Id);
    procedure Traverse_Handled_Statement_Sequence  (N : Node_Id);
    procedure Traverse_Package_Body                (N : Node_Id);
@@ -339,15 +345,17 @@ 
       --  filled even later, but are initialized to represent an empty range.
 
       ALFA_Scope_Table.Append (
-        (Scope_Name   => new String'(Exact_Source_Name (Sloc (E))),
-         File_Num     => 0,
-         Scope_Num    => 0,
-         Line         => Nat (Get_Logical_Line_Number (Loc)),
-         Stype        => Typ,
-         Col          => Nat (Get_Column_Number (Loc)),
-         From_Xref    => 1,
-         To_Xref      => 0,
-         Scope_Entity => E));
+        (Scope_Name     => new String'(Exact_Source_Name (Sloc (E))),
+         File_Num       => 0,
+         Scope_Num      => 0,
+         Spec_File_Num  => 0,
+         Spec_Scope_Num => 0,
+         Line           => Nat (Get_Logical_Line_Number (Loc)),
+         Stype          => Typ,
+         Col            => Nat (Get_Column_Number (Loc)),
+         From_Xref      => 1,
+         To_Xref        => 0,
+         Scope_Entity   => E));
    end Add_ALFA_Scope;
 
    --------------------
@@ -367,36 +375,37 @@ 
          procedure Set_Scope_Num (N : Entity_Id; Num : Nat);
       end Scopes;
 
+      ------------
+      -- Scopes --
+      ------------
+
       package body Scopes is
          type Scope is record
             Num    : Nat;
             Entity : Entity_Id;
          end record;
 
-         type Scope_Hashed is range 0 .. 255;
-
-         function Scope_Hash (E : Entity_Id) return Scope_Hashed;
-
-         function Scope_Hash (E : Entity_Id) return Scope_Hashed is
-            Value  : constant Int := Int (E);
-            Modulo : constant Int := Int (Scope_Hashed'Last) + 1;
-         begin
-            return Scope_Hashed (Value - (Value / Modulo) * Modulo);
-         end Scope_Hash;
-
          package Scopes is new GNAT.HTable.Simple_HTable
-           (Header_Num => Scope_Hashed,
+           (Header_Num => Entity_Hashed_Range,
             Element    => Scope,
             No_Element => (Num => No_Scope, Entity => Empty),
             Key        => Entity_Id,
-            Hash       => Scope_Hash,
+            Hash       => Entity_Hash,
             Equal      => "=");
 
+         -------------------
+         -- Get_Scope_Num --
+         -------------------
+
          function Get_Scope_Num (N : Entity_Id) return Nat is
          begin
             return Scopes.Get (N).Num;
          end Get_Scope_Num;
 
+         -------------------
+         -- Set_Scope_Num --
+         -------------------
+
          procedure Set_Scope_Num (N : Entity_Id; Num : Nat) is
          begin
             Scopes.Set (K => N, E => Scope'(Num => Num, Entity => N));
@@ -782,11 +791,83 @@ 
          end if;
       end loop;
 
+      --  Fill in the spec information when relevant
+
+      declare
+         package Entity_Hash_Table is new
+           GNAT.HTable.Simple_HTable
+             (Header_Num => Entity_Hashed_Range,
+              Element    => Scope_Index,
+              No_Element => 0,
+              Key        => Entity_Id,
+              Hash       => Entity_Hash,
+              Equal      => "=");
+
+      begin
+         --  Fill in the hash-table
+
+         for S in ALFA_Scope_Table.First .. ALFA_Scope_Table.Last loop
+            declare
+               Srec : ALFA_Scope_Record renames ALFA_Scope_Table.Table (S);
+            begin
+               Entity_Hash_Table.Set (Srec.Scope_Entity, S);
+            end;
+         end loop;
+
+         --  Use the hash-table to locate spec entities
+
+         for S in ALFA_Scope_Table.First .. ALFA_Scope_Table.Last loop
+            declare
+               Srec : ALFA_Scope_Record renames ALFA_Scope_Table.Table (S);
+               Body_Entity : Entity_Id;
+               Spec_Entity : Entity_Id;
+               Spec_Scope  : Scope_Index;
+            begin
+               if Ekind (Srec.Scope_Entity) = E_Subprogram_Body then
+                  Body_Entity := Parent (Parent (Srec.Scope_Entity));
+               elsif Ekind (Srec.Scope_Entity) = E_Package_Body then
+                  Body_Entity := Parent (Srec.Scope_Entity);
+               else
+                  Body_Entity := Empty;
+               end if;
+
+               if Present (Body_Entity) then
+                  if Nkind (Body_Entity) = N_Defining_Program_Unit_Name then
+                     Body_Entity := Parent (Body_Entity);
+                  end if;
+
+                  Spec_Entity := Corresponding_Spec (Body_Entity);
+                  Spec_Scope := Entity_Hash_Table.Get (Spec_Entity);
+
+                  --  Spec of generic may be missing
+
+                  if Spec_Scope /= 0 then
+                     Srec.Spec_File_Num :=
+                       ALFA_Scope_Table.Table (Spec_Scope).File_Num;
+                     Srec.Spec_Scope_Num :=
+                       ALFA_Scope_Table.Table (Spec_Scope).Scope_Num;
+                  end if;
+               end if;
+            end;
+         end loop;
+
+      end;
+
       --  Generate cross reference ALFA information
 
       Add_ALFA_Xrefs;
    end Collect_ALFA;
 
+   -----------------
+   -- Entity_Hash --
+   -----------------
+
+   function Entity_Hash (E : Entity_Id) return Entity_Hashed_Range is
+   begin
+      return Entity_Hashed_Range
+        (E mod (Entity_Id (Entity_Hashed_Range'Last) + 1));
+   end Entity_Hash;
+
    -----------------------------------------
    -- Traverse_Declarations_Or_Statements --
    -----------------------------------------
Index: get_alfa.adb
===================================================================
--- get_alfa.adb	(revision 177255)
+++ get_alfa.adb	(working copy)
@@ -254,10 +254,12 @@ 
 
          when 'S' =>
             declare
-               Scope : Nat;
-               Line  : Nat;
-               Col   : Nat;
-               Typ   : Character;
+               Spec_File  : Nat;
+               Spec_Scope : Nat;
+               Scope      : Nat;
+               Line       : Nat;
+               Col        : Nat;
+               Typ        : Character;
 
             begin
                --  Scan out location
@@ -279,21 +281,36 @@ 
 
                Skip_Spaces;
                Get_Name;
+               Skip_Spaces;
 
+               if Nextc = '-' then
+                  Skipc;
+                  Check ('>');
+                  Skip_Spaces;
+                  Spec_File := Get_Nat;
+                  Check ('.');
+                  Spec_Scope := Get_Nat;
+               else
+                  Spec_File  := 0;
+                  Spec_Scope := 0;
+               end if;
+
                --  Make new scope table entry (will fill in From_Xref and
                --  To_Xref later). Initial range (From_Xref .. To_Xref) is
                --  empty for scopes without entities.
 
                ALFA_Scope_Table.Append (
-                 (Scope_Entity => Empty,
-                  Scope_Name   => new String'(Name_Str (1 .. Name_Len)),
-                  File_Num     => Cur_File,
-                  Scope_Num    => Cur_Scope,
-                  Line         => Line,
-                  Stype        => Typ,
-                  Col          => Col,
-                  From_Xref    => 1,
-                  To_Xref      => 0));
+                 (Scope_Entity   => Empty,
+                  Scope_Name     => new String'(Name_Str (1 .. Name_Len)),
+                  File_Num       => Cur_File,
+                  Scope_Num      => Cur_Scope,
+                  Spec_File_Num  => Spec_File,
+                  Spec_Scope_Num => Spec_Scope,
+                  Line           => Line,
+                  Stype          => Typ,
+                  Col            => Col,
+                  From_Xref      => 1,
+                  To_Xref        => 0));
             end;
 
             --  Update counter for scopes