+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,
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
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
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);
("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.
-
- 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;
+ -- 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.
- 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;
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
-- 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 --
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;
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
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
-
- -- We cannot lock three tasks at the same time, so defer the
- -- operations on the parent.
+ pragma Assert (Parent = Environment_Task);
- 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
Independent_Task_Count := Independent_Task_Count + 1;
- Unlock (Self_Id);
+ -- 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.
- -- 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 (Self_Id);
+ pragma Assert (Environment_Task.Common.State /= Master_Completion_Sleep);
Unlock (Environment_Task);
-- 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);
-- --
-- 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- --
-- --
------------------------------------------------------------------------------
+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
------------
-- 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;
-- --
-- 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- --
-- --
------------------------------------------------------------------------------
+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
-- 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
projects / gcc.git / commitdiff