From cabadd1ce33412c70d2c910ae49c4341fe39d3b6 Mon Sep 17 00:00:00 2001 From: Arnaud Charlet Date: Thu, 25 Jun 2009 10:33:02 +0200 Subject: [PATCH] [multiple changes] 2009-06-25 Emmanuel Briot * 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 * gcc-interface/Make-lang.in: Remove references to sem_maps.o * sem_maps.adb, sem_maps.ads: Removed, not used. From-SVN: r148931 --- gcc/ada/ChangeLog | 13 + gcc/ada/gcc-interface/Make-lang.in | 15 +- gcc/ada/gnatcmd.adb | 14 +- gcc/ada/make.adb | 8 +- gcc/ada/mlib-prj.adb | 4 +- gcc/ada/prj-env.adb | 48 ++-- gcc/ada/prj-env.ads | 2 + gcc/ada/prj-nmsc.adb | 34 +-- gcc/ada/prj.adb | 16 +- gcc/ada/prj.ads | 6 - gcc/ada/sem_maps.adb | 373 ----------------------------- gcc/ada/sem_maps.ads | 167 ------------- 12 files changed, 61 insertions(+), 639 deletions(-) delete mode 100644 gcc/ada/sem_maps.adb delete mode 100644 gcc/ada/sem_maps.ads diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index c90ab103892..b5703fb6011 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,16 @@ +2009-06-25 Emmanuel Briot + + * 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 + + * 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 * s-vxwext-rtp.ads: Add missing declaration diff --git a/gcc/ada/gcc-interface/Make-lang.in b/gcc/ada/gcc-interface/Make-lang.in index ee3bb8f9697..dd8a4b49329 100644 --- a/gcc/ada/gcc-interface/Make-lang.in +++ b/gcc/ada/gcc-interface/Make-lang.in @@ -157,7 +157,7 @@ GNAT_ADA_OBJS = ada/s-bitops.o ada/ada.o ada/a-charac.o ada/a-chlat1.o ada/a-exc 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 \ @@ -3686,19 +3686,6 @@ ada/sem_intr.o : ada/ada.ads ada/a-except.ads ada/a-unccon.ads \ 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 \ diff --git a/gcc/ada/gnatcmd.adb b/gcc/ada/gnatcmd.adb index d4d5122b51a..89dcb6860ca 100644 --- a/gcc/ada/gnatcmd.adb +++ b/gcc/ada/gnatcmd.adb @@ -417,7 +417,7 @@ procedure GNATCmd is 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 @@ -427,7 +427,7 @@ procedure GNATCmd is 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 @@ -456,7 +456,7 @@ procedure GNATCmd is 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. @@ -478,7 +478,7 @@ procedure GNATCmd is 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. @@ -489,7 +489,7 @@ procedure GNATCmd is 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 @@ -523,7 +523,7 @@ procedure GNATCmd is 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 @@ -552,7 +552,7 @@ procedure GNATCmd is 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); diff --git a/gcc/ada/make.adb b/gcc/ada/make.adb index a2d4f6cf1b5..5999951b5fb 100644 --- a/gcc/ada/make.adb +++ b/gcc/ada/make.adb @@ -3609,7 +3609,7 @@ package body Make is 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 := @@ -3617,7 +3617,7 @@ package body Make is 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 := @@ -7002,7 +7002,7 @@ package body Make is -- 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 @@ -7049,7 +7049,7 @@ package body Make is 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 diff --git a/gcc/ada/mlib-prj.adb b/gcc/ada/mlib-prj.adb index 0b97c842800..c7f0f0b73f0 100644 --- a/gcc/ada/mlib-prj.adb +++ b/gcc/ada/mlib-prj.adb @@ -946,7 +946,7 @@ package body MLib.Prj is 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 @@ -975,7 +975,7 @@ package body MLib.Prj is 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); diff --git a/gcc/ada/prj-env.adb b/gcc/ada/prj-env.adb index e76a926607f..aa050d40913 100644 --- a/gcc/ada/prj-env.adb +++ b/gcc/ada/prj-env.adb @@ -622,7 +622,8 @@ package body Prj.Env is 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 @@ -650,7 +651,8 @@ package body Prj.Env is 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 @@ -676,6 +678,7 @@ package body Prj.Env is 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, @@ -685,6 +688,7 @@ package body Prj.Env is 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, @@ -718,7 +722,8 @@ package body Prj.Env is 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 @@ -744,18 +749,17 @@ package body Prj.Env is 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 @@ -764,22 +768,7 @@ package body Prj.Env is 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; @@ -971,7 +960,6 @@ package body Prj.Env is 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 @@ -997,7 +985,13 @@ package body Prj.Env is 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; diff --git a/gcc/ada/prj-env.ads b/gcc/ada/prj-env.ads index 3a92d996743..34b77aa4c25 100644 --- a/gcc/ada/prj-env.ads +++ b/gcc/ada/prj-env.ads @@ -56,6 +56,8 @@ package Prj.Env is -- 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); diff --git a/gcc/ada/prj-nmsc.adb b/gcc/ada/prj-nmsc.adb index b8a2864fd20..0f5cf320da2 100644 --- a/gcc/ada/prj-nmsc.adb +++ b/gcc/ada/prj-nmsc.adb @@ -4569,7 +4569,7 @@ package body Prj.Nmsc is -- 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, @@ -4618,7 +4618,7 @@ package body Prj.Nmsc is 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) @@ -7802,7 +7802,6 @@ package body Prj.Nmsc is Source : Source_Id := No_Source; OK : Boolean; Excluded : File_Found; - Index : Unit_Index; begin Excluded := Excluded_Sources_Htable.Get_First; @@ -7821,27 +7820,12 @@ package body Prj.Nmsc is 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 "); @@ -8134,12 +8118,12 @@ package body Prj.Nmsc is 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); diff --git a/gcc/ada/prj.adb b/gcc/ada/prj.adb index 4cc0c4d5a62..7d96eec8d4e 100644 --- a/gcc/ada/prj.adb +++ b/gcc/ada/prj.adb @@ -53,7 +53,6 @@ package body Prj is 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; @@ -620,9 +619,6 @@ package body Prj is 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)); @@ -1134,15 +1130,6 @@ package body Prj is 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 -- ----------------------- @@ -1464,7 +1451,8 @@ package body Prj is 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; ---------------------------- diff --git a/gcc/ada/prj.ads b/gcc/ada/prj.ads index f1cc450276c..456c17268ac 100644 --- a/gcc/ada/prj.ads +++ b/gcc/ada/prj.ads @@ -121,10 +121,6 @@ package Prj is -- 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 @@ -692,8 +688,6 @@ package Prj is 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 diff --git a/gcc/ada/sem_maps.adb b/gcc/ada/sem_maps.adb deleted file mode 100644 index 4e669d21e07..00000000000 --- a/gcc/ada/sem_maps.adb +++ /dev/null @@ -1,373 +0,0 @@ ------------------------------------------------------------------------------- --- -- --- 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; diff --git a/gcc/ada/sem_maps.ads b/gcc/ada/sem_maps.ads deleted file mode 100644 index 713999f92cc..00000000000 --- a/gcc/ada/sem_maps.ads +++ /dev/null @@ -1,167 +0,0 @@ ------------------------------------------------------------------------------- --- -- --- 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; -- 2.30.2