Skip to content

R
riscv-gcc-1
Commit 5a66a766 by Emmanuel Briot Committed by Arnaud Charlet
Options

gnatcmd.adb, [...] (Units_Table): Removed, since no longer useful. 

2009-06-24  Emmanuel Briot  <briot@adacore.com>

	* gnatcmd.adb, make.adb, mlib-prj.adb, prj.adb, prj.ads, clean.adb,
	prj-nmsc.adb, prj-env.adb, prj-proc.adb (Units_Table): Removed, since
	no longer useful.
	(Source_Data.Lang_Kind): Removed, since it duplicates information
	already available through Language.Config.
	(Source_Data.Compile): Removed, since information is already available
	through the language.
	(Is_Compilable): New subprogram.
	(Source_Data.Dependency): Removed, since already available through
	the language.
	(Source_Data.Object_Exist, Object_Linked): Removed since available
	through the language already.
	(Unit_Data.File_Names): Is now also set in multi_language mode, to
	bring the two modes closer in the resulting data structures.
	(Source_Data.Unit): Now a direct pointer to the unit data, rather than
	just the name that would point into a hash table.
	(Get_Language_From_Name): New subprogram.

From-SVN: r148901
parent 852dba80
Showing with 247 additions and 207 deletions
gcc/ada/ChangeLog
2009-06-24 Emmanuel Briot <briot@adacore.com>
* gnatcmd.adb, make.adb, mlib-prj.adb, prj.adb, prj.ads, clean.adb,
prj-nmsc.adb, prj-env.adb, prj-proc.adb (Units_Table): Removed, since
no longer useful.
(Source_Data.Lang_Kind): Removed, since it duplicates information
already available through Language.Config.
(Source_Data.Compile): Removed, since information is already available
through the language.
(Is_Compilable): New subprogram.
(Source_Data.Dependency): Removed, since already available through
the language.
(Source_Data.Object_Exist, Object_Linked): Removed since available
through the language already.
(Unit_Data.File_Names): Is now also set in multi_language mode, to
bring the two modes closer in the resulting data structures.
(Source_Data.Unit): Now a direct pointer to the unit data, rather than
just the name that would point into a hash table.
(Get_Language_From_Name): New subprogram.
2009-06-24 Javier Miranda <miranda@adacore.com>
* exp_ch4.adb (Expand_N_Type_Conversion): Handle entities that are
......
gcc/ada/clean.adb
......@@ -540,7 +540,7 @@ package body Clean is
Last : Natural;
Delete_File : Boolean;
Unit : Unit_Data;
Unit : Unit_Index;
begin
if Project.Library
......@@ -570,13 +570,11 @@ package body Clean is
Canonical_Case_File_Name (Name (1 .. Last));
Delete_File := False;
-- Compare with source file names of the project
Unit := Units_Htable.Get_First (Project_Tree.Units_HT);
for Index in
1 .. Unit_Table.Last (Project_Tree.Units)
loop
Unit := Project_Tree.Units.Table (Index);
-- Compare with source file names of the project
while Unit /= No_Unit_Index loop
if Unit.File_Names (Impl) /= null
and then Ultimate_Extending_Project_Of
(Unit.File_Names (Impl).Project) = Project
......@@ -599,6 +597,8 @@ package body Clean is
Delete_File := True;
exit;
end if;
Unit := Units_Htable.Get_Next (Project_Tree.Units_HT);
end loop;
if Delete_File then
......@@ -733,15 +733,13 @@ package body Clean is
if Last > 4 and then Name (Last - 3 .. Last) = ".ali" then
declare
Unit : Unit_Data;
Unit : Unit_Index;
begin
-- Compare with ALI file names of the project
for
Index in 1 .. Unit_Table.Last (Project_Tree.Units)
loop
Unit := Project_Tree.Units.Table (Index);
Unit := Units_Htable.Get_First
(Project_Tree.Units_HT);
while Unit /= No_Unit_Index loop
if Unit.File_Names (Impl) /= null
and then Unit.File_Names (Impl).Project /=
No_Project
......@@ -781,6 +779,9 @@ package body Clean is
exit;
end if;
end if;
Unit := Units_Htable.Get_Next
(Project_Tree.Units_HT);
end loop;
end;
end if;
......@@ -817,7 +818,7 @@ package body Clean is
-- Name of the executable file
Current_Dir : constant Dir_Name_Str := Get_Current_Dir;
U_Data : Unit_Data;
Unit : Unit_Index;
File_Name1 : File_Name_Type;
Index1 : Int;
File_Name2 : File_Name_Type;
......@@ -879,10 +880,8 @@ package body Clean is
if Has_Ada_Sources (Project)
or else Project.Extends /= No_Project
then
for Unit in Unit_Table.First ..
Unit_Table.Last (Project_Tree.Units)
loop
U_Data := Project_Tree.Units.Table (Unit);
Unit := Units_Htable.Get_First (Project_Tree.Units_HT);
while Unit /= No_Unit_Index loop
File_Name1 := No_File;
File_Name2 := No_File;
......@@ -890,29 +889,26 @@ package body Clean is
-- project, check for the corresponding ALI file in the
-- object directory.
if (U_Data.File_Names (Impl) /= null
if (Unit.File_Names (Impl) /= null
and then
In_Extension_Chain
(U_Data.File_Names (Impl).Project, Project))
(Unit.File_Names (Impl).Project, Project))
or else
(U_Data.File_Names (Spec) /= null
(Unit.File_Names (Spec) /= null
and then In_Extension_Chain
(U_Data.File_Names
(Spec).Project, Project))
(Unit.File_Names (Spec).Project, Project))
then
if U_Data.File_Names (Impl) /= null then
File_Name1 := U_Data.File_Names (Impl).File;
Index1 := U_Data.File_Names (Impl).Index;
if Unit.File_Names (Impl) /= null then
File_Name1 := Unit.File_Names (Impl).File;
Index1 := Unit.File_Names (Impl).Index;
else
File_Name1 := No_File;
Index1 := 0;
end if;
if U_Data.File_Names (Spec) /= null then
File_Name2 :=
U_Data.File_Names (Spec).File;
Index2 :=
U_Data.File_Names (Spec).Index;
if Unit.File_Names (Spec) /= null then
File_Name2 := Unit.File_Names (Spec).File;
Index2 := Unit.File_Names (Spec).Index;
else
File_Name2 := No_File;
Index2 := 0;
......@@ -1031,6 +1027,8 @@ package body Clean is
end if;
end;
end if;
Unit := Units_Htable.Get_Next (Project_Tree.Units_HT);
end loop;
end if;
......
gcc/ada/mlib-prj.adb
......@@ -936,18 +936,16 @@ package body MLib.Prj is
-- Bind is False, so that First_ALI is set.
declare
Unit : Unit_Data;
Unit : Unit_Index;
begin
Library_ALIs.Reset;
Interface_ALIs.Reset;
Processed_ALIs.Reset;
for Source in Unit_Table.First ..
Unit_Table.Last (In_Tree.Units)
loop
Unit := In_Tree.Units.Table (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
then
......@@ -988,6 +986,8 @@ package body MLib.Prj is
Add_ALI_For (Unit.File_Names (Spec).File);
exit when not Bind;
end if;
Unit := Units_Htable.Get_Next (In_Tree.Units_HT);
end loop;
end;
......@@ -1406,6 +1406,7 @@ package body MLib.Prj is
B_Start.all);
Fname : File_Name_Type;
Proj : Project_Id;
Index : Unit_Index;
begin
if Is_Regular_File (ALI_Path) then
......@@ -1417,35 +1418,26 @@ package body MLib.Prj is
-- the library.
if not Add_It then
for Index in
1 .. Unit_Table.Last
(In_Tree.Units)
loop
if In_Tree.Units.Table
(Index).File_Names
(Impl) /= null
Index := Units_Htable.Get_First
(In_Tree.Units_HT);
while Index /= null loop
if Index.File_Names (Impl) /=
null
then
Proj :=
In_Tree.Units.Table (Index).
File_Names
(Impl).Project;
Index.File_Names (Impl)
.Project;
Fname :=
In_Tree.Units.Table (Index).
File_Names (Impl).File;
Index.File_Names (Impl).File;
elsif
In_Tree.Units.Table
(Index).File_Names
(Spec) /= null
elsif Index.File_Names (Spec) /=
null
then
Proj :=
In_Tree.Units.Table
(Index).File_Names
(Spec).Project;
Index.File_Names (Spec)
.Project;
Fname :=
In_Tree.Units.Table
(Index).File_Names
(Spec).File;
Index.File_Names (Spec).File;
else
Proj := No_Project;
......@@ -1478,6 +1470,9 @@ package body MLib.Prj is
end if;
exit when Add_It;
Index := Units_Htable.Get_Next
(In_Tree.Units_HT);
end loop;
end if;
......@@ -1830,16 +1825,13 @@ package body MLib.Prj is
and then Name (Last - 3 .. Last) = ".ali"
then
declare
Unit : Unit_Data;
Unit : Unit_Index;
begin
-- Compare with ALI file names of the project
for Index in
1 .. Unit_Table.Last (In_Tree.Units)
loop
Unit := In_Tree.Units.Table (Index);
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).Project /=
No_Project
......@@ -1880,6 +1872,8 @@ package body MLib.Prj is
exit;
end if;
end if;
Unit := Units_Htable.Get_Next (In_Tree.Units_HT);
end loop;
end;
end if;
......@@ -1959,7 +1953,7 @@ package body MLib.Prj is
declare
Dir : Dir_Type;
Delete : Boolean := False;
Unit : Unit_Data;
Unit : Unit_Index;
Name : String (1 .. 200);
Last : Natural;
......@@ -1980,9 +1974,8 @@ package body MLib.Prj is
-- Compare with source file names of the project
for Index in 1 .. Unit_Table.Last (In_Tree.Units) loop
Unit := In_Tree.Units.Table (Index);
Unit := Units_Htable.Get_First (In_Tree.Units_HT);
while Unit /= No_Unit_Index loop
if Unit.File_Names (Impl) /= null
and then Ultimate_Extending_Project_Of
(Unit.File_Names (Impl).Project) = For_Project
......@@ -2007,6 +2000,8 @@ package body MLib.Prj is
Delete := True;
exit;
end if;
Unit := Units_Htable.Get_Next (In_Tree.Units_HT);
end loop;
end if;
......@@ -2163,7 +2158,7 @@ package body MLib.Prj is
First_Unit : ALI.Unit_Id;
Second_Unit : ALI.Unit_Id;
Data : Unit_Data;
Data : Unit_Index;
Copy_Subunits : Boolean := False;
-- When True, indicates that subunits, if any, need to be copied too
......@@ -2186,12 +2181,10 @@ package body MLib.Prj is
pragma Warnings (Off, Success);
begin
Unit_Loop :
for Index in Unit_Table.First ..
Unit_Table.Last (In_Tree.Units)
loop
Data := In_Tree.Units.Table (Index);
Data := Units_Htable.Get_First (In_Tree.Units_HT);
Unit_Loop :
while Data /= No_Unit_Index loop
-- Find and copy the immediate or inherited source
for J in Data.File_Names'Range loop
......@@ -2209,6 +2202,8 @@ package body MLib.Prj is
exit Unit_Loop;
end if;
end loop;
Data := Units_Htable.Get_Next (In_Tree.Units_HT);
end loop Unit_Loop;
end Copy;
......
gcc/ada/prj-proc.adb
......@@ -321,9 +321,8 @@ package body Prj.Proc is
Source1 := Prj.Element (Iter);
exit when Source1 = No_Source;
Name := Source1.Unit;
if Name /= No_Name then
if Source1.Unit /= No_Unit_Index then
Name := Source1.Unit.Name;
Source2 := Unit_Htable.Get (Name);
if Source2 = No_Source then
......
gcc/ada/prj.adb
......@@ -149,6 +149,9 @@ package body Prj is
procedure Free_List (Languages : in out Language_List);
-- Free memory allocated for the list of languages or sources
procedure Free_Units (Table : in out Units_Htable.Instance);
-- Free memory allocated for unit information in the project
procedure Language_Changed (Iter : in out Source_Iterator);
procedure Project_Changed (Iter : in out Source_Iterator);
-- Called when a new project or language was selected for this iterator.
......@@ -638,21 +641,10 @@ package body Prj is
function Is_A_Language
(Project : Project_Id;
Language_Name : Name_Id) return Boolean
is
Lang_Ind : Language_Ptr;
Language_Name : Name_Id) return Boolean is
begin
Lang_Ind := Project.Languages;
while Lang_Ind /= No_Language_Index loop
if Lang_Ind.Name = Language_Name then
return True;
end if;
Lang_Ind := Lang_Ind.Next;
end loop;
return False;
return Get_Language_From_Name
(Project, Get_Name_String (Language_Name)) /= null;
end Is_A_Language;
------------------
......@@ -860,6 +852,11 @@ package body Prj is
while Source /= No_Source loop
Tmp := Source.Next_In_Lang;
Free_List (Source.Alternate_Languages);
if Source.Unit /= null then
Source.Unit.File_Names (Source.Kind) := null;
end if;
Unchecked_Free (Source);
Source := Tmp;
end loop;
......@@ -907,6 +904,32 @@ package body Prj is
end loop;
end Free_List;
----------------
-- Free_Units --
----------------
procedure Free_Units (Table : in out Units_Htable.Instance) is
procedure Unchecked_Free is new Ada.Unchecked_Deallocation
(Unit_Data, Unit_Index);
Unit : Unit_Index;
begin
Unit := Units_Htable.Get_First (Table);
while Unit /= No_Unit_Index loop
if Unit.File_Names (Spec) /= null then
Unit.File_Names (Spec).Unit := No_Unit_Index;
end if;
if Unit.File_Names (Impl) /= null then
Unit.File_Names (Impl).Unit := No_Unit_Index;
end if;
Unchecked_Free (Unit);
Unit := Units_Htable.Get_Next (Table);
end loop;
Units_Htable.Reset (Table);
end Free_Units;
----------
-- Free --
----------
......@@ -923,12 +946,11 @@ package body Prj is
Array_Element_Table.Free (Tree.Array_Elements);
Array_Table.Free (Tree.Arrays);
Package_Table.Free (Tree.Packages);
Unit_Table.Free (Tree.Units);
Units_Htable.Reset (Tree.Units_HT);
Source_Paths_Htable.Reset (Tree.Source_Paths_HT);
Unit_Sources_Htable.Reset (Tree.Unit_Sources_HT);
Free_List (Tree.Projects, Free_Project => True);
Free_Units (Tree.Units_HT);
-- Private part
......@@ -961,12 +983,11 @@ package body Prj is
Array_Element_Table.Init (Tree.Array_Elements);
Array_Table.Init (Tree.Arrays);
Package_Table.Init (Tree.Packages);
Unit_Table.Init (Tree.Units);
Units_Htable.Reset (Tree.Units_HT);
Source_Paths_Htable.Reset (Tree.Source_Paths_HT);
Unit_Sources_Htable.Reset (Tree.Unit_Sources_HT);
Free_List (Tree.Projects, Free_Project => True);
Free_Units (Tree.Units_HT);
-- Private part table
......@@ -1427,6 +1448,42 @@ package body Prj is
For_All_Projects (Project, Dummy);
end Compute_All_Imported_Projects;
-------------------
-- Is_Compilable --
-------------------
function Is_Compilable (Source : Source_Id) return Boolean is
begin
return Source.Language.Config.Compiler_Driver /= Empty_File_Name;
end Is_Compilable;
----------------------------
-- Get_Language_From_Name --
----------------------------
function Get_Language_From_Name
(Project : Project_Id; Name : String) return Language_Ptr
is
N : Name_Id;
Result : Language_Ptr;
begin
Name_Len := Name'Length;
Name_Buffer (1 .. Name_Len) := Name;
To_Lower (Name_Buffer (1 .. Name_Len));
N := Name_Find;
Result := Project.Languages;
while Result /= No_Language_Index loop
if Result.Name = N then
return Result;
end if;
Result := Result.Next;
end loop;
return No_Language_Index;
end Get_Language_From_Name;
begin
-- Make sure that the standard config and user project file extensions are
-- compatible with canonical case file naming.
......
gcc/ada/prj.ads
......@@ -307,6 +307,11 @@ package Prj is
No_Language_Index : constant Language_Ptr := null;
-- Constant indicating that there is no language data
function Get_Language_From_Name
(Project : Project_Id; Name : String) return Language_Ptr;
-- Get a language from a project. This might return null if no such
-- language exists in the project
Max_Header_Num : constant := 6150;
type Header_Num is range 0 .. Max_Header_Num;
-- Size for hash table below. The upper bound is an arbitrary value, the
......@@ -392,6 +397,11 @@ package Prj is
type Source_Data;
type Source_Id is access all Source_Data;
function Is_Compilable (Source : Source_Id) return Boolean;
pragma Inline (Is_Compilable);
-- Return True if we know how to compile Source (ie if a compiler is
-- defined). This doesn't indicate whether the source should be compiled
No_Source : constant Source_Id := null;
type Path_Syntax_Kind is
......@@ -615,6 +625,17 @@ package Prj is
end record;
type Source_Kind is (Spec, Impl, Sep);
subtype Spec_Or_Body is Source_Kind range Spec .. Impl;
type File_Names_Data is array (Spec_Or_Body) of Source_Id;
type Unit_Data is record
Name : Name_Id := No_Name;
File_Names : File_Names_Data;
end record;
type Unit_Index is access Unit_Data;
No_Unit_Index : constant Unit_Index := null;
-- Name and File and Path names of a unit, with a reference to its
-- GNAT Project File(s).
type Source_Data is record
Project : Project_Id := No_Project;
......@@ -624,13 +645,6 @@ package Prj is
-- Index of the language. This is an index into
-- Project_Tree.Languages_Data.
Lang_Kind : Language_Kind := File_Based;
-- Kind of the language
-- ??? Should be in Language itself
Compiled : Boolean := True;
-- False when there is no compiler for the language
In_Interfaces : Boolean := True;
-- False when the source is not included in interfaces, when attribute
-- Interfaces is declared.
......@@ -645,14 +659,11 @@ package Prj is
Kind : Source_Kind := Spec;
-- Kind of the source: spec, body or subunit
Dependency : Dependency_File_Kind := None;
-- Kind of dependency: none, Makefile fragment or ALI file
Other_Part : Source_Id := No_Source;
-- Source ID for the other part, if any: for a spec, indicates its body;
-- for a body, indicates its spec.
Unit : Name_Id := No_Name;
Unit : Unit_Index := No_Unit_Index;
-- Name of the unit, if language is unit based
Index : Int := 0;
......@@ -686,13 +697,6 @@ package Prj is
-- Project where the object file is. This might be different from
-- Project when using extending project files.
Object_Exists : Boolean := True;
-- True if an object file exists
Object_Linked : Boolean := True;
-- False if the object file is not use to link executables or included
-- in libraries.
Object : File_Name_Type := No_File;
-- File name of the object file
......@@ -737,15 +741,12 @@ package Prj is
No_Source_Data : constant Source_Data :=
(Project => No_Project,
Language => No_Language_Index,
Lang_Kind => File_Based,
Compiled => True,
In_Interfaces => True,
Declared_In_Interfaces => False,
Alternate_Languages => null,
Kind => Spec,
Dependency => None,
Other_Part => No_Source,
Unit => No_Name,
Unit => No_Unit_Index,
Index => 0,
Locally_Removed => False,
Get_Object => False,
......@@ -755,8 +756,6 @@ package Prj is
Path => No_Path_Information,
Source_TS => Empty_Time_Stamp,
Object_Project => No_Project,
Object_Exists => True,
Object_Linked => True,
Object => No_File,
Current_Object_Path => No_Path,
Object_Path => No_Path,
......@@ -1345,25 +1344,6 @@ package Prj is
Project_Error : exception;
-- Raised by some subprograms in Prj.Attr
subtype Spec_Or_Body is Source_Kind range Spec .. Impl;
type File_Names_Data is array (Spec_Or_Body) of Source_Id;
type Unit_Index is new Nat;
No_Unit_Index : constant Unit_Index := 0;
type Unit_Data is record
Name : Name_Id := No_Name;
File_Names : File_Names_Data;
end record;
-- Name and File and Path names of a unit, with a reference to its
-- GNAT Project File(s).
package Unit_Table is new GNAT.Dynamic_Tables
(Table_Component_Type => Unit_Data,
Table_Index_Type => Unit_Index,
Table_Low_Bound => 1,
Table_Initial => 100,
Table_Increment => 100);
-- Table of all units in a project tree
package Units_Htable is new Simple_HTable
(Header_Num => Header_Num,
Element => Unit_Index,
......@@ -1417,7 +1397,6 @@ package Prj is
Arrays : Array_Table.Instance;
Packages : Package_Table.Instance;
Projects : Project_List;
Units : Unit_Table.Instance;
Units_HT : Units_Htable.Instance;
Source_Paths_HT : Source_Paths_Htable.Instance;
Unit_Sources_HT : Unit_Sources_Htable.Instance;
......
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