1 ------------------------------------------------------------------------------
3 -- GNAT COMPILER COMPONENTS --
9 -- Copyright (C) 1996-2002 Free Software Foundation, Inc. --
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. --
22 -- GNAT was originally developed by the GNAT team at New York University. --
23 -- Extensive contributions were provided by Ada Core Technologies Inc. --
25 ------------------------------------------------------------------------------
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;
34 package body Sem_Maps is
36 -----------------------
37 -- Local Subprograms --
38 -----------------------
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.
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.
49 procedure Write_Map (E : Entity_Id);
50 pragma Warnings (Off, Write_Map);
51 -- For debugging purposes.
57 procedure Add_Association
61 Kind : Scope_Kind := S_Local)
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;
70 Associations_Table.Table (K) := (O_Id, N_Id, Kind, No_Assoc);
71 Maps_Table.Table (M).Assoc_Next := K + 1;
73 if Headers_Table.Table (Offh + J) /= No_Assoc then
75 -- Place new association at head of chain.
77 Associations_Table.Table (K).Next := Headers_Table.Table (Offh + J);
80 Headers_Table.Table (Offh + J) := K;
83 ------------------------
84 -- Build_Instance_Map --
85 ------------------------
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;
95 A_Index : Assoc_Index;
98 for J in 0 .. Info.Header_Num - 1 loop
99 A_Index := Headers_Table.Table (Offh1 + J);
101 if A_Index /= No_Assoc then
102 Headers_Table.Table (Offh2 + J) := A_Index + (Offa2 - Offa1);
106 for J in 0 .. Info.Assoc_Num - 1 loop
107 A := Associations_Table.Table (Offa1 + J);
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.
115 and then A.Kind = S_Local
116 and then Comes_From_Source (A.Old_Id)
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));
123 if A.Next /= No_Assoc then
124 A.Next := A.Next + (Offa2 - Offa1);
127 Associations_Table.Table (Offa2 + J) := A;
130 Maps_Table.Table (Res).Assoc_Next := Associations_Table.Last;
132 end Build_Instance_Map;
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;
145 -- Iterate over the contents of Orig_Map, looking for entities
146 -- that are further mapped under New_Map.
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);
152 if K /= No_Assoc then
153 Associations_Table.Table (Off + J).New_Id
154 := Associations_Table.Table (K).New_Id;
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;
173 A_Index : Assoc_Index;
176 for J in 0 .. Info.Header_Num - 1 loop
177 A_Index := Headers_Table.Table (Offh1 + J) + (Offa2 - Offa1);
179 if A_Index /= No_Assoc then
180 Headers_Table.Table (Offh2 + J) := A_Index + (Offa2 - Offa1);
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;
190 Maps_Table.Table (Res).Assoc_Next := Associations_Table.Last;
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;
203 A_Index : Assoc_Index;
206 A_Index := Headers_Table.Table (Offh + J);
208 if A_Index = No_Assoc then
212 A := Associations_Table.Table (A_Index);
214 while Present (A.Old_Id) loop
219 elsif A.Next = No_Assoc then
224 A := Associations_Table.Table (A.Next);
232 ----------------------
233 -- Find_Header_Size --
234 ----------------------
236 function Find_Header_Size (N : Int) return Header_Index is
241 while 2 * Siz < Header_Index (N) loop
246 end Find_Header_Size;
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;
259 if Headers_Table.Table (Offh + J) = No_Assoc then
263 A := Associations_Table.Table (Headers_Table.Table (Offh + J));
265 while Present (A.Old_Id) loop
270 elsif A.Next = No_Assoc then
274 A := Associations_Table.Table (A.Next);
286 function New_Map (Num_Assoc : Int) return Map is
287 Header_Size : constant Header_Index := Find_Header_Size (Num_Assoc);
291 -- Allocate the tables for the new map at the current end of the
294 Associations_Table.Increment_Last;
295 Headers_Table.Increment_Last;
296 Maps_Table.Increment_Last;
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);
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;
309 for J in 1 .. Header_Size loop
310 Headers_Table.Table (Headers_Table.Last - J) := No_Assoc;
313 return Maps_Table.Last;
316 ------------------------
317 -- Update_Association --
318 ------------------------
320 procedure Update_Association
324 Kind : Scope_Kind := S_Local)
326 J : constant Assoc_Index := Find_Assoc (M, O_Id);
329 Associations_Table.Table (J).New_Id := N_Id;
330 Associations_Table.Table (J).Kind := Kind;
331 end Update_Association;
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;
345 Write_Str ("Size : ");
346 Write_Int (Int (Info.Assoc_Num));
349 Write_Str ("Headers");
352 for J in 0 .. Info.Header_Num - 1 loop
353 Write_Int (Int (Offh + J));
355 Write_Int (Int (Headers_Table.Table (Offh + J)));
359 for J in 0 .. Info.Assoc_Num - 1 loop
360 A := Associations_Table.Table (Offa + J);
361 Write_Int (Int (Offa + J));
363 Write_Name (Chars (A.Old_Id));
365 Write_Int (Int (A.Old_Id));
367 Write_Int (Int (A.New_Id));
368 Write_Str (" next = ");
369 Write_Int (Int (A.Next));