------------------------------------------------------------------------------ -- -- -- GNAT COMPILER COMPONENTS -- -- -- -- S E M _ M A P S -- -- -- -- B o d y -- -- -- -- 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. -- -- Extensive contributions were provided by Ada Core Technologies Inc. -- -- -- ------------------------------------------------------------------------------ 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;