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