Skip to content

R
riscv-gcc-1
Commit 02954c25 by Arnaud Charlet
Options

[multiple changes] 

2010-09-09  Ed Schonberg  <schonberg@adacore.com>

	* sem_util.adb (Same_Object): include formal parameters.

2010-09-09  Vincent Celier  <celier@adacore.com>

	* make.adb (Queue): New package implementing a new impementation of the
	queue, taking into account the new switch --single-compile-per-obj-dir.
	* makeutl.ads (Single_Compile_Per_Obj_Dir_Switch): New constant String
	for gnatmake and gprbuild new switch --single-compile-per-obj-dir.
	* opt.ads (One_Compilation_Per_Obj_Dir): New Boolean flag, defauted to
	False.
	* switch-m.adb (Scan_Make_Switches): Take into account new gnatmake
	switch --single-compile-per-obj-dir.
	* vms_data.ads: Add qualifier SINGLE_COMPILE_PER_OBJ_DIR for gnatmake
	switch --single-compile-per-obj-dir.
	* gnat_ugn.texi: Add documentation for new gnatmake switch
	--single-compile-per-obj-dir.

From-SVN: r164067
parent 855f2f8c
Showing with 453 additions and 229 deletions
gcc/ada/ChangeLog
2010-09-09 Ed Schonberg <schonberg@adacore.com>
* sem_util.adb (Same_Object): include formal parameters.
2010-09-09 Vincent Celier <celier@adacore.com>
* make.adb (Queue): New package implementing a new impementation of the
queue, taking into account the new switch --single-compile-per-obj-dir.
* makeutl.ads (Single_Compile_Per_Obj_Dir_Switch): New constant String
for gnatmake and gprbuild new switch --single-compile-per-obj-dir.
* opt.ads (One_Compilation_Per_Obj_Dir): New Boolean flag, defauted to
False.
* switch-m.adb (Scan_Make_Switches): Take into account new gnatmake
switch --single-compile-per-obj-dir.
* vms_data.ads: Add qualifier SINGLE_COMPILE_PER_OBJ_DIR for gnatmake
switch --single-compile-per-obj-dir.
* gnat_ugn.texi: Add documentation for new gnatmake switch
--single-compile-per-obj-dir.
2010-09-09 Ed Schonberg <schonberg@adacore.com>
* einfo.adb, einfo.ads: Clarify use of Corresponding_Protected_Entry.
2010-09-09 Javier Miranda <miranda@adacore.com>
......
gcc/ada/gnat_ugn.texi
......@@ -9250,7 +9250,11 @@ itself must not include any embedded spaces.
@item ^--subdirs^/SUBDIRS^=subdir
Actual object directory of each project file is the subdirectory subdir of the
object directory specified or defauted in the project file.
object directory specified or defaulted in the project file.
@item ^--single-compile-per-obj-dir^/SINGLE_COMPILE_PER_OBJ_DIR^
Disallow simultaneous compilations in the same object directory when
project files are used.
@item ^--unchecked-shared-lib-imports^/UNCHECKED_SHARED_LIB_IMPORTS^
By default, shared library projects are not allowed to import static library
......
gcc/ada/make.adb
......@@ -71,6 +71,7 @@ with Ada.Command_Line; use Ada.Command_Line;
with GNAT.Directory_Operations; use GNAT.Directory_Operations;
with GNAT.Dynamic_HTables; use GNAT.Dynamic_HTables;
with GNAT.HTable;
with GNAT.Case_Util; use GNAT.Case_Util;
with GNAT.OS_Lib; use GNAT.OS_Lib;
......@@ -135,49 +136,6 @@ package body Make is
-- complex, for example in main.1.ada, the termination in this name is
-- ".1.ada" and in main_.ada the termination is "_.ada".
-------------------------------------
-- Queue (Q) Manipulation Routines --
-------------------------------------
-- The Q is used in Compile_Sources below. Its implementation uses the GNAT
-- generic package Table (basically an extensible array). Q_Front points to
-- the first valid element in the Q, whereas Q.First is the first element
-- ever enqueued, while Q.Last - 1 is the last element in the Q.
--
-- +---+--------------+---+---+---+-----------+---+--------
-- Q | | ........ | | | | ....... | |
-- +---+--------------+---+---+---+-----------+---+--------
-- ^ ^ ^
-- Q.First Q_Front Q.Last-1
--
-- The elements comprised between Q.First and Q_Front-1 are the elements
-- that have been enqueued and then dequeued, while the elements between
-- Q_Front and Q.Last-1 are the elements currently in the Q. When the Q
-- is initialized Q_Front = Q.First = Q.Last. After Compile_Sources has
-- terminated its execution, Q_Front = Q.Last and the elements contained
-- between Q.First and Q.Last-1 are those that were explored and thus
-- marked by Compile_Sources. Whenever the Q is reinitialized, the elements
-- between Q.First and Q.Last-1 are unmarked.
procedure Init_Q;
-- Must be called to (re)initialize the Q
procedure Insert_Q
(Source_File : File_Name_Type;
Source_Unit : Unit_Name_Type := No_Unit_Name;
Index : Int := 0);
-- Inserts Source_File at the end of Q. Provide Source_Unit when possible
-- for external use (gnatdist). Provide index for multi-unit sources.
function Empty_Q return Boolean;
-- Returns True if Q is empty
procedure Extract_From_Q
(Source_File : out File_Name_Type;
Source_Unit : out Unit_Name_Type;
Source_Index : out Int);
-- Extracts the first element from the Q
procedure Insert_Project_Sources
(The_Project : Project_Id;
All_Projects : Boolean;
......@@ -190,12 +148,6 @@ package body Make is
-- including, if The_Project is an extending project, sources inherited
-- from projects being extended.
First_Q_Initialization : Boolean := True;
-- Will be set to false after Init_Q has been called once
Q_Front : Natural;
-- Points to the first valid element in the Q
Unique_Compile : Boolean := False;
-- Set to True if -u or -U or a project file with no main is used
......@@ -216,24 +168,55 @@ package body Make is
N_M_Switch : Natural := 0;
-- Used to count -mxxx switches that can affect multilib
type Q_Record is record
File : File_Name_Type;
Unit : Unit_Name_Type;
Index : Int;
end record;
-- File is the name of the file to compile. Unit is for gnatdist
-- use in order to easily get the unit name of a file to compile
-- when its name is krunched or declared in gnat.adc. Index, when not 0,
-- is the index of the unit in a multi-unit source.
package Queue is
---------------------------------
-- Queue Manipulation Routines --
---------------------------------
package Q is new Table.Table (
Table_Component_Type => Q_Record,
Table_Index_Type => Natural,
Table_Low_Bound => 0,
Table_Initial => 4000,
Table_Increment => 100,
Table_Name => "Make.Q");
-- This is the actual Q
procedure Initialize (Queue_Per_Obj_Dir : Boolean);
-- Initialize the queue
function Is_Empty return Boolean;
-- Returns True if the queue is empty
function Is_Virtually_Empty return Boolean;
-- Returns True if the queue is empty or if all object directories are
-- busy.
procedure Insert
(Source_File_Name : File_Name_Type;
Project : Project_Id;
Source_Unit : Unit_Name_Type := No_Unit_Name;
Index : Int := 0);
-- Insert source in the queue
procedure Extract
(Source_File_Name : out File_Name_Type;
Source_Unit : out Unit_Name_Type;
Source_Index : out Int);
-- Get the first source that can be compiled from the queue. If no
-- source may be compiled, return No_File/No_Source.
function Size return Natural;
-- Return the total size of the queue, including the sources already
-- extracted.
function Processed return Natural;
-- Return the number of source in the queue that have aready been
-- processed.
procedure Set_Obj_Dir_Busy (Obj_Dir : Path_Name_Type);
-- Indicate that this object directory is busy, so that when
-- One_Compilation_Per_Obj_Dir is True no other compilation occurs in
-- this object directory.
procedure Set_Obj_Dir_Free (Obj_Dir : Path_Name_Type);
-- Indicate that there is no compilation for this object directory
function Element (Rank : Positive) return File_Name_Type;
-- Get the file name for element of index Rank in the queue
end Queue;
-- The 3 following packages are used to store gcc, gnatbind and gnatlink
-- switches found in the project files.
......@@ -2503,8 +2486,13 @@ package body Make is
-- library file name. Process_Id of the process spawned to execute the
-- compilation.
type ALI_Project is record
ALI : ALI_Id;
Project : Project_Id;
end record;
package Good_ALI is new Table.Table (
Table_Component_Type => ALI_Id,
Table_Component_Type => ALI_Project,
Table_Index_Type => Natural,
Table_Low_Bound => 1,
Table_Initial => 50,
......@@ -2519,7 +2507,7 @@ package body Make is
-- Get a mapping file name. If there is one to be reused, reuse it.
-- Otherwise, create a new mapping file.
function Get_Next_Good_ALI return ALI_Id;
function Get_Next_Good_ALI return ALI_Project;
-- Returns the next good ALI_Id record
procedure Record_Failure
......@@ -2530,7 +2518,7 @@ package body Make is
-- If Found is False then the compilation of File failed because we
-- could not find it. Records also Unit when possible.
procedure Record_Good_ALI (A : ALI_Id);
procedure Record_Good_ALI (A : ALI_Id; Project : Project_Id);
-- Records in the previous set the Id of an ALI file
function Must_Exit_Because_Of_Error return Boolean;
......@@ -2586,6 +2574,10 @@ package body Make is
Project => Arguments_Project);
Outstanding_Compiles := OC1;
if Arguments_Project /= No_Project then
Queue.Set_Obj_Dir_Busy (Arguments_Project.Object_Directory.Name);
end if;
end Add_Process;
--------------------
......@@ -2624,6 +2616,10 @@ package body Make is
Data := Running_Compile (J);
Project := Running_Compile (J).Project;
if Project /= No_Project then
Queue.Set_Obj_Dir_Free (Project.Object_Directory.Name);
end if;
-- If a mapping file was used by this compilation, get its
-- file name for reuse by a subsequent compilation.
......@@ -2704,7 +2700,7 @@ package body Make is
end if;
else
Insert_Q (Sfile, Index => 0);
Queue.Insert (Sfile, Project => No_Project, Index => 0);
Mark (Sfile, Index => 0);
end if;
end if;
......@@ -3013,6 +3009,7 @@ package body Make is
-------------------------------
procedure Fill_Queue_From_ALI_Files is
ALI_P : ALI_Project;
ALI : ALI_Id;
Source_Index : Int;
Sfile : File_Name_Type;
......@@ -3022,8 +3019,9 @@ package body Make is
begin
while Good_ALI_Present loop
ALI := Get_Next_Good_ALI;
Source_Index := Unit_Index_Of (ALIs.Table (ALI).Afile);
ALI_P := Get_Next_Good_ALI;
ALI := ALI_P.ALI;
Source_Index := Unit_Index_Of (ALIs.Table (ALI_P.ALI).Afile);
-- If we are processing the library file corresponding to the
-- main source file check if this source can be a main unit.
......@@ -3109,8 +3107,11 @@ package body Make is
Debug_Msg ("Skipping internal file:", Sfile);
else
Insert_Q
(Sfile, Withs.Table (K).Uname, Source_Index);
Queue.Insert
(Sfile,
ALI_P.Project,
Withs.Table (K).Uname,
Source_Index);
Mark (Sfile, Source_Index);
end if;
end if;
......@@ -3156,14 +3157,14 @@ package body Make is
-- Get_Next_Good_ALI --
-----------------------
function Get_Next_Good_ALI return ALI_Id is
ALI : ALI_Id;
function Get_Next_Good_ALI return ALI_Project is
ALIP : ALI_Project;
begin
pragma Assert (Good_ALI_Present);
ALI := Good_ALI.Table (Good_ALI.Last);
ALIP := Good_ALI.Table (Good_ALI.Last);
Good_ALI.Decrement_Last;
return ALI;
return ALIP;
end Get_Next_Good_ALI;
----------------------
......@@ -3217,10 +3218,10 @@ package body Make is
-- Record_Good_ALI --
---------------------
procedure Record_Good_ALI (A : ALI_Id) is
procedure Record_Good_ALI (A : ALI_Id; Project : Project_Id) is
begin
Good_ALI.Increment_Last;
Good_ALI.Table (Good_ALI.Last) := A;
Good_ALI.Table (Good_ALI.Last) := (A, Project);
end Record_Good_ALI;
-------------------------------
......@@ -3256,8 +3257,10 @@ package body Make is
-- The object file
begin
if not Empty_Q and then Outstanding_Compiles < Max_Process then
Extract_From_Q (Source_File, Source_Unit, Source_Index);
if not Queue.Is_Virtually_Empty and then
Outstanding_Compiles < Max_Process
then
Queue.Extract (Source_File, Source_Unit, Source_Index);
Osint.Full_Source_Name
(Source_File,
......@@ -3387,7 +3390,7 @@ package body Make is
-- The ALI file is up-to-date; record its Id
Record_Good_ALI (ALI);
Record_Good_ALI (ALI, Arguments_Project);
-- Record the time stamp of the most recent object
-- file as long as no (re)compilations are needed.
......@@ -3542,7 +3545,7 @@ package body Make is
begin
if Outstanding_Compiles = Max_Process
or else (Empty_Q
or else (Queue.Is_Virtually_Empty
and then not Good_ALI_Present
and then Outstanding_Compiles > 0)
then
......@@ -3603,7 +3606,7 @@ package body Make is
end if;
else
Record_Good_ALI (ALI);
Record_Good_ALI (ALI, Data.Project);
end if;
Free (Text);
......@@ -3639,10 +3642,6 @@ package body Make is
Good_ALI.Init;
if First_Q_Initialization then
Init_Q;
end if;
if Initialize_ALI_Data then
Initialize_ALI;
Initialize_ALI_Source;
......@@ -3662,7 +3661,7 @@ package body Make is
-- compilations if -jnnn is used.
if not Is_Marked (Main_Source, Main_Index) then
Insert_Q (Main_Source, Index => Main_Index);
Queue.Insert (Main_Source, Main_Project, Index => Main_Index);
Mark (Main_Source, Main_Index);
end if;
......@@ -3674,7 +3673,8 @@ package body Make is
-- Keep looping until there is no more work to do (the Q is empty)
-- and all the outstanding compilations have terminated.
Make_Loop : while not Empty_Q or else Outstanding_Compiles > 0 loop
Make_Loop :
while not Queue.Is_Empty or else Outstanding_Compiles > 0 loop
exit Make_Loop when Must_Exit_Because_Of_Error;
exit Make_Loop when Start_Compile_If_Possible (Args);
......@@ -3687,11 +3687,11 @@ package body Make is
if Display_Compilation_Progress then
Write_Str ("completed ");
Write_Int (Int (Q_Front));
Write_Int (Int (Queue.Processed));
Write_Str (" out of ");
Write_Int (Int (Q.Last));
Write_Int (Int (Queue.Size));
Write_Str (" (");
Write_Int (Int ((Q_Front * 100) / (Q.Last - Q.First)));
Write_Int (Int ((Queue.Processed * 100) / Queue.Size));
Write_Str ("%)...");
Write_Eol;
end if;
......@@ -4052,29 +4052,6 @@ package body Make is
Display_Executed_Programs := Display;
end Display_Commands;
-------------
-- Empty_Q --
-------------
function Empty_Q return Boolean is
begin
if Debug.Debug_Flag_P then
Write_Str (" Q := [");
for J in Q_Front .. Q.Last - 1 loop
Write_Str (" ");
Write_Name (Q.Table (J).File);
Write_Eol;
Write_Str (" ");
end loop;
Write_Str ("]");
Write_Eol;
end if;
return Q_Front >= Q.Last;
end Empty_Q;
--------------------------
-- Enter_Into_Obsoleted --
--------------------------
......@@ -4106,39 +4083,6 @@ package body Make is
Obsoleted.Set (F2, True);
end Enter_Into_Obsoleted;
--------------------
-- Extract_From_Q --
--------------------
procedure Extract_From_Q
(Source_File : out File_Name_Type;
Source_Unit : out Unit_Name_Type;
Source_Index : out Int)
is
File : constant File_Name_Type := Q.Table (Q_Front).File;
Unit : constant Unit_Name_Type := Q.Table (Q_Front).Unit;
Index : constant Int := Q.Table (Q_Front).Index;
begin
if Debug.Debug_Flag_Q then
Write_Str (" Q := Q - [ ");
Write_Name (File);
if Index /= 0 then
Write_Str (", ");
Write_Int (Index);
end if;
Write_Str (" ]");
Write_Eol;
end if;
Q_Front := Q_Front + 1;
Source_File := File;
Source_Unit := Unit;
Source_Index := Index;
end Extract_From_Q;
--------------
-- Gnatmake --
--------------
......@@ -4575,10 +4519,10 @@ package body Make is
Add_Switch ("-n", Binder, And_Save => True);
for J in Q.First .. Q.Last - 1 loop
for J in 1 .. Queue.Size loop
Add_Switch
(Get_Name_String
(Lib_File_Name (Q.Table (J).File)),
(Lib_File_Name (Queue.Element (J))),
Binder, And_Save => True);
end loop;
end if;
......@@ -5595,6 +5539,10 @@ package body Make is
Args (J) := Gcc_Switches.Table (J);
end loop;
Queue.Initialize
(Main_Project /= No_Project and then
One_Compilation_Per_Obj_Dir);
-- Now we invoke Compile_Sources for the current main
Compile_Sources
......@@ -5619,10 +5567,6 @@ package body Make is
Write_Eol;
end if;
-- Make sure the queue will be reinitialized for the next round
First_Q_Initialization := True;
Total_Compilation_Failures :=
Total_Compilation_Failures + Compilation_Failures;
......@@ -6688,17 +6632,6 @@ package body Make is
File_Index := Data.Last_Mapping_File_Names;
end Init_Mapping_File;
------------
-- Init_Q --
------------
procedure Init_Q is
begin
First_Q_Initialization := False;
Q_Front := Q.First;
Q.Set_Last (Q.First);
end Init_Q;
----------------
-- Initialize --
----------------
......@@ -6969,6 +6902,7 @@ package body Make is
Unit : Unit_Index;
Sfile : File_Name_Type;
Index : Int;
Project : Project_Id;
Extending : constant Boolean := The_Project.Extends /= No_Project;
......@@ -7010,8 +6944,9 @@ package body Make is
Unit := Units_Htable.Get_First (Project_Tree.Units_HT);
while Unit /= null loop
Sfile := No_File;
Index := 0;
Sfile := No_File;
Index := 0;
Project := No_Project;
-- If there is a source for the body, and the body has not been
-- locally removed.
......@@ -7022,6 +6957,7 @@ package body Make is
-- And it is a source for the specified project
if Check_Project (Unit.File_Names (Impl).Project) then
Project := Unit.File_Names (Impl).Project;
-- If we don't have a spec, we cannot consider the source
-- if it is a subunit.
......@@ -7072,38 +7008,36 @@ package body Make is
Sfile := Unit.File_Names (Spec).Display_File;
Index := Unit.File_Names (Spec).Index;
Project := Unit.File_Names (Spec).Project;
end if;
-- If Put_In_Q is True, we insert into the Q
-- For the first source inserted into the Q, we need to initialize
-- the Q, but not for the subsequent sources.
if Put_In_Q then
Queue.Initialize
(Main_Project /= No_Project and then
One_Compilation_Per_Obj_Dir);
-- For the first source inserted into the Q, we need to initialize
-- the Q, but not for the subsequent sources.
-- And of course, only insert in the Q if the source is not marked
if First_Q_Initialization then
Init_Q;
if Sfile /= No_File and then not Is_Marked (Sfile, Index) then
if Verbose_Mode then
Write_Str ("Adding """);
Write_Str (Get_Name_String (Sfile));
Write_Line (""" to the queue");
end if;
-- And of course, only insert in the Q if the source is not marked
if Sfile /= No_File and then not Is_Marked (Sfile, Index) then
if Verbose_Mode then
Write_Str ("Adding """);
Write_Str (Get_Name_String (Sfile));
Write_Line (""" to the queue");
end if;
Insert_Q (Sfile, Index => Index);
Mark (Sfile, Index);
end if;
Queue.Insert (Sfile, Project, Index => Index);
Mark (Sfile, Index);
end if;
elsif Sfile /= No_File then
if not Put_In_Q and then Sfile /= No_File then
-- If Put_In_Q is False, we add the source as if it were specified
-- on the command line, and we set Put_In_Q to True, so that the
-- following sources will be put directly in the queue. This will
-- allow parallel compilation processes if -jx switch is used.
-- following sources will only be put in the queue. The source is
-- aready in the Q, but we need at least one fake main to call
-- Compile_Sources.
if Verbose_Mode then
Write_Str ("Adding """);
......@@ -7113,49 +7047,12 @@ package body Make is
Osint.Add_File (Get_Name_String (Sfile), Index);
Put_In_Q := True;
-- As we may look into the Q later, ensure the Q has been
-- initialized to avoid errors.
if First_Q_Initialization then
Init_Q;
end if;
end if;
Unit := Units_Htable.Get_Next (Project_Tree.Units_HT);
end loop;
end Insert_Project_Sources;
--------------
-- Insert_Q --
--------------
procedure Insert_Q
(Source_File : File_Name_Type;
Source_Unit : Unit_Name_Type := No_Unit_Name;
Index : Int := 0)
is
begin
if Debug.Debug_Flag_Q then
Write_Str (" Q := Q + [ ");
Write_Name (Source_File);
if Index /= 0 then
Write_Str (", ");
Write_Int (Index);
end if;
Write_Str (" ] ");
Write_Eol;
end if;
Q.Table (Q.Last) :=
(File => Source_File,
Unit => Source_Unit,
Index => Index);
Q.Increment_Last;
end Insert_Q;
---------------------
-- Is_In_Obsoleted --
---------------------
......@@ -7568,6 +7465,290 @@ package body Make is
(Project_Node_Tree, "--RTS=" & Line (1 .. N_Read), And_Save => True);
end Process_Multilib;
-----------
-- Queue --
-----------
package body Queue is
type Q_Record is record
File : File_Name_Type;
Unit : Unit_Name_Type;
Index : Int;
Project : Project_Id;
Processed : Boolean;
end record;
-- File is the name of the file to compile. Unit is for gnatdist use in
-- order to easily get the unit name of a file to compile when its name
-- is krunched or declared in gnat.adc. Index, when not 0, is the index
-- of the unit in a multi-unit source.
package Q is new Table.Table
(Table_Component_Type => Q_Record,
Table_Index_Type => Positive,
Table_Low_Bound => 1,
Table_Initial => 4000,
Table_Increment => 100,
Table_Name => "Make.Queue.Q");
-- This is the actual Q
package Busy_Obj_Dirs is new GNAT.HTable.Simple_HTable
(Header_Num => Prj.Header_Num,
Element => Boolean,
No_Element => False,
Key => Path_Name_Type,
Hash => Hash,
Equal => "=");
Q_First : Natural := 1;
-- Points to the first valid element in the queue
Q_Processed : Natural := 0;
One_Queue_Per_Obj_Dir : Boolean := False;
Q_Initialized : Boolean := False;
-------------
-- Element --
-------------
function Element (Rank : Positive) return File_Name_Type is
begin
if Rank <= Q.Last then
return Q.Table (Rank).File;
else
return No_File;
end if;
end Element;
-------------
-- Extract --
-------------
-- This body needs commenting ???
procedure Extract
(Source_File_Name : out File_Name_Type;
Source_Unit : out Unit_Name_Type;
Source_Index : out Int)
is
Found : Boolean := False;
begin
if One_Queue_Per_Obj_Dir then
for J in Q_First .. Q.Last loop
if not Q.Table (J).Processed
and then (Q.Table (J).Project = No_Project
or else not
Busy_Obj_Dirs.Get
(Q.Table (J).Project.Object_Directory.Name))
then
Found := True;
Source_File_Name := Q.Table (J).File;
Source_Unit := Q.Table (J).Unit;
Source_Index := Q.Table (J).Index;
Q.Table (J).Processed := True;
if J = Q_First then
while Q_First <= Q.Last
and then Q.Table (Q_First).Processed
loop
Q_First := Q_First + 1;
end loop;
end if;
exit;
end if;
end loop;
elsif Q_First <= Q.Last then
Source_File_Name := Q.Table (Q_First).File;
Source_Unit := Q.Table (Q_First).Unit;
Source_Index := Q.Table (Q_First).Index;
Q.Table (Q_First).Processed := True;
Q_First := Q_First + 1;
Found := True;
end if;
if Found then
Q_Processed := Q_Processed + 1;
else
Source_File_Name := No_File;
Source_Unit := No_Unit_Name;
Source_Index := 0;
end if;
if Found and then Debug.Debug_Flag_Q then
Write_Str (" Q := Q - [ ");
Write_Name (Source_File_Name);
if Source_Index /= 0 then
Write_Str (", ");
Write_Int (Source_Index);
end if;
Write_Str (" ]");
Write_Eol;
Write_Str (" Q_First =");
Write_Int (Int (Q_First));
Write_Eol;
Write_Str (" Q.Last =");
Write_Int (Int (Q.Last));
Write_Eol;
end if;
end Extract;
----------------
-- Initialize --
----------------
procedure Initialize (Queue_Per_Obj_Dir : Boolean) is
begin
if not Q_Initialized then
One_Queue_Per_Obj_Dir := Queue_Per_Obj_Dir;
Q.Init;
Q_Initialized := True;
Q_Processed := 0;
Q_First := 1;
end if;
end Initialize;
------------
-- Insert --
------------
-- This body needs commenting ???
procedure Insert
(Source_File_Name : File_Name_Type;
Project : Project_Id;
Source_Unit : Unit_Name_Type := No_Unit_Name;
Index : Int := 0)
is
begin
Q.Append
((File => Source_File_Name,
Project => Project,
Unit => Source_Unit,
Index => Index,
Processed => False));
if Debug.Debug_Flag_Q then
Write_Str (" Q := Q + [ ");
Write_Name (Source_File_Name);
if Index /= 0 then
Write_Str (", ");
Write_Int (Index);
end if;
Write_Str (" ] ");
Write_Eol;
Write_Str (" Q_First =");
Write_Int (Int (Q_First));
Write_Eol;
Write_Str (" Q.Last =");
Write_Int (Int (Q.Last));
Write_Eol;
end if;
end Insert;
--------------
-- Is_Empty --
--------------
function Is_Empty return Boolean is
begin
if Debug.Debug_Flag_P then
Write_Str (" Q := [");
for J in Q_First .. Q.Last loop
if not Q.Table (J).Processed then
Write_Str (" ");
Write_Name (Q.Table (J).File);
Write_Eol;
Write_Str (" ");
end if;
end loop;
Write_Str ("]");
Write_Eol;
end if;
return Q_First > Q.Last;
end Is_Empty;
------------------------
-- Is_Virtually_Empty --
------------------------
function Is_Virtually_Empty return Boolean is
begin
if One_Queue_Per_Obj_Dir then
for J in Q_First .. Q.Last loop
if not Q.Table (J).Processed
and then
(Q.Table (J).Project = No_Project
or else not
Busy_Obj_Dirs.Get
(Q.Table (J).Project.Object_Directory.Name))
then
return False;
end if;
end loop;
return True;
else
return Is_Empty;
end if;
end Is_Virtually_Empty;
---------------
-- Processed --
---------------
function Processed return Natural is
begin
return Q_Processed;
end Processed;
----------------------
-- Set_Obj_Dir_Busy --
----------------------
procedure Set_Obj_Dir_Busy (Obj_Dir : Path_Name_Type) is
begin
if One_Queue_Per_Obj_Dir then
Busy_Obj_Dirs.Set (Obj_Dir, True);
end if;
end Set_Obj_Dir_Busy;
----------------------
-- Set_Obj_Dir_Free --
----------------------
procedure Set_Obj_Dir_Free (Obj_Dir : Path_Name_Type) is
begin
if One_Queue_Per_Obj_Dir then
Busy_Obj_Dirs.Set (Obj_Dir, False);
end if;
end Set_Obj_Dir_Free;
----------
-- Size --
----------
function Size return Natural is
begin
return Q.Last;
end Size;
end Queue;
-----------------------------
-- Recursive_Compute_Depth --
-----------------------------
......
gcc/ada/makeutl.ads
......@@ -52,6 +52,11 @@ package Makeutl is
-- Command line switch to allow shared library projects to import projects
-- that are not shared library projects.
Single_Compile_Per_Obj_Dir_Switch : constant String :=
"--single-compile-per-obj-dir";
-- Switch to forbid simultaneous compilations for the same object directory
-- when project files are used.
procedure Add
(Option : String_Access;
To : in out String_List_Access;
......
gcc/ada/opt.ads
......@@ -910,6 +910,12 @@ package Opt is
-- GNATMAKE
-- Set to True when an object directory is specified with option -D
One_Compilation_Per_Obj_Dir : Boolean := False;
-- GNATMAKE, GPRBUILD
-- Set to True with switch --single-compile-per-obj-dir. When True, there
-- cannot be simultaneous compilations with the object files in the same
-- object directory, if project files are used.
type Operating_Mode_Type is (Check_Syntax, Check_Semantics, Generate_Code);
Operating_Mode : Operating_Mode_Type := Generate_Code;
-- GNAT
......
gcc/ada/sem_util.adb
......@@ -10538,7 +10538,9 @@ package body Sem_Util is
and then Present (Entity (N2))
and then (Ekind (Entity (N1)) = E_Variable
or else
Ekind (Entity (N1)) = E_Constant)
Ekind (Entity (N1)) = E_Constant
or else
Ekind (Entity (N1)) in Formal_Kind)
and then Entity (N1) = Entity (N2)
then
return True;
......
gcc/ada/switch-m.adb
......@@ -655,6 +655,9 @@ package body Switch.M is
elsif Switch_Chars = Makeutl.Unchecked_Shared_Lib_Imports then
Opt.Unchecked_Shared_Lib_Imports := True;
elsif Switch_Chars = Makeutl.Single_Compile_Per_Obj_Dir_Switch then
Opt.One_Compilation_Per_Obj_Dir := True;
elsif Switch_Chars (Ptr) = '-' then
Bad_Switch (Switch_Chars);
......
gcc/ada/vms_data.ads
......@@ -4858,6 +4858,9 @@ package VMS_Data is
--
-- Search the specified directories for both source and object files.
S_Make_Single : aliased constant S := "/SINGLE_COMPILE_PER_OBJ_DIR " &
"--single-compile-per-obj-dir";
S_Make_Skip : aliased constant S := "/SKIP_MISSING=*" &
"-aL*";
-- /SKIP_MISSING=(directory[,...])
......@@ -4977,6 +4980,7 @@ package VMS_Data is
S_Make_Reason 'Access,
S_Make_RTS 'Access,
S_Make_Search 'Access,
S_Make_Single 'Access,
S_Make_Skip 'Access,
S_Make_Source 'Access,
S_Make_Stand 'Access,
......
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