diff options
Diffstat (limited to 'gcc/ada/sem_maps.adb')
-rw-r--r-- | gcc/ada/sem_maps.adb | 376 |
1 files changed, 376 insertions, 0 deletions
diff --git a/gcc/ada/sem_maps.adb b/gcc/ada/sem_maps.adb new file mode 100644 index 00000000000..a876156c6ac --- /dev/null +++ b/gcc/ada/sem_maps.adb @@ -0,0 +1,376 @@ +------------------------------------------------------------------------------ +-- -- +-- GNAT COMPILER COMPONENTS -- +-- -- +-- S E M _ M A P S -- +-- -- +-- B o d y -- +-- -- +-- $Revision: 1.3 $ -- +-- -- +-- Copyright (C) 1996-1998 Free Software Foundation, Inc. -- +-- -- +-- GNAT is free software; you can redistribute it and/or modify it under -- +-- terms of the GNU General Public License as published by the Free Soft- -- +-- ware Foundation; either version 2, or (at your option) any later ver- -- +-- sion. GNAT is distributed in the hope that it will be useful, but WITH- -- +-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY -- +-- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -- +-- for more details. You should have received a copy of the GNU General -- +-- Public License distributed with GNAT; see file COPYING. If not, write -- +-- to the Free Software Foundation, 59 Temple Place - Suite 330, Boston, -- +-- MA 02111-1307, USA. -- +-- -- +-- GNAT was originally developed by the GNAT team at New York University. -- +-- It is now maintained by Ada Core Technologies Inc (http://www.gnat.com). -- +-- -- +------------------------------------------------------------------------------ + +with Atree; use Atree; +with Einfo; use Einfo; +with Namet; use Namet; +with Output; use Output; +with Sinfo; use Sinfo; +with Uintp; use Uintp; + +package body Sem_Maps is + + ----------------------- + -- Local Subprograms -- + ----------------------- + + function Find_Assoc (M : Map; E : Entity_Id) return Assoc_Index; + -- Standard hash table search. M is the map to be searched, E is the + -- entity to be searched for, and Assoc_Index is the resulting + -- association, or is set to No_Assoc if there is no association. + + function Find_Header_Size (N : Int) return Header_Index; + -- Find largest power of two smaller than the number of entries in + -- the table. This load factor of 2 may be adjusted later if needed. + + procedure Write_Map (E : Entity_Id); + pragma Warnings (Off, Write_Map); + -- For debugging purposes. + + --------------------- + -- Add_Association -- + --------------------- + + procedure Add_Association + (M : in out Map; + O_Id : Entity_Id; + N_Id : Entity_Id; + Kind : Scope_Kind := S_Local) + is + Info : constant Map_Info := Maps_Table.Table (M); + Offh : constant Header_Index := Info.Header_Offset; + Offs : constant Header_Index := Info.Header_Num; + J : constant Header_Index := Header_Index (O_Id) mod Offs; + K : constant Assoc_Index := Info.Assoc_Next; + + begin + Associations_Table.Table (K) := (O_Id, N_Id, Kind, No_Assoc); + Maps_Table.Table (M).Assoc_Next := K + 1; + + if Headers_Table.Table (Offh + J) /= No_Assoc then + + -- Place new association at head of chain. + + Associations_Table.Table (K).Next := Headers_Table.Table (Offh + J); + end if; + + Headers_Table.Table (Offh + J) := K; + end Add_Association; + + ------------------------ + -- Build_Instance_Map -- + ------------------------ + + function Build_Instance_Map (M : Map) return Map is + Info : constant Map_Info := Maps_Table.Table (M); + Res : constant Map := New_Map (Int (Info.Assoc_Num)); + Offh1 : constant Header_Index := Info.Header_Offset; + Offa1 : constant Assoc_Index := Info.Assoc_Offset; + Offh2 : constant Header_Index := Maps_Table.Table (Res).Header_Offset; + Offa2 : constant Assoc_Index := Maps_Table.Table (Res).Assoc_Offset; + A : Assoc; + A_Index : Assoc_Index; + + begin + for J in 0 .. Info.Header_Num - 1 loop + A_Index := Headers_Table.Table (Offh1 + J); + + if A_Index /= No_Assoc then + Headers_Table.Table (Offh2 + J) := A_Index + (Offa2 - Offa1); + end if; + end loop; + + for J in 0 .. Info.Assoc_Num - 1 loop + A := Associations_Table.Table (Offa1 + J); + + -- For local entities that come from source, create the + -- corresponding local entities in the instance. Entities that + -- do not come from source are etypes, and new ones will be + -- generated when analyzing the instance. + + if No (A.New_Id) + and then A.Kind = S_Local + and then Comes_From_Source (A.Old_Id) + then + A.New_Id := New_Copy (A.Old_Id); + A.New_Id := New_Entity (Nkind (A.Old_Id), Sloc (A.Old_Id)); + Set_Chars (A.New_Id, Chars (A.Old_Id)); + end if; + + if A.Next /= No_Assoc then + A.Next := A.Next + (Offa2 - Offa1); + end if; + + Associations_Table.Table (Offa2 + J) := A; + end loop; + + Maps_Table.Table (Res).Assoc_Next := Associations_Table.Last; + return Res; + end Build_Instance_Map; + + ------------- + -- Compose -- + ------------- + + function Compose (Orig_Map : Map; New_Map : Map) return Map is + Res : constant Map := Copy (Orig_Map); + Off : constant Assoc_Index := Maps_Table.Table (Res).Assoc_Offset; + A : Assoc; + K : Assoc_Index; + + begin + -- Iterate over the contents of Orig_Map, looking for entities + -- that are further mapped under New_Map. + + for J in 0 .. Maps_Table.Table (Res).Assoc_Num - 1 loop + A := Associations_Table.Table (Off + J); + K := Find_Assoc (New_Map, A.New_Id); + + if K /= No_Assoc then + Associations_Table.Table (Off + J).New_Id + := Associations_Table.Table (K).New_Id; + end if; + end loop; + + return Res; + end Compose; + + ---------- + -- Copy -- + ---------- + + function Copy (M : Map) return Map is + Info : constant Map_Info := Maps_Table.Table (M); + Res : constant Map := New_Map (Int (Info.Assoc_Num)); + Offh1 : constant Header_Index := Info.Header_Offset; + Offa1 : constant Assoc_Index := Info.Assoc_Offset; + Offh2 : constant Header_Index := Maps_Table.Table (Res).Header_Offset; + Offa2 : constant Assoc_Index := Maps_Table.Table (Res).Assoc_Offset; + A : Assoc; + A_Index : Assoc_Index; + + begin + for J in 0 .. Info.Header_Num - 1 loop + A_Index := Headers_Table.Table (Offh1 + J) + (Offa2 - Offa1); + + if A_Index /= No_Assoc then + Headers_Table.Table (Offh2 + J) := A_Index + (Offa2 - Offa1); + end if; + end loop; + + for J in 0 .. Info.Assoc_Num - 1 loop + A := Associations_Table.Table (Offa1 + J); + A.Next := A.Next + (Offa2 - Offa1); + Associations_Table.Table (Offa2 + J) := A; + end loop; + + Maps_Table.Table (Res).Assoc_Next := Associations_Table.Last; + return Res; + end Copy; + + ---------------- + -- Find_Assoc -- + ---------------- + + function Find_Assoc (M : Map; E : Entity_Id) return Assoc_Index is + Offh : constant Header_Index := Maps_Table.Table (M).Header_Offset; + Offs : constant Header_Index := Maps_Table.Table (M).Header_Num; + J : constant Header_Index := Header_Index (E) mod Offs; + A : Assoc; + A_Index : Assoc_Index; + + begin + A_Index := Headers_Table.Table (Offh + J); + + if A_Index = No_Assoc then + return A_Index; + + else + A := Associations_Table.Table (A_Index); + + while Present (A.Old_Id) loop + + if A.Old_Id = E then + return A_Index; + + elsif A.Next = No_Assoc then + return No_Assoc; + + else + A_Index := A.Next; + A := Associations_Table.Table (A.Next); + end if; + end loop; + + return No_Assoc; + end if; + end Find_Assoc; + + ---------------------- + -- Find_Header_Size -- + ---------------------- + + function Find_Header_Size (N : Int) return Header_Index is + Siz : Header_Index; + + begin + Siz := 2; + while 2 * Siz < Header_Index (N) loop + Siz := 2 * Siz; + end loop; + + return Siz; + end Find_Header_Size; + + ------------ + -- Lookup -- + ------------ + + function Lookup (M : Map; E : Entity_Id) return Entity_Id is + Offh : constant Header_Index := Maps_Table.Table (M).Header_Offset; + Offs : constant Header_Index := Maps_Table.Table (M).Header_Num; + J : constant Header_Index := Header_Index (E) mod Offs; + A : Assoc; + + begin + if Headers_Table.Table (Offh + J) = No_Assoc then + return Empty; + + else + A := Associations_Table.Table (Headers_Table.Table (Offh + J)); + + while Present (A.Old_Id) loop + + if A.Old_Id = E then + return A.New_Id; + + elsif A.Next = No_Assoc then + return Empty; + + else + A := Associations_Table.Table (A.Next); + end if; + end loop; + + return Empty; + end if; + end Lookup; + + ------------- + -- New_Map -- + ------------- + + function New_Map (Num_Assoc : Int) return Map is + Header_Size : Header_Index := Find_Header_Size (Num_Assoc); + Res : Map_Info; + + begin + -- Allocate the tables for the new map at the current end of the + -- global tables. + + Associations_Table.Increment_Last; + Headers_Table.Increment_Last; + Maps_Table.Increment_Last; + + Res.Header_Offset := Headers_Table.Last; + Res.Header_Num := Header_Size; + Res.Assoc_Offset := Associations_Table.Last; + Res.Assoc_Next := Associations_Table.Last; + Res.Assoc_Num := Assoc_Index (Num_Assoc); + + Headers_Table.Set_Last (Headers_Table.Last + Header_Size); + Associations_Table.Set_Last + (Associations_Table.Last + Assoc_Index (Num_Assoc)); + Maps_Table.Table (Maps_Table.Last) := Res; + + for J in 1 .. Header_Size loop + Headers_Table.Table (Headers_Table.Last - J) := No_Assoc; + end loop; + + return Maps_Table.Last; + end New_Map; + + ------------------------ + -- Update_Association -- + ------------------------ + + procedure Update_Association + (M : in out Map; + O_Id : Entity_Id; + N_Id : Entity_Id; + Kind : Scope_Kind := S_Local) + is + J : constant Assoc_Index := Find_Assoc (M, O_Id); + + begin + Associations_Table.Table (J).New_Id := N_Id; + Associations_Table.Table (J).Kind := Kind; + end Update_Association; + + --------------- + -- Write_Map -- + --------------- + + procedure Write_Map (E : Entity_Id) is + M : constant Map := Map (UI_To_Int (Renaming_Map (E))); + Info : constant Map_Info := Maps_Table.Table (M); + Offh : constant Header_Index := Info.Header_Offset; + Offa : constant Assoc_Index := Info.Assoc_Offset; + A : Assoc; + + begin + Write_Str ("Size : "); + Write_Int (Int (Info.Assoc_Num)); + Write_Eol; + + Write_Str ("Headers"); + Write_Eol; + + for J in 0 .. Info.Header_Num - 1 loop + Write_Int (Int (Offh + J)); + Write_Str (" : "); + Write_Int (Int (Headers_Table.Table (Offh + J))); + Write_Eol; + end loop; + + for J in 0 .. Info.Assoc_Num - 1 loop + A := Associations_Table.Table (Offa + J); + Write_Int (Int (Offa + J)); + Write_Str (" : "); + Write_Name (Chars (A.Old_Id)); + Write_Str (" "); + Write_Int (Int (A.Old_Id)); + Write_Str (" ==> "); + Write_Int (Int (A.New_Id)); + Write_Str (" next = "); + Write_Int (Int (A.Next)); + Write_Eol; + end loop; + end Write_Map; + +end Sem_Maps; |