From b9de1157289455b0ca26daff519d4a0ddcd1fa13 Mon Sep 17 00:00:00 2001 From: Dan Albert Date: Wed, 24 Feb 2016 13:48:45 -0800 Subject: Update 4.8.1 to 4.8.3. My previous drop was the wrong version. The platform mingw is currently using 4.8.3, not 4.8.1 (not sure how I got that wrong). From ftp://ftp.gnu.org/gnu/gcc/gcc-4.8.3/gcc-4.8.3.tar.bz2. Bug: http://b/26523949 Change-Id: Id85f1bdcbbaf78c7d0b5a69e74c798a08f341c35 --- gcc-4.8.3/gcc/ada/a-tasatt.adb | 762 +++++++++++++++++++++++++++++++++++++++++ 1 file changed, 762 insertions(+) create mode 100644 gcc-4.8.3/gcc/ada/a-tasatt.adb (limited to 'gcc-4.8.3/gcc/ada/a-tasatt.adb') diff --git a/gcc-4.8.3/gcc/ada/a-tasatt.adb b/gcc-4.8.3/gcc/ada/a-tasatt.adb new file mode 100644 index 000000000..44cb8a936 --- /dev/null +++ b/gcc-4.8.3/gcc/ada/a-tasatt.adb @@ -0,0 +1,762 @@ +------------------------------------------------------------------------------ +-- -- +-- GNAT RUN-TIME COMPONENTS -- +-- -- +-- A D A . T A S K _ A T T R I B U T E S -- +-- -- +-- B o d y -- +-- -- +-- Copyright (C) 1991-1994, Florida State University -- +-- Copyright (C) 1995-2010, 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- -- +-- ware Foundation; either version 3, or (at your option) any later ver- -- +-- sion. GNAT is distributed in the hope that it will be useful, but WITH- -- +-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY -- +-- or FITNESS FOR A PARTICULAR PURPOSE. -- +-- -- +-- As a special exception under Section 7 of GPL version 3, you are granted -- +-- additional permissions described in the GCC Runtime Library Exception, -- +-- version 3.1, as published by the Free Software Foundation. -- +-- -- +-- You should have received a copy of the GNU General Public License and -- +-- a copy of the GCC Runtime Library Exception along with this program; -- +-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see -- +-- . -- +-- -- +-- GNARL was developed by the GNARL team at Florida State University. -- +-- Extensive contributions were provided by Ada Core Technologies, Inc. -- +-- -- +------------------------------------------------------------------------------ + +-- 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 System.Tasking.Initialization; +with System.Tasking.Task_Attributes; + +with Ada.Exceptions; +with Ada.Unchecked_Conversion; +with Ada.Unchecked_Deallocation; + +pragma Elaborate_All (System.Tasking.Task_Attributes); +-- To ensure the initialization of object Local (below) will work + +package body Ada.Task_Attributes is + + use System.Tasking.Initialization, + System.Tasking, + System.Tasking.Task_Attributes, + Ada.Exceptions; + + package POP renames System.Task_Primitives.Operations; + + --------------------------- + -- Unchecked Conversions -- + --------------------------- + + -- The following type corresponds to Dummy_Wrapper, declared in + -- System.Tasking.Task_Attributes. + + type Wrapper; + type Access_Wrapper is access all Wrapper; + + pragma Warnings (Off); + -- We turn warnings off for the following To_Attribute_Handle conversions, + -- since these are used only for small attributes where we know that there + -- are no problems with alignment, but the compiler will generate warnings + -- for the occurrences in the large attribute case, even though they will + -- not actually be used. + + function To_Attribute_Handle is new Ada.Unchecked_Conversion + (System.Address, Attribute_Handle); + function To_Direct_Attribute_Element is new Ada.Unchecked_Conversion + (System.Address, Direct_Attribute_Element); + -- For reference to directly addressed task attributes + + type Access_Integer_Address is access all + System.Storage_Elements.Integer_Address; + + function To_Attribute_Handle is new Ada.Unchecked_Conversion + (Access_Integer_Address, Attribute_Handle); + -- For reference to directly addressed task attributes + + pragma Warnings (On); + -- End warnings off region for directly addressed attribute conversions + + function To_Access_Address is new Ada.Unchecked_Conversion + (Access_Node, Access_Address); + -- To store pointer to list of indirect attributes + + pragma Warnings (Off); + function To_Access_Wrapper is new Ada.Unchecked_Conversion + (Access_Dummy_Wrapper, Access_Wrapper); + pragma Warnings (On); + -- To fetch pointer to actual wrapper of attribute node. We turn off + -- warnings since this may generate an alignment warning. The warning can + -- be ignored since Dummy_Wrapper is only a non-generic standin for the + -- real wrapper type (we never actually allocate objects of type + -- Dummy_Wrapper). + + function To_Access_Dummy_Wrapper is new Ada.Unchecked_Conversion + (Access_Wrapper, Access_Dummy_Wrapper); + -- To store pointer to actual wrapper of attribute node + + function To_Task_Id is new Ada.Unchecked_Conversion + (Task_Identification.Task_Id, Task_Id); + -- To access TCB of identified task + + type Local_Deallocator is access procedure (P : in out Access_Node); + + function To_Lib_Level_Deallocator is new Ada.Unchecked_Conversion + (Local_Deallocator, Deallocator); + -- To defeat accessibility check + + ------------------------ + -- Storage Management -- + ------------------------ + + procedure Deallocate (P : in out Access_Node); + -- Passed to the RTS via unchecked conversion of a pointer to permit + -- finalization and deallocation of attribute storage nodes. + + -------------------------- + -- Instantiation Record -- + -------------------------- + + Local : aliased Instance; + -- Initialized in package body + + type Wrapper is record + Dummy_Node : aliased Node; + + Value : aliased Attribute := Initial_Value; + -- The generic formal type, may be controlled + end record; + + -- A number of unchecked conversions involving Wrapper_Access sources are + -- performed in this unit. We have to ensure that the designated object is + -- always strictly enough aligned. + + for Wrapper'Alignment use Standard'Maximum_Alignment; + + procedure Free is + new Ada.Unchecked_Deallocation (Wrapper, Access_Wrapper); + + procedure Deallocate (P : in out Access_Node) is + T : Access_Wrapper := To_Access_Wrapper (P.Wrapper); + begin + Free (T); + end Deallocate; + + --------------- + -- Reference -- + --------------- + + function Reference + (T : Task_Identification.Task_Id := Task_Identification.Current_Task) + return Attribute_Handle + is + TT : constant Task_Id := To_Task_Id (T); + Error_Message : constant String := "Trying to get the reference of a "; + + begin + if TT = null then + Raise_Exception (Program_Error'Identity, Error_Message & "null task"); + end if; + + if TT.Common.State = Terminated then + Raise_Exception (Tasking_Error'Identity, + Error_Message & "terminated task"); + end if; + + -- Directly addressed case + + if Local.Index /= 0 then + + -- Return the attribute handle. Warnings off because this return + -- statement generates alignment warnings for large attributes + -- (but will never be executed in this case anyway). + + pragma Warnings (Off); + return + To_Attribute_Handle (TT.Direct_Attributes (Local.Index)'Address); + pragma Warnings (On); + + -- Not directly addressed + + else + declare + P : Access_Node := To_Access_Node (TT.Indirect_Attributes); + W : Access_Wrapper; + Self_Id : constant Task_Id := POP.Self; + + begin + Defer_Abort (Self_Id); + POP.Lock_RTS; + + while P /= null loop + if P.Instance = Access_Instance'(Local'Unchecked_Access) then + POP.Unlock_RTS; + Undefer_Abort (Self_Id); + return To_Access_Wrapper (P.Wrapper).Value'Access; + end if; + + P := P.Next; + end loop; + + -- Unlock the RTS here to follow the lock ordering rule that + -- prevent us from using new (i.e the Global_Lock) while holding + -- any other lock. + + POP.Unlock_RTS; + W := new Wrapper' + ((null, Local'Unchecked_Access, null), Initial_Value); + POP.Lock_RTS; + + P := W.Dummy_Node'Unchecked_Access; + P.Wrapper := To_Access_Dummy_Wrapper (W); + P.Next := To_Access_Node (TT.Indirect_Attributes); + TT.Indirect_Attributes := To_Access_Address (P); + POP.Unlock_RTS; + Undefer_Abort (Self_Id); + return W.Value'Access; + + exception + when others => + POP.Unlock_RTS; + Undefer_Abort (Self_Id); + raise; + end; + end if; + + exception + when Tasking_Error | Program_Error => + raise; + + when others => + raise Program_Error; + end Reference; + + ------------------ + -- Reinitialize -- + ------------------ + + procedure Reinitialize + (T : Task_Identification.Task_Id := Task_Identification.Current_Task) + is + TT : constant Task_Id := To_Task_Id (T); + Error_Message : constant String := "Trying to Reinitialize a "; + + begin + if TT = null then + Raise_Exception (Program_Error'Identity, Error_Message & "null task"); + end if; + + if TT.Common.State = Terminated then + Raise_Exception (Tasking_Error'Identity, + Error_Message & "terminated task"); + end if; + + if Local.Index /= 0 then + Set_Value (Initial_Value, T); + else + declare + P, Q : Access_Node; + W : Access_Wrapper; + Self_Id : constant Task_Id := POP.Self; + + begin + Defer_Abort (Self_Id); + POP.Lock_RTS; + Q := To_Access_Node (TT.Indirect_Attributes); + + while Q /= null loop + if Q.Instance = Access_Instance'(Local'Unchecked_Access) then + if P = null then + TT.Indirect_Attributes := To_Access_Address (Q.Next); + else + P.Next := Q.Next; + end if; + + W := To_Access_Wrapper (Q.Wrapper); + Free (W); + POP.Unlock_RTS; + Undefer_Abort (Self_Id); + return; + end if; + + P := Q; + Q := Q.Next; + end loop; + + POP.Unlock_RTS; + Undefer_Abort (Self_Id); + + exception + when others => + POP.Unlock_RTS; + Undefer_Abort (Self_Id); + raise; + end; + end if; + + exception + when Tasking_Error | Program_Error => + raise; + + when others => + raise Program_Error; + end Reinitialize; + + --------------- + -- Set_Value -- + --------------- + + procedure Set_Value + (Val : Attribute; + T : Task_Identification.Task_Id := Task_Identification.Current_Task) + is + TT : constant Task_Id := To_Task_Id (T); + Error_Message : constant String := "Trying to Set the Value of a "; + + begin + if TT = null then + Raise_Exception (Program_Error'Identity, Error_Message & "null task"); + end if; + + if TT.Common.State = Terminated then + Raise_Exception (Tasking_Error'Identity, + Error_Message & "terminated task"); + end if; + + -- Directly addressed case + + if Local.Index /= 0 then + + -- Set attribute handle, warnings off, because this code can generate + -- alignment warnings with large attributes (but of course will not + -- be executed in this case, since we never have direct addressing in + -- such cases). + + pragma Warnings (Off); + To_Attribute_Handle + (TT.Direct_Attributes (Local.Index)'Address).all := Val; + pragma Warnings (On); + return; + end if; + + -- Not directly addressed + + declare + P : Access_Node := To_Access_Node (TT.Indirect_Attributes); + W : Access_Wrapper; + Self_Id : constant Task_Id := POP.Self; + + begin + Defer_Abort (Self_Id); + POP.Lock_RTS; + + while P /= null loop + + if P.Instance = Access_Instance'(Local'Unchecked_Access) then + To_Access_Wrapper (P.Wrapper).Value := Val; + POP.Unlock_RTS; + Undefer_Abort (Self_Id); + return; + end if; + + P := P.Next; + end loop; + + -- Unlock RTS here to follow the lock ordering rule that prevent us + -- from using new (i.e the Global_Lock) while holding any other lock. + + POP.Unlock_RTS; + W := new Wrapper'((null, Local'Unchecked_Access, null), Val); + POP.Lock_RTS; + P := W.Dummy_Node'Unchecked_Access; + P.Wrapper := To_Access_Dummy_Wrapper (W); + P.Next := To_Access_Node (TT.Indirect_Attributes); + TT.Indirect_Attributes := To_Access_Address (P); + + POP.Unlock_RTS; + Undefer_Abort (Self_Id); + + exception + when others => + POP.Unlock_RTS; + Undefer_Abort (Self_Id); + raise; + end; + + exception + when Tasking_Error | Program_Error => + raise; + + when others => + raise Program_Error; + end Set_Value; + + ----------- + -- Value -- + ----------- + + function Value + (T : Task_Identification.Task_Id := Task_Identification.Current_Task) + return Attribute + is + TT : constant Task_Id := To_Task_Id (T); + Error_Message : constant String := "Trying to get the Value of a "; + + begin + if TT = null then + Raise_Exception (Program_Error'Identity, Error_Message & "null task"); + end if; + + if TT.Common.State = Terminated then + Raise_Exception + (Program_Error'Identity, Error_Message & "terminated task"); + end if; + + -- Directly addressed case + + if Local.Index /= 0 then + + -- Get value of attribute. We turn Warnings off, because for large + -- attributes, this code can generate alignment warnings. But of + -- course large attributes are never directly addressed so in fact + -- we will never execute the code in this case. + + pragma Warnings (Off); + return To_Attribute_Handle + (TT.Direct_Attributes (Local.Index)'Address).all; + pragma Warnings (On); + end if; + + -- Not directly addressed + + declare + P : Access_Node; + Result : Attribute; + Self_Id : constant Task_Id := POP.Self; + + begin + Defer_Abort (Self_Id); + POP.Lock_RTS; + P := To_Access_Node (TT.Indirect_Attributes); + + while P /= null loop + if P.Instance = Access_Instance'(Local'Unchecked_Access) then + Result := To_Access_Wrapper (P.Wrapper).Value; + POP.Unlock_RTS; + Undefer_Abort (Self_Id); + return Result; + end if; + + P := P.Next; + end loop; + + POP.Unlock_RTS; + Undefer_Abort (Self_Id); + return Initial_Value; + + exception + when others => + POP.Unlock_RTS; + Undefer_Abort (Self_Id); + raise; + end; + + exception + when Tasking_Error | Program_Error => + raise; + + when others => + raise Program_Error; + end Value; + +-- Start of elaboration code for package Ada.Task_Attributes + +begin + -- This unchecked conversion can give warnings when alignments are + -- incorrect, but they will not be used in such cases anyway, so the + -- warnings can be safely ignored. + + pragma Warnings (Off); + Local.Deallocate := To_Lib_Level_Deallocator (Deallocate'Access); + pragma Warnings (On); + + declare + Two_To_J : Direct_Index_Vector; + Self_Id : constant Task_Id := POP.Self; + begin + Defer_Abort (Self_Id); + + -- Need protection for updating links to per-task initialization and + -- finalization routines, in case some task is being created or + -- terminated concurrently. + + POP.Lock_RTS; + + -- Add this instantiation to the list of all instantiations + + Local.Next := System.Tasking.Task_Attributes.All_Attributes; + System.Tasking.Task_Attributes.All_Attributes := + Local'Unchecked_Access; + + -- Try to find space for the attribute in the TCB + + Local.Index := 0; + Two_To_J := 1; + + if Attribute'Size <= System.Address'Size then + for J in Direct_Index_Range loop + if (Two_To_J and In_Use) = 0 then + + -- Reserve location J for this attribute + + In_Use := In_Use or Two_To_J; + Local.Index := J; + + -- This unchecked conversion can give a warning when the + -- alignment is incorrect, but it will not be used in such + -- a case anyway, so the warning can be safely ignored. + + pragma Warnings (Off); + To_Attribute_Handle (Local.Initial_Value'Access).all := + Initial_Value; + pragma Warnings (On); + + exit; + end if; + + Two_To_J := Two_To_J * 2; + end loop; + end if; + + -- Attribute goes directly in the TCB + + if Local.Index /= 0 then + -- Replace stub for initialization routine that is called at task + -- creation. + + Initialization.Initialize_Attributes_Link := + System.Tasking.Task_Attributes.Initialize_Attributes'Access; + + -- Initialize the attribute, for all tasks + + declare + C : System.Tasking.Task_Id := System.Tasking.All_Tasks_List; + begin + while C /= null loop + C.Direct_Attributes (Local.Index) := + To_Direct_Attribute_Element + (System.Storage_Elements.To_Address (Local.Initial_Value)); + C := C.Common.All_Tasks_Link; + end loop; + end; + + -- Attribute goes into a node onto a linked list + + else + -- Replace stub for finalization routine called at task termination + + Initialization.Finalize_Attributes_Link := + System.Tasking.Task_Attributes.Finalize_Attributes'Access; + end if; + + POP.Unlock_RTS; + Undefer_Abort (Self_Id); + end; +end Ada.Task_Attributes; -- cgit v1.2.3