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-2002 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,  59 Temple Place - Suite 330,  Boston, --
20-- MA 02111-1307, 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
27with Atree;  use Atree;
28with Einfo;  use Einfo;
29with Namet;  use Namet;
30with Output; use Output;
31with Sinfo;  use Sinfo;
32with Uintp;  use Uintp;
33
34package 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
374end Sem_Maps;
375