===================================================================
@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
+-- Copyright (C) 1992-2014, Free Software Foundation, Inc. --
-- --
-- GNARL 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- --
@@ -242,7 +242,7 @@
-- Make_Independent --
----------------------
- procedure Make_Independent is
+ function Make_Independent return Boolean is
Self_Id : constant Task_Id := STPO.Self;
Environment_Task : constant Task_Id := STPO.Environment_Task;
Parent : constant Task_Id := Self_Id.Common.Parent;
@@ -321,6 +321,8 @@
end if;
Initialization.Undefer_Abort (Self_Id);
+
+ return True; -- return value doesn't matter
end Make_Independent;
------------------
===================================================================
@@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
+-- Copyright (C) 1992-2014, Free Software Foundation, Inc. --
-- --
-- GNARL 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- --
@@ -44,7 +44,7 @@
-- Task_Stage Related routines --
---------------------------------
- procedure Make_Independent;
+ function Make_Independent return Boolean;
-- Move the current task to the outermost level (level 2) of the master
-- hierarchy of the environment task. That is one level further out
-- than normal tasks defined in library-level packages (level 3). The
@@ -63,9 +63,35 @@
-- will change the task's parent. This assumption is particularly
-- important for master level completion and for the computation of
-- Independent_Task_Count.
+ --
+ -- NOTE WELL: Make_Independent should be called before the task reaches its
+ -- "begin", like this:
+ --
+ -- task body Some_Independent_Task is
+ -- ...
+ -- Ignore : constant Boolean := Make_Independent;
+ -- pragma Unreferenced (Ignore);
+ -- ...
+ -- begin
+ --
+ -- The return value is meaningless; the only reason this is a function is
+ -- to get around the Ada limitation that makes a procedure call
+ -- syntactically illegal before the "begin".
+ --
+ -- Calling it before "begin" ensures that the call completes before the
+ -- activating task can proceed. This is important for preventing race
+ -- conditions. For example, if the environment task reaches
+ -- Finalize_Global_Tasks before some task has finished Make_Independent,
+ -- the program can hang.
+ --
+ -- Note also that if a package declares independent tasks, it should not
+ -- initialize its package-body data after "begin" of the package, because
+ -- that's where the tasks are activated. Initializing such data before the
+ -- task activation helps prevent the tasks from accessing uninitialized
+ -- data.
Independent_Task_Count : Natural := 0;
- -- Number of independent task. This counter is incremented each time
+ -- Number of independent tasks. This counter is incremented each time
-- Make_Independent is called. Note that if a server task terminates,
-- this counter will not be decremented. Since Make_Independent locks
-- the environment task (because every independent task depends on it),
===================================================================
@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
+-- Copyright (C) 1996-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- --
@@ -348,13 +348,14 @@
pragma Volatile (Param);
- begin
-- By making this task independent of master, when the environment
-- task is finalizing, the AST_Server_Task will be notified that it
-- should terminate.
- STU.Make_Independent;
+ Ignore : constant Boolean := STU.Make_Independent;
+ pragma Unreferenced (Ignore);
+ begin
-- Record our task Id for access by Process_AST
AST_Task_Ids (Num) := Self_Id;
===================================================================
@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
+-- Copyright (C) 1998-2014, Free Software Foundation, Inc. --
-- --
-- GNARL 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- --
@@ -60,8 +60,6 @@
function To_System is new Ada.Unchecked_Conversion
(Ada.Task_Identification.Task_Id, Task_Id);
- Timer_Server_ID : ST.Task_Id;
-
Timer_Attention : Boolean := False;
pragma Atomic (Timer_Attention);
@@ -69,14 +67,28 @@
pragma Interrupt_Priority (System.Any_Priority'Last);
end Timer_Server;
+ Timer_Server_ID : constant ST.Task_Id := To_System (Timer_Server'Identity);
+
-- The timer queue is a circular doubly linked list, ordered by absolute
-- wakeup time. The first item in the queue is Timer_Queue.Succ.
-- It is given a Resume_Time that is larger than any legitimate wakeup
-- time, so that the ordered insertion will always stop searching when it
-- gets back to the queue header block.
- Timer_Queue : aliased Delay_Block;
+ function Empty_Queue return Delay_Block;
+ -- Initial value for Timer_Queue
+ function Empty_Queue return Delay_Block 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;
+
------------------------
-- Cancel_Async_Delay --
------------------------
@@ -270,23 +282,12 @@
------------------
task body Timer_Server is
- function Get_Next_Wakeup_Time return Duration;
- -- Used to initialize Next_Wakeup_Time, but also to ensure that
- -- Make_Independent is called during the elaboration of this task.
+ Ignore : constant Boolean := STU.Make_Independent;
+ pragma Unreferenced (Ignore);
- --------------------------
- -- Get_Next_Wakeup_Time --
- --------------------------
-
- function Get_Next_Wakeup_Time return Duration is
- begin
- STU.Make_Independent;
- return Duration'Last;
- end Get_Next_Wakeup_Time;
-
-- Local Declarations
- Next_Wakeup_Time : Duration := Get_Next_Wakeup_Time;
+ Next_Wakeup_Time : Duration := Duration'Last;
Timedout : Boolean;
Yielded : Boolean;
Now : Duration;
@@ -296,7 +297,7 @@
pragma Unreferenced (Timedout, Yielded);
begin
- Timer_Server_ID := STPO.Self;
+ pragma Assert (Timer_Server_ID = STPO.Self);
-- Since this package may be elaborated before System.Interrupt,
-- we need to call Setup_Interrupt_Mask explicitly to ensure that
@@ -400,13 +401,4 @@
end loop;
end Timer_Server;
- ------------------------------
- -- Package Body Elaboration --
- ------------------------------
-
-begin
- Timer_Queue.Succ := Timer_Queue'Access;
- Timer_Queue.Pred := Timer_Queue'Access;
- Timer_Queue.Resume_Time := Duration'Last;
- Timer_Server_ID := To_System (Timer_Server'Identity);
end System.Tasking.Async_Delays;
===================================================================
@@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
+-- Copyright (C) 1998-2014, Free Software Foundation, Inc. --
-- --
-- GNARL 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- --
@@ -113,7 +113,7 @@
private
- type Delay_Block is record
+ type Delay_Block is limited record
Self_Id : Task_Id;
-- ID of the calling task
===================================================================
@@ -52,6 +52,7 @@
-- There is no more than one interrupt per Server_Task and no more than one
-- Server_Task per interrupt.
+with Ada.Exceptions;
with Ada.Task_Identification;
with System.Task_Primitives;
@@ -60,6 +61,8 @@
with System.Interrupt_Management.Operations;
pragma Elaborate_All (System.Interrupt_Management.Operations);
+with System.IO;
+
with System.Task_Primitives.Operations;
with System.Task_Primitives.Interrupt_Operations;
with System.Storage_Elements;
@@ -678,7 +681,12 @@
-----------------------
task body Interrupt_Manager is
+ -- By making this task independent of master, when the process
+ -- goes away, the Interrupt_Manager will terminate gracefully.
+ Ignore : constant Boolean := System.Tasking.Utilities.Make_Independent;
+ pragma Unreferenced (Ignore);
+
---------------------
-- Local Variables --
---------------------
@@ -940,11 +948,6 @@
-- Start of processing for Interrupt_Manager
begin
- -- By making this task independent of master, when the process
- -- goes away, the Interrupt_Manager will terminate gracefully.
-
- System.Tasking.Utilities.Make_Independent;
-
-- Environment task gets its own interrupt mask, saves it, and then
-- masks all interrupts except the Keep_Unmasked set.
@@ -1221,9 +1224,10 @@
when Program_Error =>
null;
- when others =>
+ when X : others =>
+ System.IO.Put_Line ("Exception in Interrupt_Manager");
+ System.IO.Put_Line (Ada.Exceptions.Exception_Information (X));
pragma Assert (False);
- null;
end;
end loop;
end Interrupt_Manager;
@@ -1233,6 +1237,12 @@
-----------------
task body Server_Task is
+ -- By making this task independent of master, when the process goes
+ -- away, the Server_Task will terminate gracefully.
+
+ Ignore : constant Boolean := System.Tasking.Utilities.Make_Independent;
+ pragma Unreferenced (Ignore);
+
Intwait_Mask : aliased IMNG.Interrupt_Mask;
Ret_Interrupt : Interrupt_ID;
Self_ID : constant Task_Id := Self;
@@ -1241,11 +1251,6 @@
Tmp_Entry_Index : Task_Entry_Index;
begin
- -- By making this task independent of master, when the process goes
- -- away, the Server_Task will terminate gracefully.
-
- System.Tasking.Utilities.Make_Independent;
-
-- Install default action in system level
IMOP.Install_Default_Action (IMNG.Interrupt_ID (Interrupt));
===================================================================
@@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
+-- Copyright (C) 1992-2014, Free Software Foundation, Inc. --
-- --
-- GNARL 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- --
@@ -156,9 +156,9 @@
function Is_Ignored (Interrupt : Interrupt_ID) return Boolean;
-- Comment needed ???
- -- Note : Direct calls to sigaction, sigprocmask, thr_sigsetmask or any
+ -- Note : Direct calls to sigaction, sigprocmask, thr_sigsetmask, or any
-- other low-level interface that changes the signal action or signal mask
- -- needs a careful thought.
+ -- needs careful thought.
-- One may achieve the effect of system calls first making RTS blocked (by
-- calling Block_Interrupt) for the signal under consideration. This will
===================================================================
@@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
+-- Copyright (C) 1992-2014, Free Software Foundation, Inc. --
-- --
-- GNARL 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- --
@@ -75,9 +75,9 @@
-- used for that purpose. This is one of the reserved interrupts.
Keep_Unmasked : Interrupt_Set := (others => False);
- -- Keep_Unmasked (I) is true iff the interrupt I is one that must that
- -- must be kept unmasked at all times, except (perhaps) for short critical
- -- sections. This includes interrupts that are mapped to exceptions (see
+ -- Keep_Unmasked (I) is true iff the interrupt I is one that must be kept
+ -- unmasked at all times, except (perhaps) for short critical sections.
+ -- This includes interrupts that are mapped to exceptions (see
-- System.Interrupt_Exceptions.Is_Exception), but may also include
-- interrupts (e.g. timer) that need to be kept unmasked for other
-- reasons. Where interrupts are implemented as OS signals, and signal
===================================================================
@@ -719,7 +719,12 @@
-----------------------
task body Interrupt_Manager is
+ -- By making this task independent of any master, when the process goes
+ -- away, the Interrupt_Manager will terminate gracefully.
+ Ignore : constant Boolean := System.Tasking.Utilities.Make_Independent;
+ pragma Unreferenced (Ignore);
+
--------------------
-- Local Routines --
--------------------
@@ -907,11 +912,6 @@
-- Start of processing for Interrupt_Manager
begin
- -- By making this task independent of any master, when the process goes
- -- away, the Interrupt_Manager will terminate gracefully.
-
- System.Tasking.Utilities.Make_Independent;
-
loop
-- A block is needed to absorb Program_Error exception
@@ -1039,6 +1039,9 @@
-- Server task for vectored hardware interrupt handling
task body Interrupt_Server_Task is
+ Ignore : constant Boolean := System.Tasking.Utilities.Make_Independent;
+ pragma Unreferenced (Ignore);
+
Self_Id : constant Task_Id := Self;
Tmp_Handler : Parameterless_Handler;
Tmp_ID : Task_Id;
@@ -1046,7 +1049,6 @@
Status : int;
begin
- System.Tasking.Utilities.Make_Independent;
Semaphore_ID_Map (Interrupt) := Int_Sema;
loop
===================================================================
@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
+-- Copyright (C) 2005-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- --
@@ -64,6 +64,15 @@
Event_Queue_Lock : aliased System.Task_Primitives.RTS_Lock;
-- Used for mutually exclusive access to All_Events
+ -- We need to Initialize_Lock before Timer is activated. The purpose of the
+ -- Dummy package is to get around Ada's syntax rules.
+
+ package Dummy is end Dummy;
+ package body Dummy is
+ begin
+ Initialize_Lock (Event_Queue_Lock'Access, Level => PO_Level);
+ end Dummy;
+
procedure Process_Queued_Events;
-- Examine the queue of pending events for any that have timed out. For
-- those that have timed out, remove them from the queue and invoke their
@@ -86,7 +95,6 @@
task Timer is
pragma Priority (System.Priority'Last);
- entry Start;
end Timer;
task body Timer is
@@ -96,29 +104,16 @@
-- requirements. Obviously a shorter period would give better resolution
-- at the cost of more overhead.
- begin
- System.Tasking.Utilities.Make_Independent;
+ Ignore : constant Boolean := System.Tasking.Utilities.Make_Independent;
+ pragma Unreferenced (Ignore);
+ begin
-- Since this package may be elaborated before System.Interrupt,
-- we need to call Setup_Interrupt_Mask explicitly to ensure that
-- this task has the proper signal mask.
System.Interrupt_Management.Operations.Setup_Interrupt_Mask;
- -- We await the call to Start to ensure that Event_Queue_Lock has been
- -- initialized by the package executable part prior to accessing it in
- -- the loop. The task is activated before the first statement of the
- -- executable part so it would otherwise be possible for the task to
- -- call EnterCriticalSection in Process_Queued_Events before the
- -- initialization.
-
- -- We don't simply put the initialization here, prior to the loop,
- -- because other application tasks could call the visible routines that
- -- also call Enter/LeaveCriticalSection prior to this task doing the
- -- initialization.
-
- accept Start;
-
loop
Process_Queued_Events;
delay until Clock + Period;
@@ -369,7 +364,4 @@
Remove_From_Queue (This'Unchecked_Access);
end Finalize;
-begin
- Initialize_Lock (Event_Queue_Lock'Access, Level => PO_Level);
- Timer.Start;
end Ada.Real_Time.Timing_Events;
===================================================================
@@ -566,7 +566,12 @@
-----------------------
task body Interrupt_Manager is
+ -- By making this task independent of master, when the process goes
+ -- away, the Interrupt_Manager will terminate gracefully.
+ Ignore : constant Boolean := System.Tasking.Utilities.Make_Independent;
+ pragma Unreferenced (Ignore);
+
--------------------
-- Local Routines --
--------------------
@@ -705,11 +710,6 @@
-- Start of processing for Interrupt_Manager
begin
- -- By making this task independent of master, when the process goes
- -- away, the Interrupt_Manager will terminate gracefully.
-
- System.Tasking.Utilities.Make_Independent;
-
-- Environment task gets its own interrupt mask, saves it, and then
-- masks all interrupts except the Keep_Unmasked set.
@@ -893,6 +893,12 @@
-----------------
task body Server_Task is
+ -- By making this task independent of master, when the process
+ -- goes away, the Server_Task will terminate gracefully.
+
+ Ignore : constant Boolean := System.Tasking.Utilities.Make_Independent;
+ pragma Unreferenced (Ignore);
+
Self_ID : constant Task_Id := Self;
Tmp_Handler : Parameterless_Handler;
Tmp_ID : Task_Id;
@@ -900,11 +906,6 @@
Intwait_Mask : aliased IMNG.Interrupt_Mask;
begin
- -- By making this task independent of master, when the process
- -- goes away, the Server_Task will terminate gracefully.
-
- System.Tasking.Utilities.Make_Independent;
-
-- Install default action in system level
IMOP.Install_Default_Action (IMNG.Interrupt_ID (Interrupt));
===================================================================
@@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
+-- Copyright (C) 1997-2014, Free Software Foundation, Inc. --
-- --
-- GNARL 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- --
@@ -105,25 +105,25 @@
procedure Suspend_All_Tasks (Thread_Self : OS_Interface.Thread_Id);
-- Suspend all the tasks except the one whose associated thread is
- -- Thread_Self by traversing All_Tasks_Lists and calling
+ -- Thread_Self by traversing All_Tasks_List and calling
-- System.Task_Primitives.Operations.Suspend_Task.
procedure Resume_All_Tasks (Thread_Self : OS_Interface.Thread_Id);
-- Resume all the tasks except the one whose associated thread is
- -- Thread_Self by traversing All_Tasks_Lists and calling
+ -- Thread_Self by traversing All_Tasks_List and calling
-- System.Task_Primitives.Operations.Continue_Task.
procedure Stop_All_Tasks_Handler;
- -- Stop all the tasks by traversing All_Tasks_Lists and calling
+ -- Stop all the tasks by traversing All_Tasks_List and calling
-- System.Task_Primitives.Operations.Stop_All_Task. This function
-- can be used in an interrupt handler.
procedure Stop_All_Tasks;
- -- Stop all the tasks by traversing All_Tasks_Lists and calling
+ -- Stop all the tasks by traversing All_Tasks_List and calling
-- System.Task_Primitives.Operations.Stop_Task.
procedure Continue_All_Tasks;
- -- Continue all the tasks by traversing All_Tasks_Lists and calling
+ -- Continue all the tasks by traversing All_Tasks_List and calling
-- System.Task_Primitives.Operations.Continue_Task.
-------------------------------
===================================================================
@@ -6,8 +6,8 @@
-- --
-- S p e c --
-- --
+-- Copyright (C) 1991-1914, Florida State University --
+-- Copyright (C) 1995-2014, AdaCore --
-- --
-- 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- --
@@ -48,8 +48,8 @@
type RTS_Lock is limited private;
-- Should be used inside the runtime system. The difference between Lock
- -- and the RTS_Lock is that the later one serves only as a semaphore so
- -- that do not check for ceiling violations.
+ -- and the RTS_Lock is that the latter serves only as a semaphore so that
+ -- we do not check for ceiling violations.
type Suspension_Object is limited private;
-- Should be used for the implementation of Ada.Synchronous_Task_Control
===================================================================
@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
+-- Copyright (C) 1996-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- --
@@ -353,13 +353,14 @@
pragma Volatile (Param);
- begin
-- By making this task independent of master, when the environment
-- task is finalizing, the AST_Server_Task will be notified that it
-- should terminate.
- STU.Make_Independent;
+ Ignore : constant Boolean := STU.Make_Independent;
+ pragma Unreferenced (Ignore);
+ begin
-- Record our task Id for access by Process_AST
AST_Task_Ids (Num) := Self_Id;
===================================================================
@@ -616,13 +616,14 @@
end Is_Blocked;
task body Server_Task is
+ Ignore : constant Boolean := Utilities.Make_Independent;
+ pragma Unreferenced (Ignore);
+
Desc : Handler_Desc renames Descriptors (Interrupt);
Self_Id : constant Task_Id := STPO.Self;
Temp : Parameterless_Handler;
begin
- Utilities.Make_Independent;
-
loop
while Interrupt_Count (Interrupt) > 0 loop
Interrupt_Count (Interrupt) := Interrupt_Count (Interrupt) - 1;