1 ------------------------------------------------------------------------------
3 -- GNAT COMPILER COMPONENTS --
10 -- Copyright (C) 1996-1998 Free Software Foundation, Inc. --
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. --
23 -- GNAT was originally developed by the GNAT team at New York University. --
24 -- It is now maintained by Ada Core Technologies Inc (http://www.gnat.com). --
26 ------------------------------------------------------------------------------
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
;
35 package body Sem_Maps
is
37 -----------------------
38 -- Local Subprograms --
39 -----------------------
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.
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.
50 procedure Write_Map
(E
: Entity_Id
);
51 pragma Warnings
(Off
, Write_Map
);
52 -- For debugging purposes.
58 procedure Add_Association
62 Kind
: Scope_Kind
:= S_Local
)
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
;
71 Associations_Table
.Table
(K
) := (O_Id
, N_Id
, Kind
, No_Assoc
);
72 Maps_Table
.Table
(M
).Assoc_Next
:= K
+ 1;
74 if Headers_Table
.Table
(Offh
+ J
) /= No_Assoc
then
76 -- Place new association at head of chain.
78 Associations_Table
.Table
(K
).Next
:= Headers_Table
.Table
(Offh
+ J
);
81 Headers_Table
.Table
(Offh
+ J
) := K
;
84 ------------------------
85 -- Build_Instance_Map --
86 ------------------------
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
;
96 A_Index
: Assoc_Index
;
99 for J
in 0 .. Info
.Header_Num
- 1 loop
100 A_Index
:= Headers_Table
.Table
(Offh1
+ J
);
102 if A_Index
/= No_Assoc
then
103 Headers_Table
.Table
(Offh2
+ J
) := A_Index
+ (Offa2
- Offa1
);
107 for J
in 0 .. Info
.Assoc_Num
- 1 loop
108 A
:= Associations_Table
.Table
(Offa1
+ J
);
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.
116 and then A
.Kind
= S_Local
117 and then Comes_From_Source
(A
.Old_Id
)
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
));
124 if A
.Next
/= No_Assoc
then
125 A
.Next
:= A
.Next
+ (Offa2
- Offa1
);
128 Associations_Table
.Table
(Offa2
+ J
) := A
;
131 Maps_Table
.Table
(Res
).Assoc_Next
:= Associations_Table
.Last
;
133 end Build_Instance_Map
;
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
;
146 -- Iterate over the contents of Orig_Map, looking for entities
147 -- that are further mapped under New_Map.
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
);
153 if K
/= No_Assoc
then
154 Associations_Table
.Table
(Off
+ J
).New_Id
155 := Associations_Table
.Table
(K
).New_Id
;
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
;
174 A_Index
: Assoc_Index
;
177 for J
in 0 .. Info
.Header_Num
- 1 loop
178 A_Index
:= Headers_Table
.Table
(Offh1
+ J
) + (Offa2
- Offa1
);
180 if A_Index
/= No_Assoc
then
181 Headers_Table
.Table
(Offh2
+ J
) := A_Index
+ (Offa2
- Offa1
);
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
;
191 Maps_Table
.Table
(Res
).Assoc_Next
:= Associations_Table
.Last
;
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
;
204 A_Index
: Assoc_Index
;
207 A_Index
:= Headers_Table
.Table
(Offh
+ J
);
209 if A_Index
= No_Assoc
then
213 A
:= Associations_Table
.Table
(A_Index
);
215 while Present
(A
.Old_Id
) loop
220 elsif A
.Next
= No_Assoc
then
225 A
:= Associations_Table
.Table
(A
.Next
);
233 ----------------------
234 -- Find_Header_Size --
235 ----------------------
237 function Find_Header_Size
(N
: Int
) return Header_Index
is
242 while 2 * Siz
< Header_Index
(N
) loop
247 end Find_Header_Size
;
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
;
260 if Headers_Table
.Table
(Offh
+ J
) = No_Assoc
then
264 A
:= Associations_Table
.Table
(Headers_Table
.Table
(Offh
+ J
));
266 while Present
(A
.Old_Id
) loop
271 elsif A
.Next
= No_Assoc
then
275 A
:= Associations_Table
.Table
(A
.Next
);
287 function New_Map
(Num_Assoc
: Int
) return Map
is
288 Header_Size
: Header_Index
:= Find_Header_Size
(Num_Assoc
);
292 -- Allocate the tables for the new map at the current end of the
295 Associations_Table
.Increment_Last
;
296 Headers_Table
.Increment_Last
;
297 Maps_Table
.Increment_Last
;
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
);
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
;
310 for J
in 1 .. Header_Size
loop
311 Headers_Table
.Table
(Headers_Table
.Last
- J
) := No_Assoc
;
314 return Maps_Table
.Last
;
317 ------------------------
318 -- Update_Association --
319 ------------------------
321 procedure Update_Association
325 Kind
: Scope_Kind
:= S_Local
)
327 J
: constant Assoc_Index
:= Find_Assoc
(M
, O_Id
);
330 Associations_Table
.Table
(J
).New_Id
:= N_Id
;
331 Associations_Table
.Table
(J
).Kind
:= Kind
;
332 end Update_Association
;
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
;
346 Write_Str
("Size : ");
347 Write_Int
(Int
(Info
.Assoc_Num
));
350 Write_Str
("Headers");
353 for J
in 0 .. Info
.Header_Num
- 1 loop
354 Write_Int
(Int
(Offh
+ J
));
356 Write_Int
(Int
(Headers_Table
.Table
(Offh
+ J
)));
360 for J
in 0 .. Info
.Assoc_Num
- 1 loop
361 A
:= Associations_Table
.Table
(Offa
+ J
);
362 Write_Int
(Int
(Offa
+ J
));
364 Write_Name
(Chars
(A
.Old_Id
));
366 Write_Int
(Int
(A
.Old_Id
));
368 Write_Int
(Int
(A
.New_Id
));
369 Write_Str
(" next = ");
370 Write_Int
(Int
(A
.Next
));