OpenE2K/gcc
2
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

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

Browse Source 
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
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

25
gcc/ada/ChangeLog
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> 2014-07-30 Robert Dewar <dewar@adacore.com>
* exp_ch7.adb, s-tataat.adb, s-tataat.ads, s-parame-vms-alpha.ads, * exp_ch7.adb, s-tataat.adb, s-tataat.ads, s-parame-vms-alpha.ads,

77
gcc/ada/frontend.adb
View File

@ -71,42 +71,6 @@ procedure Frontend is
Config_Pragmas : List_Id; Config_Pragmas : List_Id;
-- Gather configuration pragmas -- 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 begin
-- Carry out package initializations. These are initializations which might -- Carry out package initializations. These are initializations which might
-- logically be performed at elaboration time, were it not for the fact -- logically be performed at elaboration time, were it not for the fact
@ -180,6 +144,8 @@ begin
Prag : Node_Id; Prag : Node_Id;
Temp_File : Boolean;
begin begin
-- We always analyze config files with style checks off, since -- We always analyze config files with style checks off, since
-- we don't want a miscellaneous gnat.adc that is around to -- 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_Len := Config_File_Names (Index)'Length;
Name_Buffer (1 .. Name_Len) := Config_File_Names (Index).all; 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 -- Load the file, error if we did not find it
Source_Config_File := Load_Config_File (Name_Enter); Source_Config_File := Load_Config_File (Name_Enter);
@ -262,30 +235,20 @@ begin
("cannot find configuration pragmas file " ("cannot find configuration pragmas file "
& Config_File_Names (Index).all); & Config_File_Names (Index).all);
-- If we did find the file, and it contains pragmas other than -- If we did find the file, and it is not a temporary file, then
-- Source_File_Name_Project, then we unconditionally add a -- we unconditionally add a compilation dependency for it so
-- compilation dependency for it so that if it changes, we force -- that if it changes, we force a recompilation. This is a
-- a recompilation. This is a fairly recent (2014-03-28) change. -- fairly recent (2014-03-28) change.
else elsif not Temp_File then
Prepcomp.Add_Dependency (Source_Config_File);
-- 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;
end if; 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 loop;
end if; end if;

9
gcc/ada/gnat_ugn.texi
View File

@ -12339,8 +12339,13 @@ It is allowable to specify several switches @option{-gnatec=}, all of which
will be taken into account. will be taken into account.
Files containing configuration pragmas specified with switches Files containing configuration pragmas specified with switches
@option{-gnatec=} are added to the dependencies, unless they contain @option{-gnatec=} are added to the dependencies, unless they are
only pragmas Source_File_Name_Project. 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 If you are using project file, a separate mechanism is provided using
project attributes, see @ref{Specifying Configuration Pragmas} for more project attributes, see @ref{Specifying Configuration Pragmas} for more

25
gcc/ada/s-taasde.adb
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 -- time, so that the ordered insertion will always stop searching when it
-- gets back to the queue header block. -- gets back to the queue header block.
function Empty_Queue return Delay_Block; Timer_Queue : aliased Delay_Block;
-- Initial value for Timer_Queue
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 begin
return Result : aliased Delay_Block do Timer_Queue.Succ := Timer_Queue'Unchecked_Access;
Result.Succ := Result'Unchecked_Access; Timer_Queue.Pred := Timer_Queue'Unchecked_Access;
Result.Pred := Result'Unchecked_Access; Timer_Queue.Resume_Time := Duration'Last;
Result.Resume_Time := Duration'Last; end Init_Timer_Queue;
end return;
end Empty_Queue;
Timer_Queue : aliased Delay_Block := Empty_Queue;
------------------------ ------------------------
-- Cancel_Async_Delay -- -- Cancel_Async_Delay --

14
gcc/ada/s-tassta.adb
View File

@ -557,14 +557,20 @@ package body System.Tasking.Stages is
else System.Multiprocessors.CPU_Range (CPU)); else System.Multiprocessors.CPU_Range (CPU));
end if; 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; P := Self_ID;
if P /= null then if P.Master_of_Task <= Independent_Task_Level then
while P.Master_of_Task >= Master loop P := Environment_Task;
else
while P /= null and then P.Master_of_Task >= Master loop
P := P.Common.Parent; P := P.Common.Parent;
exit when P = null;
end loop; end loop;
end if; end if;

55
gcc/ada/s-tasuti.adb
View File

@ -246,8 +246,6 @@ package body System.Tasking.Utilities is
Self_Id : constant Task_Id := STPO.Self; Self_Id : constant Task_Id := STPO.Self;
Environment_Task : constant Task_Id := STPO.Environment_Task; Environment_Task : constant Task_Id := STPO.Environment_Task;
Parent : constant Task_Id := Self_Id.Common.Parent; Parent : constant Task_Id := Self_Id.Common.Parent;
Parent_Needs_Updating : Boolean := False;
Master_of_Task : Integer;
begin begin
if Self_Id.Known_Tasks_Index /= -1 then if Self_Id.Known_Tasks_Index /= -1 then
@ -263,23 +261,12 @@ package body System.Tasking.Utilities is
Write_Lock (Environment_Task); Write_Lock (Environment_Task);
Write_Lock (Self_Id); 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 -- The run time assumes that the parent of an independent task is the
-- environment task. -- environment task.
if Parent /= Environment_Task then pragma Assert (Parent = Environment_Task);
-- We cannot lock three tasks at the same time, so defer the Self_Id.Master_of_Task := Independent_Task_Level;
-- operations on the parent.
Parent_Needs_Updating := True;
Self_Id.Common.Parent := Environment_Task;
end if;
-- Update Independent_Task_Count that is needed for the GLADE -- Update Independent_Task_Count that is needed for the GLADE
-- termination rule. See also pending update in -- termination rule. See also pending update in
@ -287,32 +274,12 @@ package body System.Tasking.Utilities is
Independent_Task_Count := Independent_Task_Count + 1; 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); Unlock (Self_Id);
pragma Assert (Environment_Task.Common.State /= Master_Completion_Sleep);
-- 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;
Unlock (Environment_Task); 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 -- If parent is in Master_Completion_Sleep, it cannot be on a
-- terminate alternative, hence it cannot have Wait_Count of -- terminate alternative, hence it cannot have Wait_Count of
-- zero. ???Except that the race condition in Make_Independent can -- zero.
-- cause Wait_Count to be zero, so we need to check for that.
if P.Common.Wait_Count > 0 then pragma Assert (P.Common.Wait_Count > 0);
P.Common.Wait_Count := P.Common.Wait_Count - 1; P.Common.Wait_Count := P.Common.Wait_Count - 1;
end if;
if P.Common.Wait_Count = 0 then if P.Common.Wait_Count = 0 then
Wakeup (P, Master_Completion_Sleep); Wakeup (P, Master_Completion_Sleep);

6
gcc/ada/s-traent-vms.adb
View File

@ -6,7 +6,7 @@
-- -- -- --
-- B o d y -- -- 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 -- -- 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- -- -- 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 package body System.Traceback_Entries is
------------ ------------

4
gcc/ada/s-traent-vms.ads
View File

@ -35,6 +35,10 @@
-- This is the Alpha/OpenVMS version of this package -- 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 package System.Traceback_Entries is
pragma Preelaborate; pragma Preelaborate;

6
gcc/ada/s-traent.adb
View File

@ -6,7 +6,7 @@
-- -- -- --
-- B o d y -- -- 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 -- -- 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- -- -- 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; pragma Compiler_Unit_Warning;
package body System.Traceback_Entries is package body System.Traceback_Entries is

4
gcc/ada/s-traent.ads
View File

@ -38,6 +38,10 @@
-- version of the package, an entry is a mere code location representing the -- version of the package, an entry is a mere code location representing the
-- address of a call instruction part of the call-chain. -- 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; pragma Compiler_Unit_Warning;
package System.Traceback_Entries is package System.Traceback_Entries is