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