gcc/gcc/ada/sem_maps.adb

------------------------------------------------------------------------------
--                                                                          --
--                         GNAT COMPILER COMPONENTS                         --
--                                                                          --
--                             S E M _ M A P S                              --
--                                                                          --
--                                 B o d y                                  --
--                                                                          --
--          Copyright (C) 1996-2005, 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- --
-- ware  Foundation;  either version 2,  or (at your option) any later ver- --
-- sion.  GNAT is distributed in the hope that it will be useful, but WITH- --
-- OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY --
-- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
-- for  more details.  You should have  received  a copy of the GNU General --
-- Public License  distributed with GNAT;  see file COPYING.  If not, write --
-- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
-- Boston, MA 02110-1301, USA.                                              --
--                                                                          --
-- GNAT was originally developed  by the GNAT team at  New York University. --
-- Extensive contributions were provided by Ada Core Technologies Inc.      --
--                                                                          --
------------------------------------------------------------------------------

with Atree;  use Atree;
with Einfo;  use Einfo;
with Namet;  use Namet;
with Output; use Output;
with Sinfo;  use Sinfo;
with Uintp;  use Uintp;

package body Sem_Maps is

   -----------------------
   -- Local Subprograms --
   -----------------------

   function Find_Assoc (M : Map; E : Entity_Id) return Assoc_Index;
   --  Standard hash table search. M is the map to be searched, E is the
   --  entity to be searched for, and Assoc_Index is the resulting
   --  association, or is set to No_Assoc if there is no association.

   function Find_Header_Size (N : Int) return Header_Index;
   --  Find largest power of two smaller than the number of entries in
   --  the table. This load factor of 2 may be adjusted later if needed.

   procedure Write_Map (E : Entity_Id);
   pragma Warnings (Off, Write_Map);
   --  For debugging purposes

   ---------------------
   -- Add_Association --
   ---------------------

   procedure Add_Association
     (M    : in out Map;
      O_Id : Entity_Id;
      N_Id : Entity_Id;
      Kind : Scope_Kind := S_Local)
   is
      Info : constant Map_Info      := Maps_Table.Table (M);
      Offh : constant Header_Index  := Info.Header_Offset;
      Offs : constant Header_Index  := Info.Header_Num;
      J    : constant Header_Index  := Header_Index (O_Id) mod Offs;
      K    : constant Assoc_Index   := Info.Assoc_Next;

   begin
      Associations_Table.Table (K) := (O_Id, N_Id, Kind, No_Assoc);
      Maps_Table.Table (M).Assoc_Next := K + 1;

      if Headers_Table.Table (Offh + J) /= No_Assoc then

         --  Place new association at head of chain

         Associations_Table.Table (K).Next := Headers_Table.Table (Offh + J);
      end if;

      Headers_Table.Table (Offh + J) := K;
   end Add_Association;

   ------------------------
   -- Build_Instance_Map --
   ------------------------

   function Build_Instance_Map (M : Map) return Map is
      Info    : constant Map_Info     := Maps_Table.Table (M);
      Res     : constant Map          := New_Map (Int (Info.Assoc_Num));
      Offh1   : constant Header_Index := Info.Header_Offset;
      Offa1   : constant Assoc_Index  := Info.Assoc_Offset;
      Offh2   : constant Header_Index := Maps_Table.Table (Res).Header_Offset;
      Offa2   : constant Assoc_Index  := Maps_Table.Table (Res).Assoc_Offset;
      A       : Assoc;
      A_Index : Assoc_Index;

   begin
      for J in 0 .. Info.Header_Num - 1 loop
         A_Index := Headers_Table.Table (Offh1 + J);

         if A_Index /= No_Assoc then
            Headers_Table.Table (Offh2 + J) := A_Index + (Offa2 - Offa1);
         end if;
      end loop;

      for J in 0 .. Info.Assoc_Num - 1 loop
         A  := Associations_Table.Table (Offa1 + J);

         --  For local entities that come from source, create the
         --  corresponding local entities in the instance. Entities that
         --  do not come from source are etypes, and new ones will be
         --  generated when analyzing the instance.

         if No (A.New_Id)
           and then A.Kind = S_Local
           and then Comes_From_Source (A.Old_Id)
         then
            A.New_Id := New_Copy (A.Old_Id);
            A.New_Id := New_Entity (Nkind (A.Old_Id), Sloc (A.Old_Id));
            Set_Chars (A.New_Id, Chars (A.Old_Id));
         end if;

         if A.Next /= No_Assoc then
            A.Next := A.Next + (Offa2 - Offa1);
         end if;

         Associations_Table.Table (Offa2 + J) := A;
      end loop;

      Maps_Table.Table (Res).Assoc_Next := Associations_Table.Last;
      return Res;
   end Build_Instance_Map;

   -------------
   -- Compose --
   -------------

   function Compose (Orig_Map : Map; New_Map : Map) return Map is
      Res : constant Map         := Copy (Orig_Map);
      Off : constant Assoc_Index := Maps_Table.Table (Res).Assoc_Offset;
      A   : Assoc;
      K   : Assoc_Index;

   begin
      --  Iterate over the contents of Orig_Map, looking for entities
      --  that are further mapped under New_Map.

      for J in 0 .. Maps_Table.Table (Res).Assoc_Num - 1  loop
         A := Associations_Table.Table (Off + J);
         K := Find_Assoc (New_Map, A.New_Id);

         if K /= No_Assoc then
            Associations_Table.Table (Off + J).New_Id
              := Associations_Table.Table (K).New_Id;
         end if;
      end loop;

      return Res;
   end Compose;

   ----------
   -- Copy --
   ----------

   function Copy (M : Map) return Map is
      Info    : constant Map_Info     := Maps_Table.Table (M);
      Res     : constant Map          := New_Map (Int (Info.Assoc_Num));
      Offh1   : constant Header_Index := Info.Header_Offset;
      Offa1   : constant Assoc_Index  := Info.Assoc_Offset;
      Offh2   : constant Header_Index := Maps_Table.Table (Res).Header_Offset;
      Offa2   : constant Assoc_Index  := Maps_Table.Table (Res).Assoc_Offset;
      A       : Assoc;
      A_Index : Assoc_Index;

   begin
      for J in 0 .. Info.Header_Num - 1 loop
         A_Index := Headers_Table.Table (Offh1 + J) + (Offa2 - Offa1);

         if A_Index /= No_Assoc then
            Headers_Table.Table (Offh2 + J) := A_Index + (Offa2 - Offa1);
         end if;
      end loop;

      for J in 0 .. Info.Assoc_Num - 1 loop
         A := Associations_Table.Table (Offa1 + J);
         A.Next := A.Next + (Offa2 - Offa1);
         Associations_Table.Table (Offa2 + J) := A;
      end loop;

      Maps_Table.Table (Res).Assoc_Next := Associations_Table.Last;
      return Res;
   end Copy;

   ----------------
   -- Find_Assoc --
   ----------------

   function Find_Assoc (M : Map; E : Entity_Id) return Assoc_Index is
      Offh    : constant Header_Index := Maps_Table.Table (M).Header_Offset;
      Offs    : constant Header_Index := Maps_Table.Table (M).Header_Num;
      J       : constant Header_Index := Header_Index (E) mod Offs;
      A       : Assoc;
      A_Index : Assoc_Index;

   begin
      A_Index := Headers_Table.Table (Offh + J);

      if A_Index = No_Assoc then
         return A_Index;

      else
         A := Associations_Table.Table (A_Index);

         while Present (A.Old_Id) loop

            if A.Old_Id = E then
               return A_Index;

            elsif A.Next = No_Assoc then
               return No_Assoc;

            else
               A_Index := A.Next;
               A := Associations_Table.Table (A.Next);
            end if;
         end loop;

         return No_Assoc;
      end if;
   end Find_Assoc;

   ----------------------
   -- Find_Header_Size --
   ----------------------

   function Find_Header_Size (N : Int) return Header_Index is
      Siz : Header_Index;

   begin
      Siz := 2;
      while 2 * Siz < Header_Index (N) loop
         Siz := 2 * Siz;
      end loop;

      return Siz;
   end Find_Header_Size;

   ------------
   -- Lookup --
   ------------

   function Lookup (M : Map; E : Entity_Id) return Entity_Id is
      Offh : constant Header_Index := Maps_Table.Table (M).Header_Offset;
      Offs : constant Header_Index := Maps_Table.Table (M).Header_Num;
      J    : constant Header_Index := Header_Index (E) mod Offs;
      A    : Assoc;

   begin
      if Headers_Table.Table (Offh + J) = No_Assoc then
         return Empty;

      else
         A := Associations_Table.Table (Headers_Table.Table (Offh + J));

         while Present (A.Old_Id) loop

            if A.Old_Id = E then
               return A.New_Id;

            elsif A.Next = No_Assoc then
               return Empty;

            else
               A := Associations_Table.Table (A.Next);
            end if;
         end loop;

         return Empty;
      end if;
   end Lookup;

   -------------
   -- New_Map --
   -------------

   function New_Map (Num_Assoc : Int) return Map is
      Header_Size : constant Header_Index := Find_Header_Size (Num_Assoc);
      Res         : Map_Info;

   begin
      --  Allocate the tables for the new map at the current end of the
      --  global tables.

      Associations_Table.Increment_Last;
      Headers_Table.Increment_Last;
      Maps_Table.Increment_Last;

      Res.Header_Offset := Headers_Table.Last;
      Res.Header_Num    := Header_Size;
      Res.Assoc_Offset  := Associations_Table.Last;
      Res.Assoc_Next    := Associations_Table.Last;
      Res.Assoc_Num     := Assoc_Index (Num_Assoc);

      Headers_Table.Set_Last (Headers_Table.Last + Header_Size);
      Associations_Table.Set_Last
        (Associations_Table.Last + Assoc_Index (Num_Assoc));
      Maps_Table.Table (Maps_Table.Last) := Res;

      for J in 1 .. Header_Size loop
         Headers_Table.Table (Headers_Table.Last - J) := No_Assoc;
      end loop;

      return Maps_Table.Last;
   end New_Map;

   ------------------------
   -- Update_Association --
   ------------------------

   procedure Update_Association
     (M    : in out Map;
      O_Id : Entity_Id;
      N_Id : Entity_Id;
      Kind : Scope_Kind := S_Local)
   is
      J : constant Assoc_Index := Find_Assoc (M, O_Id);

   begin
      Associations_Table.Table (J).New_Id := N_Id;
      Associations_Table.Table (J).Kind := Kind;
   end Update_Association;

   ---------------
   -- Write_Map --
   ---------------

   procedure Write_Map (E : Entity_Id) is
      M    : constant Map          := Map (UI_To_Int (Renaming_Map (E)));
      Info : constant Map_Info     := Maps_Table.Table (M);
      Offh : constant Header_Index := Info.Header_Offset;
      Offa : constant Assoc_Index  := Info.Assoc_Offset;
      A    : Assoc;

   begin
      Write_Str ("Size : ");
      Write_Int (Int (Info.Assoc_Num));
      Write_Eol;

      Write_Str ("Headers");
      Write_Eol;

      for J in 0 .. Info.Header_Num - 1 loop
         Write_Int (Int (Offh + J));
         Write_Str (" : ");
         Write_Int (Int (Headers_Table.Table (Offh + J)));
         Write_Eol;
      end loop;

      for J in 0 .. Info.Assoc_Num - 1 loop
         A := Associations_Table.Table (Offa + J);
         Write_Int (Int (Offa + J));
         Write_Str (" : ");
         Write_Name (Chars (A.Old_Id));
         Write_Str ("  ");
         Write_Int (Int (A.Old_Id));
         Write_Str (" ==> ");
         Write_Int (Int (A.New_Id));
         Write_Str (" next = ");
         Write_Int (Int (A.Next));
         Write_Eol;
      end loop;
   end Write_Map;

end Sem_Maps;