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