Subversion Repositories openrisc_2011-10-31

------------------------------------------------------------------------------

--                                                                          --

--                        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-2009, AdaCore                     --

--                                                                          --

-- 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- --

-- ware  Foundation;  either version 2,  or (at your option) any later ver- --

-- sion. GNARL 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.  See the GNU General Public License --

-- for  more details.  You should have  received  a copy of the GNU General --

-- Public License  distributed with GNARL; see file COPYING.  If not, write --

-- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --

-- Boston, MA 02110-1301, USA.                                              --

--                                                                          --

-- As a special exception,  if other files  instantiate  generics from this --

-- unit, or you link  this unit with other files  to produce an executable, --

-- this  unit  does not  by itself cause  the resulting  executable  to  be --

-- covered  by the  GNU  General  Public  License.  This exception does not --

-- however invalidate  any other reasons why  the executable file  might be --

-- covered by the  GNU Public License.                                      --

--                                                                          --

-- 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;