gcc/ada/sem_maps.adb

   1 ------------------------------------------------------------------------------
   2 --                                                                          --
   3 --                         GNAT COMPILER COMPONENTS                         --
   4 --                                                                          --
   5 --                             S E M _ M A P S                              --
   6 --                                                                          --
   7 --                                 B o d y                                  --
   8 --                                                                          --
   9 --                             $Revision: 1.3 $                             --
  10 --                                                                          --
  11 --          Copyright (C) 1996-1998 Free Software Foundation, Inc.          --
  12 --                                                                          --
  13 -- GNAT is free software;  you can  redistribute it  and/or modify it under --
  14 -- terms of the  GNU General Public License as published  by the Free Soft- --
  15 -- ware  Foundation;  either version 2,  or (at your option) any later ver- --
  16 -- sion.  GNAT is distributed in the hope that it will be useful, but WITH- --
  17 -- OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY --
  18 -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  19 -- for  more details.  You should have  received  a copy of the GNU General --
  20 -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
  21 -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
  22 -- MA 02111-1307, USA.                                                      --
  23 --                                                                          --
  24 -- GNAT was originally developed  by the GNAT team at  New York University. --
  25 -- It is now maintained by Ada Core Technologies Inc (http://www.gnat.com). --
  26 --                                                                          --
  27 ------------------------------------------------------------------------------
  28
  29 with Atree;  use Atree;
  30 with Einfo;  use Einfo;
  31 with Namet;  use Namet;
  32 with Output; use Output;
  33 with Sinfo;  use Sinfo;
  34 with Uintp;  use Uintp;
  35
  36 package body Sem_Maps is
  37
  38    -----------------------
  39    -- Local Subprograms --
  40    -----------------------
  41
  42    function Find_Assoc (M : Map; E : Entity_Id) return Assoc_Index;
  43    --  Standard hash table search. M is the map to be searched, E is the
  44    --  entity to be searched for, and Assoc_Index is the resulting
  45    --  association, or is set to No_Assoc if there is no association.
  46
  47    function Find_Header_Size (N : Int) return Header_Index;
  48    --  Find largest power of two smaller than the number of entries in
  49    --  the table. This load factor of 2 may be adjusted later if needed.
  50
  51    procedure Write_Map (E : Entity_Id);
  52    pragma Warnings (Off, Write_Map);
  53    --  For debugging purposes.
  54
  55    ---------------------
  56    -- Add_Association --
  57    ---------------------
  58
  59    procedure Add_Association
  60      (M    : in out Map;
  61       O_Id : Entity_Id;
  62       N_Id : Entity_Id;
  63       Kind : Scope_Kind := S_Local)
  64    is
  65       Info : constant Map_Info      := Maps_Table.Table (M);
  66       Offh : constant Header_Index  := Info.Header_Offset;
  67       Offs : constant Header_Index  := Info.Header_Num;
  68       J    : constant Header_Index  := Header_Index (O_Id) mod Offs;
  69       K    : constant Assoc_Index   := Info.Assoc_Next;
  70
  71    begin
  72       Associations_Table.Table (K) := (O_Id, N_Id, Kind, No_Assoc);
  73       Maps_Table.Table (M).Assoc_Next := K + 1;
  74
  75       if Headers_Table.Table (Offh + J) /= No_Assoc then
  76
  77          --  Place new association at head of chain.
  78
  79          Associations_Table.Table (K).Next := Headers_Table.Table (Offh + J);
  80       end if;
  81
  82       Headers_Table.Table (Offh + J) := K;
  83    end Add_Association;
  84
  85    ------------------------
  86    -- Build_Instance_Map --
  87    ------------------------
  88
  89    function Build_Instance_Map (M : Map) return Map is
  90       Info    : constant Map_Info     := Maps_Table.Table (M);
  91       Res     : constant Map          := New_Map (Int (Info.Assoc_Num));
  92       Offh1   : constant Header_Index := Info.Header_Offset;
  93       Offa1   : constant Assoc_Index  := Info.Assoc_Offset;
  94       Offh2   : constant Header_Index := Maps_Table.Table (Res).Header_Offset;
  95       Offa2   : constant Assoc_Index  := Maps_Table.Table (Res).Assoc_Offset;
  96       A       : Assoc;
  97       A_Index : Assoc_Index;
  98
  99    begin
 100       for J in 0 .. Info.Header_Num - 1 loop
 101          A_Index := Headers_Table.Table (Offh1 + J);
 102
 103          if A_Index /= No_Assoc then
 104             Headers_Table.Table (Offh2 + J) := A_Index + (Offa2 - Offa1);
 105          end if;
 106       end loop;
 107
 108       for J in 0 .. Info.Assoc_Num - 1 loop
 109          A  := Associations_Table.Table (Offa1 + J);
 110
 111          --  For local entities that come from source, create the
 112          --  corresponding local entities in the instance. Entities that
 113          --  do not come from source are etypes, and new ones will be
 114          --  generated when analyzing the instance.
 115
 116          if No (A.New_Id)
 117            and then A.Kind = S_Local
 118            and then Comes_From_Source (A.Old_Id)
 119          then
 120             A.New_Id := New_Copy (A.Old_Id);
 121             A.New_Id := New_Entity (Nkind (A.Old_Id), Sloc (A.Old_Id));
 122             Set_Chars (A.New_Id, Chars (A.Old_Id));
 123          end if;
 124
 125          if A.Next /= No_Assoc then
 126             A.Next := A.Next + (Offa2 - Offa1);
 127          end if;
 128
 129          Associations_Table.Table (Offa2 + J) := A;
 130       end loop;
 131
 132       Maps_Table.Table (Res).Assoc_Next := Associations_Table.Last;
 133       return Res;
 134    end Build_Instance_Map;
 135
 136    -------------
 137    -- Compose --
 138    -------------
 139
 140    function Compose (Orig_Map : Map; New_Map : Map) return Map is
 141       Res : constant Map         := Copy (Orig_Map);
 142       Off : constant Assoc_Index := Maps_Table.Table (Res).Assoc_Offset;
 143       A   : Assoc;
 144       K   : Assoc_Index;
 145
 146    begin
 147       --  Iterate over the contents of Orig_Map, looking for entities
 148       --  that are further mapped under New_Map.
 149
 150       for J in 0 .. Maps_Table.Table (Res).Assoc_Num - 1  loop
 151          A := Associations_Table.Table (Off + J);
 152          K := Find_Assoc (New_Map, A.New_Id);
 153
 154          if K /= No_Assoc then
 155             Associations_Table.Table (Off + J).New_Id
 156               := Associations_Table.Table (K).New_Id;
 157          end if;
 158       end loop;
 159
 160       return Res;
 161    end Compose;
 162
 163    ----------
 164    -- Copy --
 165    ----------
 166
 167    function Copy (M : Map) return Map is
 168       Info    : constant Map_Info     := Maps_Table.Table (M);
 169       Res     : constant Map          := New_Map (Int (Info.Assoc_Num));
 170       Offh1   : constant Header_Index := Info.Header_Offset;
 171       Offa1   : constant Assoc_Index  := Info.Assoc_Offset;
 172       Offh2   : constant Header_Index := Maps_Table.Table (Res).Header_Offset;
 173       Offa2   : constant Assoc_Index  := Maps_Table.Table (Res).Assoc_Offset;
 174       A       : Assoc;
 175       A_Index : Assoc_Index;
 176
 177    begin
 178       for J in 0 .. Info.Header_Num - 1 loop
 179          A_Index := Headers_Table.Table (Offh1 + J) + (Offa2 - Offa1);
 180
 181          if A_Index /= No_Assoc then
 182             Headers_Table.Table (Offh2 + J) := A_Index + (Offa2 - Offa1);
 183          end if;
 184       end loop;
 185
 186       for J in 0 .. Info.Assoc_Num - 1 loop
 187          A := Associations_Table.Table (Offa1 + J);
 188          A.Next := A.Next + (Offa2 - Offa1);
 189          Associations_Table.Table (Offa2 + J) := A;
 190       end loop;
 191
 192       Maps_Table.Table (Res).Assoc_Next := Associations_Table.Last;
 193       return Res;
 194    end Copy;
 195
 196    ----------------
 197    -- Find_Assoc --
 198    ----------------
 199
 200    function Find_Assoc (M : Map; E : Entity_Id) return Assoc_Index is
 201       Offh    : constant Header_Index := Maps_Table.Table (M).Header_Offset;
 202       Offs    : constant Header_Index := Maps_Table.Table (M).Header_Num;
 203       J       : constant Header_Index := Header_Index (E) mod Offs;
 204       A       : Assoc;
 205       A_Index : Assoc_Index;
 206
 207    begin
 208       A_Index := Headers_Table.Table (Offh + J);
 209
 210       if A_Index = No_Assoc then
 211          return A_Index;
 212
 213       else
 214          A := Associations_Table.Table (A_Index);
 215
 216          while Present (A.Old_Id) loop
 217
 218             if A.Old_Id = E then
 219                return A_Index;
 220
 221             elsif A.Next = No_Assoc then
 222                return No_Assoc;
 223
 224             else
 225                A_Index := A.Next;
 226                A := Associations_Table.Table (A.Next);
 227             end if;
 228          end loop;
 229
 230          return No_Assoc;
 231       end if;
 232    end Find_Assoc;
 233
 234    ----------------------
 235    -- Find_Header_Size --
 236    ----------------------
 237
 238    function Find_Header_Size (N : Int) return Header_Index is
 239       Siz : Header_Index;
 240
 241    begin
 242       Siz := 2;
 243       while 2 * Siz < Header_Index (N) loop
 244          Siz := 2 * Siz;
 245       end loop;
 246
 247       return Siz;
 248    end Find_Header_Size;
 249
 250    ------------
 251    -- Lookup --
 252    ------------
 253
 254    function Lookup (M : Map; E : Entity_Id) return Entity_Id is
 255       Offh : constant Header_Index := Maps_Table.Table (M).Header_Offset;
 256       Offs : constant Header_Index := Maps_Table.Table (M).Header_Num;
 257       J    : constant Header_Index := Header_Index (E) mod Offs;
 258       A    : Assoc;
 259
 260    begin
 261       if Headers_Table.Table (Offh + J) = No_Assoc then
 262          return Empty;
 263
 264       else
 265          A := Associations_Table.Table (Headers_Table.Table (Offh + J));
 266
 267          while Present (A.Old_Id) loop
 268
 269             if A.Old_Id = E then
 270                return A.New_Id;
 271
 272             elsif A.Next = No_Assoc then
 273                return Empty;
 274
 275             else
 276                A := Associations_Table.Table (A.Next);
 277             end if;
 278          end loop;
 279
 280          return Empty;
 281       end if;
 282    end Lookup;
 283
 284    -------------
 285    -- New_Map --
 286    -------------
 287
 288    function New_Map (Num_Assoc : Int) return Map is
 289       Header_Size : Header_Index := Find_Header_Size (Num_Assoc);
 290       Res         : Map_Info;
 291
 292    begin
 293       --  Allocate the tables for the new map at the current end of the
 294       --  global tables.
 295
 296       Associations_Table.Increment_Last;
 297       Headers_Table.Increment_Last;
 298       Maps_Table.Increment_Last;
 299
 300       Res.Header_Offset := Headers_Table.Last;
 301       Res.Header_Num    := Header_Size;
 302       Res.Assoc_Offset  := Associations_Table.Last;
 303       Res.Assoc_Next    := Associations_Table.Last;
 304       Res.Assoc_Num     := Assoc_Index (Num_Assoc);
 305
 306       Headers_Table.Set_Last (Headers_Table.Last + Header_Size);
 307       Associations_Table.Set_Last
 308         (Associations_Table.Last + Assoc_Index (Num_Assoc));
 309       Maps_Table.Table (Maps_Table.Last) := Res;
 310
 311       for J in 1 .. Header_Size loop
 312          Headers_Table.Table (Headers_Table.Last - J) := No_Assoc;
 313       end loop;
 314
 315       return Maps_Table.Last;
 316    end New_Map;
 317
 318    ------------------------
 319    -- Update_Association --
 320    ------------------------
 321
 322    procedure Update_Association
 323      (M    : in out Map;
 324       O_Id : Entity_Id;
 325       N_Id : Entity_Id;
 326       Kind : Scope_Kind := S_Local)
 327    is
 328       J : constant Assoc_Index := Find_Assoc (M, O_Id);
 329
 330    begin
 331       Associations_Table.Table (J).New_Id := N_Id;
 332       Associations_Table.Table (J).Kind := Kind;
 333    end Update_Association;
 334
 335    ---------------
 336    -- Write_Map --
 337    ---------------
 338
 339    procedure Write_Map (E : Entity_Id) is
 340       M    : constant Map          := Map (UI_To_Int (Renaming_Map (E)));
 341       Info : constant Map_Info     := Maps_Table.Table (M);
 342       Offh : constant Header_Index := Info.Header_Offset;
 343       Offa : constant Assoc_Index  := Info.Assoc_Offset;
 344       A    : Assoc;
 345
 346    begin
 347       Write_Str ("Size : ");
 348       Write_Int (Int (Info.Assoc_Num));
 349       Write_Eol;
 350
 351       Write_Str ("Headers");
 352       Write_Eol;
 353
 354       for J in 0 .. Info.Header_Num - 1 loop
 355          Write_Int (Int (Offh + J));
 356          Write_Str (" : ");
 357          Write_Int (Int (Headers_Table.Table (Offh + J)));
 358          Write_Eol;
 359       end loop;
 360
 361       for J in 0 .. Info.Assoc_Num - 1 loop
 362          A := Associations_Table.Table (Offa + J);
 363          Write_Int (Int (Offa + J));
 364          Write_Str (" : ");
 365          Write_Name (Chars (A.Old_Id));
 366          Write_Str ("  ");
 367          Write_Int (Int (A.Old_Id));
 368          Write_Str (" ==> ");
 369          Write_Int (Int (A.New_Id));
 370          Write_Str (" next = ");
 371          Write_Int (Int (A.Next));
 372          Write_Eol;
 373       end loop;
 374    end Write_Map;
 375
 376 end Sem_Maps;