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