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

[multiple changes] 

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.

From-SVN: r213256
This commit is contained in:
Arnaud Charlet 2014-07-30 14:46:03 +02:00
parent 52c1498c86
commit b0c5fdda66
21 changed files with 180 additions and 308 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

31
gcc/ada/ChangeLog
View File

@ -1,3 +1,34 @@
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.

4
gcc/ada/a-exctra.ads
View File

@ -6,7 +6,7 @@
-- --
-- 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 --
@ -44,7 +44,7 @@ package Ada.Exceptions.Traceback is
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;

34
gcc/ada/a-rttiev.adb
View File

@ -6,7 +6,7 @@
-- --
-- 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- --
@ -64,6 +64,15 @@ package body Ada.Real_Time.Timing_Events is
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 @@ package body Ada.Real_Time.Timing_Events is
task Timer is
pragma Priority (System.Priority'Last);
entry Start;
end Timer;
task body Timer is
@ -96,29 +104,16 @@ package body Ada.Real_Time.Timing_Events 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;
@ -369,7 +364,4 @@ package body Ada.Real_Time.Timing_Events is
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;

191
gcc/ada/a-tasatt.adb
View File

@ -7,7 +7,7 @@
-- 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- --
@ -30,195 +30,6 @@
-- --
------------------------------------------------------------------------------
-- 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;

13
gcc/ada/g-debpoo.adb
View File

@ -29,14 +29,13 @@
-- --
------------------------------------------------------------------------------
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;
@ -107,8 +106,7 @@ package body GNAT.Debug_Pools is
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);
@ -323,6 +321,11 @@ package body GNAT.Debug_Pools is
-- 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 --
-----------
@ -373,7 +376,7 @@ package body GNAT.Debug_Pools is
-----------
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;

7
gcc/ada/s-asthan-vms-alpha.adb
View File

@ -6,7 +6,7 @@
-- --
-- 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- --
@ -348,13 +348,14 @@ package body System.AST_Handling is
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;

7
gcc/ada/s-asthan-vms-ia64.adb
View File

@ -6,7 +6,7 @@
-- --
-- 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- --
@ -353,13 +353,14 @@ package body System.AST_Handling is
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;

14
gcc/ada/s-interr-hwint.adb
View File

@ -719,6 +719,11 @@ package body System.Interrupts is
-----------------------
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 @@ package body System.Interrupts is
-- 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 @@ package body System.Interrupts is
-- 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 @@ package body System.Interrupts is
Status : int;
begin
System.Tasking.Utilities.Make_Independent;
Semaphore_ID_Map (Interrupt) := Int_Sema;
loop

5
gcc/ada/s-interr-sigaction.adb
View File

@ -616,13 +616,14 @@ package body System.Interrupts is
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;

21
gcc/ada/s-interr-vms.adb
View File

@ -566,6 +566,11 @@ package body System.Interrupts is
-----------------------
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 @@ package body System.Interrupts is
-- 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 @@ package body System.Interrupts is
-----------------
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 @@ package body System.Interrupts is
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));

29
gcc/ada/s-interr.adb
View File

@ -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;
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,6 +681,11 @@ package body System.Interrupts is
-----------------------
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 @@ package body System.Interrupts is
-- 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 @@ package body System.Interrupts is
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 @@ package body System.Interrupts is
-----------------
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 @@ package body System.Interrupts is
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
gcc/ada/s-interr.ads
View File

@ -6,7 +6,7 @@
-- --
-- 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- --
@ -156,9 +156,9 @@ package System.Interrupts is
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

8
gcc/ada/s-intman.ads
View File

@ -6,7 +6,7 @@
-- --
-- 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- --
@ -75,9 +75,9 @@ package System.Interrupt_Management is
-- 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

48
gcc/ada/s-taasde.adb
View File

@ -6,7 +6,7 @@
-- --
-- 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- --
@ -60,8 +60,6 @@ package body System.Tasking.Async_Delays is
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,13 +67,27 @@ package body System.Tasking.Async_Delays is
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 @@ package body System.Tasking.Async_Delays is
------------------
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;
@ -296,7 +297,7 @@ package body System.Tasking.Async_Delays is
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 @@ package body System.Tasking.Async_Delays is
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;

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

@ -6,7 +6,7 @@
-- --
-- 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- --
@ -113,7 +113,7 @@ package System.Tasking.Async_Delays is
private
type Delay_Block is record
type Delay_Block is limited record
Self_Id : Task_Id;
-- ID of the calling task

12
gcc/ada/s-tasdeb.ads
View File

@ -6,7 +6,7 @@
-- --
-- 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- --
@ -105,25 +105,25 @@ package System.Tasking.Debug is
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.
-------------------------------

8
gcc/ada/s-taspri-posix.ads
View File

@ -6,8 +6,8 @@
-- --
-- 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- --
@ -48,8 +48,8 @@ package System.Task_Primitives is
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
gcc/ada/s-tasuti.adb
View File

@ -6,7 +6,7 @@
-- --
-- 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- --
@ -242,7 +242,7 @@ package body System.Tasking.Utilities is
-- 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 @@ package body System.Tasking.Utilities is
end if;
Initialization.Undefer_Abort (Self_Id);
return True; -- return value doesn't matter
end Make_Independent;
------------------

32
gcc/ada/s-tasuti.ads
View File

@ -6,7 +6,7 @@
-- --
-- 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- --
@ -44,7 +44,7 @@ package System.Tasking.Utilities is
-- 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 @@ package System.Tasking.Utilities is
-- 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),

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

@ -6,7 +6,7 @@
-- --
-- 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 --
@ -52,6 +52,8 @@ package System.Traceback_Entries is
(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;

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

@ -6,7 +6,7 @@
-- --
-- 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 --
@ -49,6 +49,8 @@ package System.Traceback_Entries is
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