+++ /dev/null
-------------------------------------------------------------------------------
--- --
--- GNAT COMPILER COMPONENTS --
--- --
--- S E M _ M A P S --
--- --
--- B o d y --
--- --
--- $Revision: 1.1.16.2 $
--- --
--- 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;
projects / msp430-gcc.git / blobdiff