Skip to content

R
riscv-gcc-1
Commit cabadd1c by Arnaud Charlet
Options

[multiple changes] 

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.

From-SVN: r148931
parent 9763f8c8
Showing with 61 additions and 266 deletions
gcc/ada/ChangeLog
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
......
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 \
......
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);
......
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
......
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);
......
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;
......
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);
......
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);
......
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;
----------------------------
......
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
......
gcc/ada/sem_maps.ads deleted 100644 → 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;
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment