From b0c5fdda662f6e7291088eaa6158b938f224f3e0 Mon Sep 17 00:00:00 2001 From: Arnaud Charlet Date: Wed, 30 Jul 2014 14:46:03 +0200 Subject: [PATCH] [multiple changes] 2014-07-30 Bob Duff * 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 * 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 * a-tasatt.adb: Remove old comments. From-SVN: r213256 --- gcc/ada/ChangeLog | 31 ++++++ gcc/ada/a-exctra.ads | 4 +- gcc/ada/a-rttiev.adb | 34 +++--- gcc/ada/a-tasatt.adb | 191 +-------------------------------- gcc/ada/g-debpoo.adb | 13 ++- gcc/ada/s-asthan-vms-alpha.adb | 7 +- gcc/ada/s-asthan-vms-ia64.adb | 7 +- gcc/ada/s-interr-hwint.adb | 14 +-- gcc/ada/s-interr-sigaction.adb | 5 +- gcc/ada/s-interr-vms.adb | 21 ++-- gcc/ada/s-interr.adb | 29 ++--- gcc/ada/s-interr.ads | 6 +- gcc/ada/s-intman.ads | 8 +- gcc/ada/s-taasde.adb | 48 ++++----- gcc/ada/s-taasde.ads | 4 +- gcc/ada/s-tasdeb.ads | 12 +-- gcc/ada/s-taspri-posix.ads | 8 +- gcc/ada/s-tasuti.adb | 6 +- gcc/ada/s-tasuti.ads | 32 +++++- gcc/ada/s-traent-vms.ads | 4 +- gcc/ada/s-traent.ads | 4 +- 21 files changed, 180 insertions(+), 308 deletions(-) diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index f34919648c2..4eb3b018dd0 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,34 @@ +2014-07-30 Bob Duff + + * 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 + + * 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 + + * a-tasatt.adb: Remove old comments. + 2014-07-30 Yannick Moy * einfo.ads (Is_Inlined): Document new use in GNATprove mode. diff --git a/gcc/ada/a-exctra.ads b/gcc/ada/a-exctra.ads index 6d22c1c746b..af1d59b9658 100644 --- a/gcc/ada/a-exctra.ads +++ b/gcc/ada/a-exctra.ads @@ -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; diff --git a/gcc/ada/a-rttiev.adb b/gcc/ada/a-rttiev.adb index 67b81c72ba8..ecb0aa7c9d5 100644 --- a/gcc/ada/a-rttiev.adb +++ b/gcc/ada/a-rttiev.adb @@ -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; diff --git a/gcc/ada/a-tasatt.adb b/gcc/ada/a-tasatt.adb index 44cb8a93609..ae2a715d601 100644 --- a/gcc/ada/a-tasatt.adb +++ b/gcc/ada/a-tasatt.adb @@ -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; diff --git a/gcc/ada/g-debpoo.adb b/gcc/ada/g-debpoo.adb index 07bff14fa26..db17fa408ca 100644 --- a/gcc/ada/g-debpoo.adb +++ b/gcc/ada/g-debpoo.adb @@ -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; diff --git a/gcc/ada/s-asthan-vms-alpha.adb b/gcc/ada/s-asthan-vms-alpha.adb index 253870f619b..8ecdd8c11e1 100644 --- a/gcc/ada/s-asthan-vms-alpha.adb +++ b/gcc/ada/s-asthan-vms-alpha.adb @@ -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; diff --git a/gcc/ada/s-asthan-vms-ia64.adb b/gcc/ada/s-asthan-vms-ia64.adb index 0f16fe8e331..5e201235f36 100644 --- a/gcc/ada/s-asthan-vms-ia64.adb +++ b/gcc/ada/s-asthan-vms-ia64.adb @@ -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; diff --git a/gcc/ada/s-interr-hwint.adb b/gcc/ada/s-interr-hwint.adb index 654efdc3b21..9da97cff1be 100644 --- a/gcc/ada/s-interr-hwint.adb +++ b/gcc/ada/s-interr-hwint.adb @@ -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 diff --git a/gcc/ada/s-interr-sigaction.adb b/gcc/ada/s-interr-sigaction.adb index 1daca4d1a3c..f9612d51af5 100644 --- a/gcc/ada/s-interr-sigaction.adb +++ b/gcc/ada/s-interr-sigaction.adb @@ -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; diff --git a/gcc/ada/s-interr-vms.adb b/gcc/ada/s-interr-vms.adb index 7ef3b1cbbde..ae3a5c1487c 100644 --- a/gcc/ada/s-interr-vms.adb +++ b/gcc/ada/s-interr-vms.adb @@ -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)); diff --git a/gcc/ada/s-interr.adb b/gcc/ada/s-interr.adb index cbf8f03117f..a9b12087e9e 100644 --- a/gcc/ada/s-interr.adb +++ b/gcc/ada/s-interr.adb @@ -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)); diff --git a/gcc/ada/s-interr.ads b/gcc/ada/s-interr.ads index 7c3ed56f9dc..c1ac164f124 100644 --- a/gcc/ada/s-interr.ads +++ b/gcc/ada/s-interr.ads @@ -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 diff --git a/gcc/ada/s-intman.ads b/gcc/ada/s-intman.ads index 5f3f4d50089..71a1cefcc6e 100644 --- a/gcc/ada/s-intman.ads +++ b/gcc/ada/s-intman.ads @@ -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 diff --git a/gcc/ada/s-taasde.adb b/gcc/ada/s-taasde.adb index 315d9ba1355..40e3dc6e91c 100644 --- a/gcc/ada/s-taasde.adb +++ b/gcc/ada/s-taasde.adb @@ -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; diff --git a/gcc/ada/s-taasde.ads b/gcc/ada/s-taasde.ads index dc4165a122c..46dc17877f3 100644 --- a/gcc/ada/s-taasde.ads +++ b/gcc/ada/s-taasde.ads @@ -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 diff --git a/gcc/ada/s-tasdeb.ads b/gcc/ada/s-tasdeb.ads index 0d0df436ad6..2c43dc1d127 100644 --- a/gcc/ada/s-tasdeb.ads +++ b/gcc/ada/s-tasdeb.ads @@ -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. ------------------------------- diff --git a/gcc/ada/s-taspri-posix.ads b/gcc/ada/s-taspri-posix.ads index 9f40693aa74..65f06909ac1 100644 --- a/gcc/ada/s-taspri-posix.ads +++ b/gcc/ada/s-taspri-posix.ads @@ -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 diff --git a/gcc/ada/s-tasuti.adb b/gcc/ada/s-tasuti.adb index a6b362ee2aa..8449ee51bcc 100644 --- a/gcc/ada/s-tasuti.adb +++ b/gcc/ada/s-tasuti.adb @@ -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; ------------------ diff --git a/gcc/ada/s-tasuti.ads b/gcc/ada/s-tasuti.ads index 7f9e8bff20c..b2003711ba1 100644 --- a/gcc/ada/s-tasuti.ads +++ b/gcc/ada/s-tasuti.ads @@ -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), diff --git a/gcc/ada/s-traent-vms.ads b/gcc/ada/s-traent-vms.ads index 45db3c4d09f..07ab1c0198a 100644 --- a/gcc/ada/s-traent-vms.ads +++ b/gcc/ada/s-traent-vms.ads @@ -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; diff --git a/gcc/ada/s-traent.ads b/gcc/ada/s-traent.ads index 1dbb9ec15d6..74f53fd361d 100644 --- a/gcc/ada/s-traent.ads +++ b/gcc/ada/s-traent.ads @@ -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 -- 2.30.2