+2014-07-30 Bob Duff <duff@adacore.com>
+
+ * s-tasuti.ads, s-tasuti.adb (Make_Independent): Change this
+ from a procedure to a function, so that it can more easily be
+ called before the "begin" of a task.
+ * s-taasde.ads (Delay_Block): Make this type immutably limited,
+ so we can use a build-in-place function call to initialize
+ Timer_Queue in the body.
+ * a-rttiev.adb, s-asthan-vms-alpha.adb, s-asthan-vms-ia64.adb,
+ * s-interr.adb, s-interr-hwint.adb, s-interr-sigaction.adb,
+ * s-interr-vms.adb, s-taasde.adb: Each independent task now calls
+ Make_Independent before reaching its "begin", to avoid race
+ conditions. This causes the activating task to wait until after
+ Make_Independent is complete before proceeding. In addition,
+ we initialize data structures used by independent tasks before
+ activating those tasks, to avoid possible use of uninitialized data.
+ * s-interr.ads, s-intman.ads, s-taspri-posix.ads, s-tasdeb.ads:
+ Minor comment fixes.
+
+2014-07-30 Bob Duff <duff@adacore.com>
+
+ * a-exctra.ads, s-traent-vms.ads, s-traent.ads (Tracebacks_Array): Move
+ the declaration of Tracebacks_Array from Ada.Exceptions.Traceback to
+ System.Traceback_Entries (s-traent.ads and s-traent-vms.ads). Add
+ subtypes renaming Tracebacks_Array in Ada.Exceptions.Traceback.
+ * g-debpoo.adb: Refer to Tracebacks_Array in its new home.
+
+2014-07-30 Arnaud Charlet <charlet@adacore.com>
+
+ * a-tasatt.adb: Remove old comments.
+
2014-07-30 Yannick Moy <moy@adacore.com>
* einfo.ads (Is_Inlined): Document new use in GNATprove mode.
-- --
-- S p e c --
-- --
--- Copyright (C) 1999-2012, Free Software Foundation, Inc. --
+-- Copyright (C) 1999-2014, Free Software Foundation, Inc. --
-- --
-- This specification is derived from the Ada Reference Manual for use with --
-- GNAT. The copyright notice above, and the license provisions that follow --
subtype Code_Loc is System.Address;
-- Code location in executing program
- type Tracebacks_Array is array (Positive range <>) of STBE.Traceback_Entry;
+ subtype Tracebacks_Array is STBE.Tracebacks_Array;
-- A traceback array is an array of traceback entries
function Tracebacks (E : Exception_Occurrence) return Tracebacks_Array;
-- --
-- B o d y --
-- --
--- Copyright (C) 2005-2011, Free Software Foundation, Inc. --
+-- 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- --
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
task Timer is
pragma Priority (System.Priority'Last);
- entry Start;
end Timer;
task body Timer is
-- 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;
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;
-- B o d y --
-- --
-- Copyright (C) 1991-1994, Florida State University --
--- Copyright (C) 1995-2010, AdaCore --
+-- 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- --
-- --
------------------------------------------------------------------------------
--- The following notes are provided in case someone decides the implementation
--- of this package is too complicated, or too slow. Please read this before
--- making any "simplifications".
-
--- Correct implementation of this package is more difficult than one might
--- expect. After considering (and coding) several alternatives, we settled on
--- the present compromise. Things we do not like about this implementation
--- include:
-
--- - It is vulnerable to bad Task_Id values, to the extent of possibly
--- trashing memory and crashing the runtime system.
-
--- - It requires dynamic storage allocation for each new attribute value,
--- except for types that happen to be the same size as System.Address, or
--- shorter.
-
--- - Instantiations at other than the library level rely on being able to
--- do down-level calls to a procedure declared in the generic package body.
--- This makes it potentially vulnerable to compiler changes.
-
--- The main implementation issue here is that the connection from task to
--- attribute is a potential source of dangling references.
-
--- When a task goes away, we want to be able to recover all the storage
--- associated with its attributes. The Ada mechanism for this is finalization,
--- via controlled attribute types. For this reason, the ARM requires
--- finalization of attribute values when the associated task terminates.
-
--- This finalization must be triggered by the tasking runtime system, during
--- termination of the task. Given the active set of instantiations of
--- Ada.Task_Attributes is dynamic, the number and types of attributes
--- belonging to a task will not be known until the task actually terminates.
--- Some of these types may be controlled and some may not. The RTS must find
--- some way to determine which of these attributes need finalization, and
--- invoke the appropriate finalization on them.
-
--- One way this might be done is to create a special finalization chain for
--- each task, similar to the finalization chain that is used for controlled
--- objects within the task. This would differ from the usual finalization
--- chain in that it would not have a LIFO structure, since attributes may be
--- added to a task at any time during its lifetime. This might be the right
--- way to go for the longer term, but at present this approach is not open,
--- since GNAT does not provide such special finalization support.
-
--- Lacking special compiler support, the RTS is limited to the normal ways an
--- application invokes finalization, i.e.
-
--- a) Explicit call to the procedure Finalize, if we know the type has this
--- operation defined on it. This is not sufficient, since we have no way
--- of determining whether a given generic formal Attribute type is
--- controlled, and no visibility of the associated Finalize procedure, in
--- the generic body.
-
--- b) Leaving the scope of a local object of a controlled type. This does not
--- help, since the lifetime of an instantiation of Ada.Task_Attributes
--- does not correspond to the lifetimes of the various tasks which may
--- have that attribute.
-
--- c) Assignment of another value to the object. This would not help, since
--- we then have to finalize the new value of the object.
-
--- d) Unchecked deallocation of an object of a controlled type. This seems to
--- be the only mechanism available to the runtime system for finalization
--- of task attributes.
-
--- We considered two ways of using unchecked deallocation, both based on a
--- linked list of that would hang from the task control block.
-
--- In the first approach the objects on the attribute list are all derived
--- from one controlled type, say T, and are linked using an access type to
--- T'Class. The runtime system has an Ada.Unchecked_Deallocation for T'Class
--- with access type T'Class, and uses this to deallocate and finalize all the
--- items in the list. The limitation of this approach is that each
--- instantiation of the package Ada.Task_Attributes derives a new record
--- extension of T, and since T is controlled (RM 3.9.1 (3)), instantiation is
--- only allowed at the library level.
-
--- In the second approach the objects on the attribute list are of unrelated
--- but structurally similar types. Unchecked conversion is used to circument
--- Ada type checking. Each attribute-storage node contains not only the
--- attribute value and a link for chaining, but also a pointer to descriptor
--- for the corresponding instantiation of Task_Attributes. The instantiation
--- descriptor contains pointer to a procedure that can do the correct
--- deallocation and finalization for that type of attribute. On task
--- termination, the runtime system uses the pointer to call the appropriate
--- deallocator.
-
--- While this gets around the limitation that instantations be at the library
--- level, it relies on an implementation feature that may not always be safe,
--- i.e. that it is safe to call the Deallocate procedure for an instantiation
--- of Ada.Task_Attributes that no longer exists. In general, it seems this
--- might result in dangling references.
-
--- Another problem with instantiations deeper than the library level is that
--- there is risk of storage leakage, or dangling references to reused storage.
--- That is, if an instantiation of Ada.Task_Attributes is made within a
--- procedure, what happens to the storage allocated for attributes, when the
--- procedure call returns? Apparently (RM 7.6.1 (4)) any such objects must be
--- finalized, since they will no longer be accessible, and in general one
--- would expect that the storage they occupy would be recovered for later
--- reuse. (If not, we would have a case of storage leakage.) Assuming the
--- storage is recovered and later reused, we have potentially dangerous
--- dangling references. When the procedure containing the instantiation of
--- Ada.Task_Attributes returns, there may still be unterminated tasks with
--- associated attribute values for that instantiation. When such tasks
--- eventually terminate, the RTS will attempt to call the Deallocate procedure
--- on them. If the corresponding storage has already been deallocated, when
--- the master of the access type was left, we have a potential disaster. This
--- disaster is compounded since the pointer to Deallocate is probably through
--- a "trampoline" which will also have been destroyed.
-
--- For this reason, we arrange to remove all dangling references before
--- leaving the scope of an instantiation. This is ugly, since it requires
--- traversing the list of all tasks, but it is no more ugly than a similar
--- traversal that we must do at the point of instantiation in order to
--- initialize the attributes of all tasks. At least we only need to do these
--- traversals if the type is controlled.
-
--- We chose to defer allocation of storage for attributes until the Reference
--- function is called or the attribute is first set to a value different from
--- the default initial one. This allows a potential savings in allocation,
--- for attributes that are not used by all tasks.
-
--- For efficiency, we reserve space in the TCB for a fixed number of direct-
--- access attributes. These are required to be of a size that fits in the
--- space of an object of type System.Address. Because we must use unchecked
--- bitwise copy operations on these values, they cannot be of a controlled
--- type, but that is covered automatically since controlled objects are too
--- large to fit in the spaces.
-
--- We originally deferred initialization of these direct-access attributes,
--- just as we do for the indirect-access attributes, and used a per-task bit
--- vector to keep track of which attributes were currently defined for that
--- task. We found that the overhead of maintaining this bit-vector seriously
--- slowed down access to the attributes, and made the fetch operation non-
--- atomic, so that even to read an attribute value required locking the TCB.
--- Therefore, we now initialize such attributes for all existing tasks at the
--- time of the attribute instantiation, and initialize existing attributes for
--- each new task at the time it is created.
-
--- The latter initialization requires a list of all the instantiation
--- descriptors. Updates to this list, as well as the bit-vector that is used
--- to reserve slots for attributes in the TCB, require mutual exclusion. That
--- is provided by the Lock/Unlock_RTS.
-
--- One special problem that added complexity to the design is that the per-
--- task list of indirect attributes contains objects of different types. We
--- use unchecked pointer conversion to link these nodes together and access
--- them, but the records may not have identical internal structure. Initially,
--- we thought it would be enough to allocate all the common components of
--- the records at the front of each record, so that their positions would
--- correspond. Unfortunately, GNAT adds "dope" information at the front
--- of a record, if the record contains any controlled-type components.
---
--- This means that the offset of the fields we use to link the nodes is at
--- different positions on nodes of different types. To get around this, each
--- attribute storage record consists of a core node and wrapper. The core
--- nodes are all of the same type, and it is these that are linked together
--- and generally "seen" by the RTS. Each core node contains a pointer to its
--- own wrapper, which is a record that contains the core node along with an
--- attribute value, approximately as follows:
-
--- type Node;
--- type Node_Access is access all Node;
--- type Wrapper;
--- type Access_Wrapper is access all Wrapper;
--- type Node is record
--- Next : Node_Access;
--- ...
--- Wrapper : Access_Wrapper;
--- end record;
--- type Wrapper is record
--- Dummy_Node : aliased Node;
--- Value : aliased Attribute; -- the generic formal type
--- end record;
-
--- Another interesting problem is with the initialization of the instantiation
--- descriptors. Originally, we did this all via the Initialize procedure of
--- the descriptor type and code in the package body. It turned out that the
--- Initialize procedure needed quite a bit of information, including the size
--- of the attribute type, the initial value of the attribute (if it fits in
--- the TCB), and a pointer to the deallocator procedure. These needed to be
--- "passed" in via access discriminants. GNAT was having trouble with access
--- discriminants, so all this work was moved to the package body.
-
--- Note that references to objects declared in this package body must in
--- general use 'Unchecked_Access instead of 'Access as the package can be
--- instantiated from within a local context.
-
with System.Storage_Elements;
with System.Task_Primitives.Operations;
with System.Tasking;
-- --
------------------------------------------------------------------------------
-with Ada.Exceptions.Traceback;
with GNAT.IO; use GNAT.IO;
with System.Address_Image;
with System.Memory; use System.Memory;
with System.Soft_Links; use System.Soft_Links;
-with System.Traceback_Entries; use System.Traceback_Entries;
+with System.Traceback_Entries;
with GNAT.HTable;
with GNAT.Traceback; use GNAT.Traceback;
type Header is range 1 .. 1023;
-- Number of elements in the hash-table
- type Tracebacks_Array_Access
- is access GNAT.Traceback.Tracebacks_Array;
+ type Tracebacks_Array_Access is access Tracebacks_Array;
type Traceback_Kind is (Alloc, Dealloc, Indirect_Alloc, Indirect_Dealloc);
-- addresses internal to this package). Depth is the number of levels that
-- the user is interested in.
+ package STBE renames System.Traceback_Entries;
+
+ function PC_For (TB_Entry : STBE.Traceback_Entry) return System.Address
+ renames STBE.PC_For;
+
-----------
-- Align --
-----------
-----------
function Equal (K1, K2 : Tracebacks_Array_Access) return Boolean is
- use Ada.Exceptions.Traceback;
+ use type Tracebacks_Array;
begin
return K1.all = K2.all;
end Equal;
-- --
-- B o d y --
-- --
--- Copyright (C) 1996-2013, Free Software Foundation, Inc. --
+-- 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- --
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;
-- --
-- B o d y --
-- --
--- Copyright (C) 1996-2013, Free Software Foundation, Inc. --
+-- 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- --
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;
-----------------------
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 --
-- 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
-- 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;
Status : int;
begin
- System.Tasking.Utilities.Make_Independent;
Semaphore_ID_Map (Interrupt) := Int_Sema;
loop
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;
-----------------------
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 --
-- 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.
-----------------
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;
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));
-- 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;
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;
-----------------------
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 --
-- 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.
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;
-----------------
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;
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));
-- --
-- S p e c --
-- --
--- Copyright (C) 1992-2013, Free Software Foundation, Inc. --
+-- 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- --
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
-- --
-- S p e c --
-- --
--- Copyright (C) 1992-2009, Free Software Foundation, Inc. --
+-- 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- --
-- 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
-- --
-- B o d y --
-- --
--- Copyright (C) 1998-2009, Free Software Foundation, Inc. --
+-- 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- --
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);
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 --
------------------
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.
-
- --------------------------
- -- Get_Next_Wakeup_Time --
- --------------------------
-
- function Get_Next_Wakeup_Time return Duration is
- begin
- STU.Make_Independent;
- return Duration'Last;
- end Get_Next_Wakeup_Time;
+ Ignore : constant Boolean := STU.Make_Independent;
+ pragma Unreferenced (Ignore);
-- Local Declarations
- Next_Wakeup_Time : Duration := Get_Next_Wakeup_Time;
+ Next_Wakeup_Time : Duration := Duration'Last;
Timedout : Boolean;
Yielded : Boolean;
Now : Duration;
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
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;
-- --
-- S p e c --
-- --
--- Copyright (C) 1998-2013, Free Software Foundation, Inc. --
+-- 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- --
private
- type Delay_Block is record
+ type Delay_Block is limited record
Self_Id : Task_Id;
-- ID of the calling task
-- --
-- S p e c --
-- --
--- Copyright (C) 1997-2011, Free Software Foundation, Inc. --
+-- 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- --
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.
-------------------------------
-- --
-- S p e c --
-- --
--- Copyright (C) 1991-1994, Florida State University --
--- Copyright (C) 1995-2011, AdaCore --
+-- 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- --
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
-- --
-- B o d y --
-- --
--- Copyright (C) 1992-2011, Free Software Foundation, Inc. --
+-- 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- --
-- 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;
end if;
Initialization.Undefer_Abort (Self_Id);
+
+ return True; -- return value doesn't matter
end Make_Independent;
------------------
-- --
-- S p e c --
-- --
--- Copyright (C) 1992-2009, Free Software Foundation, Inc. --
+-- 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- --
-- 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
-- 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),
-- --
-- S p e c --
-- --
--- Copyright (C) 2003-2009, Free Software Foundation, Inc. --
+-- Copyright (C) 2003-2014, Free Software Foundation, Inc. --
-- --
-- This specification is derived from the Ada Reference Manual for use with --
-- GNAT. The copyright notice above, and the license provisions that follow --
(PC => System.Null_Address,
PV => System.Null_Address);
+ type Tracebacks_Array is array (Positive range <>) of Traceback_Entry;
+
function PC_For (TB_Entry : Traceback_Entry) return System.Address;
function PV_For (TB_Entry : Traceback_Entry) return System.Address;
-- --
-- S p e c --
-- --
--- Copyright (C) 2003-2013, Free Software Foundation, Inc. --
+-- Copyright (C) 2003-2014, Free Software Foundation, Inc. --
-- --
-- This specification is derived from the Ada Reference Manual for use with --
-- GNAT. The copyright notice above, and the license provisions that follow --
Null_TB_Entry : constant Traceback_Entry := System.Null_Address;
-- This is the value to be used when initializing an entry
+ type Tracebacks_Array is array (Positive range <>) of Traceback_Entry;
+
function PC_For (TB_Entry : Traceback_Entry) return System.Address;
pragma Inline (PC_For);
-- Returns the address of the call instruction associated with the
projects / gcc.git / commitdiff