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
Arnaud Charlet
parent
3aac555130
commit
fccaf220f3
@ -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,
|
||||
|
||||
@ -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
|
||||
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);
|
||||
|
||||
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;
|
||||
|
||||
Append_List_To
|
||||
(Config_Pragmas, Par (Configuration_Pragmas => True));
|
||||
end loop;
|
||||
end if;
|
||||
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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 --
|
||||
|
||||
@ -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;
|
||||
|
||||
|
||||
@ -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
|
||||
pragma Assert (P.Common.Wait_Count > 0);
|
||||
P.Common.Wait_Count := P.Common.Wait_Count - 1;
|
||||
end if;
|
||||
|
||||
if P.Common.Wait_Count = 0 then
|
||||
Wakeup (P, Master_Completion_Sleep);
|
||||
|
||||
@ -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
|
||||
|
||||
------------
|
||||
|
||||
@ -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;
|
||||
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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
|
||||
|
||||
Loading…
Reference in New Issue
Block a user