s-taasde.adb (Timer_Queue): Don't use a build-in-place function call to initialize the Timer_Queue.

2014-07-30  Bob Duff  <duff@adacore.com>

	* s-taasde.adb (Timer_Queue): Don't use a
	build-in-place function call to initialize the Timer_Queue.
	* s-traent.adb, s-traent.ads, s-traent-vms.adb, s-traent-vms.ads:
	Turn off polling in these units, because otherwise we get
	elaboration circularities with Ada.Exceptions when the -gnatP
	switch is used.
	* s-tassta.adb (Create_Task): Make sure independent tasks
	are created with Parent = Environment_Task. This was not true,
	for example, in s-interr.adb, when Interrupt_Manager does "new
	Server_Task"; the Server_Task had Parent = Interrupt_Manager,
	which is wrong because the master is determined by the access
	type, which is at library level.
	* s-tasuti.adb (Make_Independent): Avoid setting Parent; it is
	now set correctly by Create_Task.
	(Make_Passive): Remove the workaround for the race condition in
	Make_Independent.
	* frontend.adb (Frontend): Revert to previous method of detecting
	temporary configuration pragma files, recognizing such files by
	".tmp" in the name. This is more general than detecting pragmas
	Source_File_Name_Project, because it allows any tool to use
	this naming convention, no matter the content of the file.
	* gnat_ugn.texi: Document this naming convention.

From-SVN: r213269
This commit is contained in:
Bob Duff 2014-07-30 13:50:25 +00:00 committed by Arnaud Charlet
parent 3aac555130
commit fccaf220f3
10 changed files with 104 additions and 121 deletions

View File

@ -1,3 +1,28 @@
2014-07-30 Bob Duff <duff@adacore.com>
* s-taasde.adb (Timer_Queue): Don't use a
build-in-place function call to initialize the Timer_Queue.
* s-traent.adb, s-traent.ads, s-traent-vms.adb, s-traent-vms.ads:
Turn off polling in these units, because otherwise we get
elaboration circularities with Ada.Exceptions when the -gnatP
switch is used.
* s-tassta.adb (Create_Task): Make sure independent tasks
are created with Parent = Environment_Task. This was not true,
for example, in s-interr.adb, when Interrupt_Manager does "new
Server_Task"; the Server_Task had Parent = Interrupt_Manager,
which is wrong because the master is determined by the access
type, which is at library level.
* s-tasuti.adb (Make_Independent): Avoid setting Parent; it is
now set correctly by Create_Task.
(Make_Passive): Remove the workaround for the race condition in
Make_Independent.
* frontend.adb (Frontend): Revert to previous method of detecting
temporary configuration pragma files, recognizing such files by
".tmp" in the name. This is more general than detecting pragmas
Source_File_Name_Project, because it allows any tool to use
this naming convention, no matter the content of the file.
* gnat_ugn.texi: Document this naming convention.
2014-07-30 Robert Dewar <dewar@adacore.com>
* exp_ch7.adb, s-tataat.adb, s-tataat.ads, s-parame-vms-alpha.ads,

View File

@ -71,42 +71,6 @@ procedure Frontend is
Config_Pragmas : List_Id;
-- Gather configuration pragmas
function Need_To_Be_In_The_Dependencies
(Pragma_List : List_Id) return Boolean;
-- Check if a configuration pragmas file that contains the Pragma_List
-- should be a dependency for the source being compiled. Returns
-- False if Pragma_List is Error_List or contains only pragmas
-- Source_File_Name_Project, returns True otherwise.
------------------------------------
-- Need_To_Be_In_The_Dependencies --
------------------------------------
function Need_To_Be_In_The_Dependencies
(Pragma_List : List_Id) return Boolean
is
Prag : Node_Id;
Pname : Name_Id;
begin
if Pragma_List /= Error_List then
Prag := First (Pragma_List);
while Present (Prag) loop
Pname := Pragma_Name (Prag);
if Pname /= Name_Source_File_Name_Project then
return True;
end if;
Next (Prag);
end loop;
end if;
return False;
end Need_To_Be_In_The_Dependencies;
-- Start of processing for Frontend
begin
-- Carry out package initializations. These are initializations which might
-- logically be performed at elaboration time, were it not for the fact
@ -180,6 +144,8 @@ begin
Prag : Node_Id;
Temp_File : Boolean;
begin
-- We always analyze config files with style checks off, since
-- we don't want a miscellaneous gnat.adc that is around to
@ -253,6 +219,13 @@ begin
Name_Len := Config_File_Names (Index)'Length;
Name_Buffer (1 .. Name_Len) := Config_File_Names (Index).all;
Temp_File :=
Name_Len > 4
and then
(Name_Buffer (Name_Len - 3 .. Name_Len) = ".TMP"
or else
Name_Buffer (Name_Len - 3 .. Name_Len) = ".tmp");
-- Load the file, error if we did not find it
Source_Config_File := Load_Config_File (Name_Enter);
@ -262,30 +235,20 @@ begin
("cannot find configuration pragmas file "
& Config_File_Names (Index).all);
-- If we did find the file, and it contains pragmas other than
-- Source_File_Name_Project, then we unconditionally add a
-- compilation dependency for it so that if it changes, we force
-- a recompilation. This is a fairly recent (2014-03-28) change.
-- If we did find the file, and it is not a temporary file, then
-- we unconditionally add a compilation dependency for it so
-- that if it changes, we force a recompilation. This is a
-- fairly recent (2014-03-28) change.
else
-- Parse the config pragmas file, and accumulate results
Initialize_Scanner (No_Unit, Source_Config_File);
declare
Pragma_List : constant List_Id :=
Par (Configuration_Pragmas => True);
begin
if Need_To_Be_In_The_Dependencies (Pragma_List) then
Prepcomp.Add_Dependency (Source_Config_File);
end if;
Append_List_To (Config_Pragmas, Pragma_List);
end;
elsif not Temp_File then
Prepcomp.Add_Dependency (Source_Config_File);
end if;
-- Parse the config pragmas file, and accumulate results
Initialize_Scanner (No_Unit, Source_Config_File);
Append_List_To
(Config_Pragmas, Par (Configuration_Pragmas => True));
end loop;
end if;

View File

@ -12339,8 +12339,13 @@ It is allowable to specify several switches @option{-gnatec=}, all of which
will be taken into account.
Files containing configuration pragmas specified with switches
@option{-gnatec=} are added to the dependencies, unless they contain
only pragmas Source_File_Name_Project.
@option{-gnatec=} are added to the dependencies, unless they are
temporary files. A file is considered temporary if its name ends in
@file{.tmp} or @file{.TMP}. Certain tools follow this naming
convention because they pass information to @command{gcc} via
temporary files that are immediately deleted; it doesn't make sense to
depend on a file that no longer exists. Such tools include
@command{gprbuild}, @command{gnatmake}, and @command{gnatcheck}.
If you are using project file, a separate mechanism is provided using
project attributes, see @ref{Specifying Configuration Pragmas} for more

View File

@ -75,19 +75,22 @@ package body System.Tasking.Async_Delays is
-- time, so that the ordered insertion will always stop searching when it
-- gets back to the queue header block.
function Empty_Queue return Delay_Block;
-- Initial value for Timer_Queue
Timer_Queue : aliased Delay_Block;
function Empty_Queue return Delay_Block is
package Init_Timer_Queue is end Init_Timer_Queue;
pragma Unreferenced (Init_Timer_Queue);
-- Initialize the Timer_Queue. This is a package to work around the
-- fact that statements are syntactically illegal here. We want this
-- initialization to happen before the Timer_Server is activated. A
-- build-in-place function would also work, but that's not supported
-- on all platforms (e.g. cil).
package body Init_Timer_Queue is
begin
return Result : aliased Delay_Block do
Result.Succ := Result'Unchecked_Access;
Result.Pred := Result'Unchecked_Access;
Result.Resume_Time := Duration'Last;
end return;
end Empty_Queue;
Timer_Queue : aliased Delay_Block := Empty_Queue;
Timer_Queue.Succ := Timer_Queue'Unchecked_Access;
Timer_Queue.Pred := Timer_Queue'Unchecked_Access;
Timer_Queue.Resume_Time := Duration'Last;
end Init_Timer_Queue;
------------------------
-- Cancel_Async_Delay --

View File

@ -557,14 +557,20 @@ package body System.Tasking.Stages is
else System.Multiprocessors.CPU_Range (CPU));
end if;
-- Find parent P of new Task, via master level number
-- Find parent P of new Task, via master level number. Independent tasks
-- should have Parent = Environment_Task, and all tasks created
-- by independent tasks are also independent. See, for example,
-- s-interr.adb, where Interrupt_Manager does "new Server_Task". The
-- access type is at library level, so the parent of the Server_Task
-- is Environment_Task.
P := Self_ID;
if P /= null then
while P.Master_of_Task >= Master loop
if P.Master_of_Task <= Independent_Task_Level then
P := Environment_Task;
else
while P /= null and then P.Master_of_Task >= Master loop
P := P.Common.Parent;
exit when P = null;
end loop;
end if;

View File

@ -246,8 +246,6 @@ package body System.Tasking.Utilities is
Self_Id : constant Task_Id := STPO.Self;
Environment_Task : constant Task_Id := STPO.Environment_Task;
Parent : constant Task_Id := Self_Id.Common.Parent;
Parent_Needs_Updating : Boolean := False;
Master_of_Task : Integer;
begin
if Self_Id.Known_Tasks_Index /= -1 then
@ -263,23 +261,12 @@ package body System.Tasking.Utilities is
Write_Lock (Environment_Task);
Write_Lock (Self_Id);
pragma Assert (Parent = Environment_Task
or else Self_Id.Master_of_Task = Library_Task_Level);
Master_of_Task := Self_Id.Master_of_Task;
Self_Id.Master_of_Task := Independent_Task_Level;
-- The run time assumes that the parent of an independent task is the
-- environment task.
if Parent /= Environment_Task then
pragma Assert (Parent = Environment_Task);
-- We cannot lock three tasks at the same time, so defer the
-- operations on the parent.
Parent_Needs_Updating := True;
Self_Id.Common.Parent := Environment_Task;
end if;
Self_Id.Master_of_Task := Independent_Task_Level;
-- Update Independent_Task_Count that is needed for the GLADE
-- termination rule. See also pending update in
@ -287,32 +274,12 @@ package body System.Tasking.Utilities is
Independent_Task_Count := Independent_Task_Count + 1;
-- This should be called before the task reaches its "begin" (see spec),
-- which ensures that the environment task cannot race ahead and be
-- already waiting for children to complete.
Unlock (Self_Id);
-- Changing the parent after creation is not trivial. Do not forget
-- to update the old parent counts, and the new parent (i.e. the
-- Environment_Task) counts.
if Parent_Needs_Updating then
Write_Lock (Parent);
Parent.Awake_Count := Parent.Awake_Count - 1;
Parent.Alive_Count := Parent.Alive_Count - 1;
Environment_Task.Awake_Count := Environment_Task.Awake_Count + 1;
Environment_Task.Alive_Count := Environment_Task.Alive_Count + 1;
Unlock (Parent);
end if;
-- In case the environment task is already waiting for children to
-- complete.
-- ??? There may be a race condition if the environment task was not in
-- master completion sleep when this task was created, but now is
if Environment_Task.Common.State = Master_Completion_Sleep and then
Master_of_Task = Environment_Task.Master_Within
then
Environment_Task.Common.Wait_Count :=
Environment_Task.Common.Wait_Count - 1;
end if;
pragma Assert (Environment_Task.Common.State /= Master_Completion_Sleep);
Unlock (Environment_Task);
@ -511,12 +478,10 @@ package body System.Tasking.Utilities is
-- If parent is in Master_Completion_Sleep, it cannot be on a
-- terminate alternative, hence it cannot have Wait_Count of
-- zero. ???Except that the race condition in Make_Independent can
-- cause Wait_Count to be zero, so we need to check for that.
-- zero.
if P.Common.Wait_Count > 0 then
P.Common.Wait_Count := P.Common.Wait_Count - 1;
end if;
pragma Assert (P.Common.Wait_Count > 0);
P.Common.Wait_Count := P.Common.Wait_Count - 1;
if P.Common.Wait_Count = 0 then
Wakeup (P, Master_Completion_Sleep);

View File

@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 2003-2009, Free Software Foundation, Inc. --
-- Copyright (C) 2003-2014, 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- --
@ -29,6 +29,10 @@
-- --
------------------------------------------------------------------------------
pragma Polling (Off);
-- We must turn polling off for this unit, because otherwise we get
-- elaboration circularities with Ada.Exceptions.
package body System.Traceback_Entries is
------------

View File

@ -35,6 +35,10 @@
-- This is the Alpha/OpenVMS version of this package
pragma Polling (Off);
-- We must turn polling off for this unit, because otherwise we get
-- elaboration circularities with Ada.Exceptions.
package System.Traceback_Entries is
pragma Preelaborate;

View File

@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 2003-2013, Free Software Foundation, Inc. --
-- Copyright (C) 2003-2014, 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- --
@ -29,6 +29,10 @@
-- --
------------------------------------------------------------------------------
pragma Polling (Off);
-- We must turn polling off for this unit, because otherwise we get
-- elaboration circularities with Ada.Exceptions.
pragma Compiler_Unit_Warning;
package body System.Traceback_Entries is

View File

@ -38,6 +38,10 @@
-- version of the package, an entry is a mere code location representing the
-- address of a call instruction part of the call-chain.
pragma Polling (Off);
-- We must turn polling off for this unit, because otherwise we get
-- elaboration circularities with Ada.Exceptions.
pragma Compiler_Unit_Warning;
package System.Traceback_Entries is