+2009-06-25 Emmanuel Briot <briot@adacore.com>
+
+ * gnatcmd.adb, make.adb, mlib-prj.adb, prj.adb, prj.ads, prj-nmsc.adb,
+ prj-env.adb, prj-env.ads (Slash): removed, no longer used
+ (Source_Data): no longer use Path.Name to point to a locally removed
+ file. Instead we use the field Locally_Removed which is clearer
+
+2009-06-25 Arnaud Charlet <charlet@adacore.com>
+
+ * gcc-interface/Make-lang.in: Remove references to sem_maps.o
+
+ * sem_maps.adb, sem_maps.ads: Removed, not used.
+
2009-06-25 Ed Falis <falis@adacore.com>
* s-vxwext-rtp.ads: Add missing declaration
ada/sem_ch12.o ada/sem_ch13.o ada/sem_ch2.o ada/sem_ch3.o ada/sem_ch4.o \
ada/sem_ch5.o ada/sem_ch6.o ada/sem_ch7.o ada/sem_ch8.o ada/sem_ch9.o \
ada/sem_case.o ada/sem_disp.o ada/sem_dist.o ada/sem_elab.o ada/sem_elim.o \
- ada/sem_eval.o ada/sem_intr.o ada/sem_maps.o ada/sem_mech.o ada/sem_prag.o \
+ ada/sem_eval.o ada/sem_intr.o ada/sem_mech.o ada/sem_prag.o \
ada/sem_res.o ada/sem_smem.o ada/sem_type.o ada/sem_util.o ada/sem_vfpt.o \
ada/sem_warn.o ada/sinfo-cn.o ada/sinfo.o ada/sinput.o ada/sinput-d.o \
ada/sinput-l.o ada/snames.o ada/sprint.o ada/stand.o ada/stringt.o \
ada/tree_io.ads ada/types.ads ada/uintp.ads ada/uintp.adb ada/uname.ads \
ada/unchconv.ads ada/unchdeal.ads ada/urealp.ads
-ada/sem_maps.o : ada/ada.ads ada/a-except.ads ada/a-unccon.ads \
- ada/a-uncdea.ads ada/alloc.ads ada/atree.ads ada/atree.adb \
- ada/casing.ads ada/debug.ads ada/einfo.ads ada/einfo.adb ada/gnat.ads \
- ada/g-htable.ads ada/hostparm.ads ada/namet.ads ada/nlists.ads \
- ada/nlists.adb ada/opt.ads ada/output.ads ada/sem_maps.ads \
- ada/sem_maps.adb ada/sinfo.ads ada/sinfo.adb ada/sinput.ads \
- ada/snames.ads ada/stand.ads ada/system.ads ada/s-exctab.ads \
- ada/s-htable.ads ada/s-imenne.ads ada/s-memory.ads ada/s-os_lib.ads \
- ada/s-parame.ads ada/s-stalib.ads ada/s-string.ads ada/s-traent.ads \
- ada/s-unstyp.ads ada/s-wchcon.ads ada/table.ads ada/table.adb \
- ada/tree_io.ads ada/types.ads ada/uintp.ads ada/uintp.adb \
- ada/unchconv.ads ada/unchdeal.ads ada/urealp.ads
-
ada/sem_mech.o : ada/ada.ads ada/a-except.ads ada/a-unccon.ads \
ada/a-uncdea.ads ada/alloc.ads ada/atree.ads ada/atree.adb \
ada/casing.ads ada/debug.ads ada/einfo.ads ada/einfo.adb \
if The_Command = List then
if Unit.File_Names (Impl) /= null
- and then Unit.File_Names (Impl).Path.Name /= Slash
+ and then not Unit.File_Names (Impl).Locally_Removed
then
-- There is a body, check if it is for this project
Subunit := False;
if Unit.File_Names (Spec) = null
- or else Unit.File_Names (Spec).Path.Name = Slash
+ or else Unit.File_Names (Spec).Locally_Removed
then
-- We have a body with no spec: we need to check if
-- this is a subunit, because gnatls will complain
end if;
elsif Unit.File_Names (Spec) /= null
- and then Unit.File_Names (Spec).Path.Name /= Slash
+ and then not Unit.File_Names (Spec).Locally_Removed
then
-- We have a spec with no body. Check if it is for this
-- project.
elsif The_Command = Stack then
if Unit.File_Names (Impl) /= null
- and then Unit.File_Names (Impl).Path.Name /= Slash
+ and then not Unit.File_Names (Impl).Locally_Removed
then
-- There is a body. Check if .ci files for this project
-- must be added.
Subunit := False;
if Unit.File_Names (Spec) = null
- or else Unit.File_Names (Spec).Path.Name = Slash
+ or else Unit.File_Names (Spec).Locally_Removed
then
-- We have a body with no spec: we need to check
-- if this is a subunit, because .ci files are not
end if;
elsif Unit.File_Names (Spec) /= null
- and then Unit.File_Names (Spec).Path.Name /= Slash
+ and then not Unit.File_Names (Spec).Locally_Removed
then
-- Spec with no body, check if it is for this project
if Unit.File_Names (Kind) /= null
and then Check_Project
(Unit.File_Names (Kind).Project, Project)
- and then Unit.File_Names (Kind).Path.Name /= Slash
+ and then not Unit.File_Names (Kind).Locally_Removed
then
Get_Name_String
(Unit.File_Names (Kind).Path.Display_Name);
if Uid /= Prj.No_Unit_Index then
if Uid.File_Names (Impl) /= null
and then
- Uid.File_Names (Impl).Path.Name /= Slash
+ not Uid.File_Names (Impl).Locally_Removed
then
Sfile := Uid.File_Names (Impl).File;
Source_Index :=
elsif Uid.File_Names (Spec) /= null
and then
- Uid.File_Names (Spec).Path.Name /= Slash
+ not Uid.File_Names (Spec).Locally_Removed
then
Sfile := Uid.File_Names (Spec).File;
Source_Index :=
-- locally removed.
if Unit.File_Names (Impl) /= null
- and then Unit.File_Names (Impl).Path.Name /= Slash
+ and then not Unit.File_Names (Impl).Locally_Removed
then
-- And it is a source for the specified project
end if;
elsif Unit.File_Names (Spec) /= null
- and then Unit.File_Names (Spec).Path.Name /= Slash
+ and then not Unit.File_Names (Spec).Locally_Removed
and then Check_Project (Unit.File_Names (Spec).Project)
then
-- If there is no source for the body, but there is a source
Unit := Units_Htable.Get_First (In_Tree.Units_HT);
while Unit /= No_Unit_Index loop
if Unit.File_Names (Impl) /= null
- and then Unit.File_Names (Impl).Path.Name /= Slash
+ and then not Unit.File_Names (Impl).Locally_Removed
then
if Check_Project (Unit.File_Names (Impl).Project) then
if Unit.File_Names (Spec) = null then
end if;
elsif Unit.File_Names (Spec) /= null
- and then Unit.File_Names (Spec).Path.Name /= Slash
+ and then not Unit.File_Names (Spec).Locally_Removed
and then Check_Project (Unit.File_Names (Spec).Project)
then
Add_ALI_For (Unit.File_Names (Spec).File);
Last := Write (File, S (S'First)'Address, S'Length);
if Last /= S'Length then
- Prj.Com.Fail ("Disk full");
+ Prj.Com.Fail
+ ("Disk full when creating " & Get_Name_String (File_Name));
end if;
if Current_Verbosity = High then
Last := Write (File, S0'Address, S0'Length);
if Last /= S'Length + 1 then
- Prj.Com.Fail ("Disk full");
+ Prj.Com.Fail
+ ("Disk full when creating " & Get_Name_String (File_Name));
end if;
if Current_Verbosity = High then
while Current_Unit /= No_Unit_Index loop
if Current_Unit.File_Names (Spec) /= null
and then Current_Unit.File_Names (Spec).Naming_Exception
+ and then not Current_Unit.File_Names (Spec).Locally_Removed
then
Put (Current_Unit.Name,
Current_Unit.File_Names (Spec).File,
if Current_Unit.File_Names (Impl) /= null
and then Current_Unit.File_Names (Impl).Naming_Exception
+ and then not Current_Unit.File_Names (Impl).Locally_Removed
then
Put (Current_Unit.Name,
Current_Unit.File_Names (Impl).File,
GNAT.OS_Lib.Close (File, Status);
if not Status then
- Prj.Com.Fail ("disk full");
+ Prj.Com.Fail
+ ("Disk full when creating " & Get_Name_String (File_Name));
end if;
if Opt.Verbose_Mode then
begin
Fmap.Reset_Tables;
+ -- ??? Shouldn't we iterate on source files instead ?
+
Unit := Units_Htable.Get_First (In_Tree.Units_HT);
while Unit /= No_Unit_Index loop
-
- -- Process only if the unit has a valid name
-
- if Unit.Name /= No_Name then
- Data := Unit.File_Names (Spec);
+ for S in Spec_Or_Body loop
+ Data := Unit.File_Names (S);
-- If there is a spec put it in the mapping
if Data /= null then
- if Data.Path.Name = Slash then
+ if Data.Locally_Removed then
Fmap.Add_Forbidden_File_Name (Data.File);
else
Fmap.Add_To_File_Map
Path_Name => File_Name_Type (Data.Path.Name));
end if;
end if;
-
- Data := Unit.File_Names (Impl);
-
- -- If there is a body (or subunit) put it in the mapping
-
- if Data /= null then
- if Data.Path.Name = Slash then
- Fmap.Add_Forbidden_File_Name (Data.File);
- else
- Fmap.Add_To_File_Map
- (Unit_Name => Unit_Name_Type (Unit.Name),
- File_Name => Data.File,
- Path_Name => File_Name_Type (Data.Path.Name));
- end if;
- end if;
- end if;
+ end loop;
Unit := Units_Htable.Get_Next (In_Tree.Units_HT);
end loop;
exit when Source = No_Source;
if Source.Language.Name = Language
- and then not Source.Locally_Removed
and then Source.Replaced_By = No_Source
and then Source.Path.Name /= No_Path
then
Get_Name_String (Source.File);
Put_Name_Buffer;
- Get_Name_String (Source.Path.Name);
+ if Source.Locally_Removed then
+ Name_Len := 1;
+ Name_Buffer (1 .. Name_Len) := "/";
+ else
+ Get_Name_String (Source.Path.Name);
+ end if;
+
Put_Name_Buffer;
end if;
-- since the latter would have to match exactly the index of that language
-- for the specified project, and that is not information available in
-- buildgpr.adb.
+ --
+ -- See fmap for a description of the format of the mapping file
procedure Set_Mapping_File_Initial_State_To_Empty
(In_Tree : Project_Tree_Ref);
-- Check that the unit is part of the project
if UData.File_Names (Impl) /= null
- and then UData.File_Names (Impl).Path.Name /= Slash
+ and then not UData.File_Names (Impl).Locally_Removed
then
if Check_Project
(UData.File_Names (Impl).Project,
end if;
elsif UData.File_Names (Spec) /= null
- and then UData.File_Names (Spec).Path.Name /= Slash
+ and then not UData.File_Names (Spec).Locally_Removed
and then Check_Project
(UData.File_Names (Spec).Project,
Project, Extending)
Source : Source_Id := No_Source;
OK : Boolean;
Excluded : File_Found;
- Index : Unit_Index;
begin
Excluded := Excluded_Sources_Htable.Get_First;
or else Is_Extending (Project, Source.Project)
then
OK := True;
+ Source.Locally_Removed := True;
- if Source.Unit /= No_Unit_Index then
- Index :=
- Units_Htable.Get
- (In_Tree.Units_HT, Source.Unit.Name);
- if Index.File_Names (Source.Kind) /= null then
- Index.File_Names (Source.Kind).Path.Name := Slash;
- Index.File_Names (Source.Kind).Naming_Exception :=
- False;
-
- -- ??? Should we simply set (can be done from the
- -- source)
- -- Index.File_Names (Source.Kind) := null;
-
- end if;
- end if;
-
- if Source /= No_Source then
- Source.Locally_Removed := True;
- Source.In_Interfaces := False;
- end if;
+ Name_Len := 1;
+ Name_Buffer (1 .. Name_Len) := "/";
+ Source.Path.Name := Name_Find;
+ Source.In_Interfaces := False;
if Current_Verbosity = High then
Write_Str ("Removing file ");
if UData.File_Names (Unit_Kind) = null
or else
(UData.File_Names (Unit_Kind).File = Canonical_File
- and then UData.File_Names (Unit_Kind).Path.Name = Slash)
+ and then UData.File_Names (Unit_Kind).Locally_Removed)
or else Is_Extending
(Project.Extends, UData.File_Names (Unit_Kind).Project)
then
if UData.File_Names (Unit_Kind) /= null
- and then UData.File_Names (Unit_Kind).Path.Name = Slash
+ and then UData.File_Names (Unit_Kind).Locally_Removed
then
Remove_Forbidden_File_Name
(UData.File_Names (Unit_Kind).File);
Default_Ada_Spec_Suffix_Id : File_Name_Type;
Default_Ada_Body_Suffix_Id : File_Name_Type;
- Slash_Id : Path_Name_Type;
-- Initialized in Prj.Initialize, then never modified
subtype Known_Casing is Casing_Type range All_Upper_Case .. Mixed_Case;
Name_Len := 4;
Name_Buffer (1 .. 4) := ".adb";
Default_Ada_Body_Suffix_Id := Name_Find;
- Name_Len := 1;
- Name_Buffer (1) := '/';
- Slash_Id := Name_Find;
Prj.Attr.Initialize;
Set_Name_Table_Byte (Name_Project, Token_Type'Pos (Tok_Project));
In_Tree.Array_Elements.Table (Naming.Spec_Suffix) := Element;
end Set_Spec_Suffix;
- -----------
- -- Slash --
- -----------
-
- function Slash return Path_Name_Type is
- begin
- return Slash_Id;
- end Slash;
-
-----------------------
-- Spec_Suffix_Id_Of --
-----------------------
function Is_Compilable (Source : Source_Id) return Boolean is
begin
- return Source.Language.Config.Compiler_Driver /= Empty_File_Name;
+ return Source.Language.Config.Compiler_Driver /= Empty_File_Name
+ and then not Source.Locally_Removed;
end Is_Compilable;
----------------------------
-- The name for the standard GNAT suffix for Ada body source file name
-- ".adb". Initialized by Prj.Initialize.
- function Slash return Path_Name_Type;
- pragma Inline (Slash);
- -- "/", used as the path of locally removed files
-
Config_Project_File_Extension : String := ".cgpr";
Project_File_Extension : String := ".gpr";
-- The standard config and user project file name extensions. They are not
Path : Path_Information := No_Path_Information;
-- Path name of the source
- -- Path.Name is set to Slash for an excluded file that does not belong
- -- in the project in fact
Source_TS : Time_Stamp_Type := Empty_Time_Stamp;
-- Time stamp of the source file
+++ /dev/null
-------------------------------------------------------------------------------
--- --
--- GNAT COMPILER COMPONENTS --
--- --
--- S E M _ M A P S --
--- --
--- B o d y --
--- --
--- Copyright (C) 1996-2007, 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 3, 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 COPYING3. If not, go to --
--- http://www.gnu.org/licenses for a complete copy of the license. --
--- --
--- 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 : 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 : constant 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 : 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;
+++ /dev/null
-------------------------------------------------------------------------------
--- --
--- GNAT COMPILER COMPONENTS --
--- --
--- S E M _ M A P S --
--- --
--- S p e c --
--- --
--- Copyright (C) 1996-2007, 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 3, 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 COPYING3. If not, go to --
--- http://www.gnu.org/licenses for a complete copy of the license. --
--- --
--- GNAT was originally developed by the GNAT team at New York University. --
--- Extensive contributions were provided by Ada Core Technologies Inc. --
--- --
-------------------------------------------------------------------------------
-
--- This package contains the operations on the renaming maps used for
--- generic analysis and instantiation. Renaming maps are created when
--- a generic unit is analyzed, in order to capture all references to
--- global variables within the unit. The renaming map of a generic unit
--- copied prior to each instantiation, and then updated by mapping the
--- formals into the actuals and the local entities into entities local to
--- the instance. When the generic tree is copied to produce the instance,
--- all references are updated by means of the renaming map.
-
--- Map composition of renaming maps takes place for nested instantiations,
--- for generic child units, and for formal packages.
-
--- For additional details, see the documentation in sem_ch12
-
-with Table;
-with Types; use Types;
-
-package Sem_Maps is
-
- type Map is new Int;
-
- type Assoc is private;
-
- type Scope_Kind is (S_Global, S_Formal, S_Local);
-
- function New_Map (Num_Assoc : Int) return Map;
- -- Build empty map with the given number of associations, and a
- -- headers table of the appropriate size.
-
- function Compose (Orig_Map : Map; New_Map : Map) return Map;
- -- Update the associations in Orig_Map, so that if Orig_Map (e1) = e2
- -- and New_Map (e2) = e3, then the image of e1 under the result is e3.
-
- function Copy (M : Map) return Map;
- -- Full copy of contents and headers
-
- function Lookup (M : Map; E : Entity_Id) return Entity_Id;
- -- Retrieve image of E under M, Empty if undefined
-
- procedure Add_Association
- (M : Map;
- O_Id : Entity_Id;
- N_Id : Entity_Id;
- Kind : Scope_Kind := S_Local);
- -- Update M in place. On entry M (O_Id) must not be defined
-
- procedure Update_Association
- (M : Map;
- O_Id : Entity_Id;
- N_Id : Entity_Id;
- Kind : Scope_Kind := S_Local);
- -- Update the entry in M for O_Id
-
- function Build_Instance_Map (M : Map) return Map;
- -- Copy renaming map of generic, and create new entities for all the
- -- local entities within.
-
-private
-
- -- New maps are created when a generic is analyzed, and for each of
- -- its instantiations. Maps are also updated for nested generics, for
- -- child units, and for formal packages. As a result we need to allocate
- -- maps dynamically.
-
- -- When analyzing a generic, we do not know how many references are
- -- in it. We build an initial map after generic analysis, using a static
- -- structure that relies on the compiler's extensible table mechanism.
- -- After constructing this initial map, all subsequent uses and updates
- -- of this map do not modify its domain, so that dynamically allocated
- -- maps have a fixed size and never need to be reallocated. Furthermore,
- -- the headers of the hash table of a dynamically allocated map can be
- -- chosen according to the total number of entries in the map, to
- -- accommodate efficiently generic units of different sizes (Unchecked_
- -- Conversion vs. Generic_Elementary_Functions, for example). So in
- -- fact both components of a map have fixed size, and can be allocated
- -- using the standard table mechanism. A Maps_Table holds records that
- -- contain indices into the global Headers table and the Associations
- -- table, and a Map is an index into the Maps_Table.
- --
- -- Maps_Table Headers_Table Associations_Table
- --
- -- |_____| |___________ |
- -- |_____| | | | |
- -- ------>|Map |------------------------------>|Associations|
- -- |Info |------------->| |=========>| for one |
- -- |_____| | |====| | unit |
- -- | | | | |====>| |
- -- |_____| |____________|
- -- | | | |
- type Header_Index is new Int;
- type Assoc_Index is new Int;
- No_Assoc : constant Assoc_Index := -1;
-
- type Map_Info is record
- Header_Offset : Header_Index;
- Header_Num : Header_Index;
- Assoc_Offset : Assoc_Index;
- Assoc_Num : Assoc_Index;
- Assoc_Next : Assoc_Index;
- end record;
-
- type Assoc is record
- Old_Id : Entity_Id := Empty;
- New_Id : Entity_Id := Empty;
- Kind : Scope_Kind := S_Local;
- Next : Assoc_Index := No_Assoc;
- end record;
-
- -- All maps are accessed through the following table. The map attribute
- -- of a generic unit or an instance is an index into this table.
-
- package Maps_Table is new Table.Table (
- Table_Component_Type => Map_Info,
- Table_Index_Type => Map,
- Table_Low_Bound => 0,
- Table_Initial => 100,
- Table_Increment => 100,
- Table_Name => "Maps_Table");
-
- -- All headers for hash tables are allocated in one global table. Each
- -- map stores the offset into this table at which its own headers start.
-
- package Headers_Table is new Table.Table (
- Table_Component_Type => Assoc_Index,
- Table_Index_Type => Header_Index,
- Table_Low_Bound => 0,
- Table_Initial => 1000,
- Table_Increment => 100,
- Table_Name => "Headers_Table");
-
- -- All associations are allocated in one global table. Each map stores
- -- the offset into this table at which its own associations start.
-
- package Associations_Table is new Table.Table (
- Table_Component_Type => Assoc,
- Table_Index_Type => Assoc_Index,
- Table_Low_Bound => 1,
- Table_Initial => 1000,
- Table_Increment => 100,
- Table_Name => "Associations_Table");
-
-end Sem_Maps;
projects / gcc.git / commitdiff