2014-07-30 Thomas Quinot <quinot@adacore.com>

	* sem.ads (Scope_Table_Entry): New component Locked_Shared_Objects.
	* sem_ch8.adb (Push_Scope): Initialize Locked_Shared_Objects.
	* exp_smem.adb (Add_Shared_Var_Lock_Procs): Handle the case where
	the call returns an unconstrained type: in this case there is
	already a transient scope, and we should not establish a new one.
	* exp_ch7.adb (Insert_Actions_In_Scope_Around): New formal Clean. If
	True, also insert cleanup actions in the tree.
	(Wrap_Transient_Declaration): Call Insert_Actions_In_Scope_Around
	with Clean set True.

2014-07-30  Arnaud Charlet  <charlet@adacore.com>

	* s-taskin.ads (Direct_Index, Direct_Index_Range,
	Direct_Attribute_Element, Direct_Attribute_Array,
	Direct_Index_Vector, Direct_Attributes, Is_Defined,
	Indirect_Attributes): Removed.	(Atomic_Address,
	Attribute_Array, Attributes): New.
	* s-tasini.ads, s-tasini.adb (Proc_T, Initialize_Attributes,
	Finalize_Attributes_Link, Initialize_Attributes_Link): Removed.
	(Finalize_Attributes): Reimplement.
	* s-tassta.adb (Create_Task): Remove call to
	Initialize_Attributes_Link (Free_Task, Vulnerable_Free_Task):
	Replace Finalize_Attributes_Link by Finalize_Attributes.
	* a-tasatt.ads, a-tasatt.adb, s-tataat.ads, s-tataat.adb:
	Reimplement from scratch, using a simpler and more efficient
	implementation.
	* s-tporft.adb (Register_Foreign_Thread): Remove now obsolete comment.
	* s-parame.ads, s-parame-hpux.ads,
	* s-parame-vms-alpha.ads, s-parame-vms-ia64.ads,
	* s-parame-vxworks.ads (Max_Attribute_Count): New, replace
	Default_Attribute_Count.



git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@213265 138bc75d-0d04-0410-961f-82ee72b054a4

1 files changed, 179 insertions, 407 deletions

diff --git a/gcc/ada/a-tasatt.adb b/gcc/ada/a-tasatt.adb
index ae2a715d601..bd7f4a74e90 100644
--- a/gcc/ada/a-tasatt.adb
+++ b/gcc/ada/a-tasatt.adb
@@ -6,8 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---             Copyright (C) 1991-1994, Florida State University            --
---                     Copyright (C) 1995-2014, AdaCore                     --
+--          Copyright (C) 1995-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- --
@@ -30,213 +29,189 @@
 --                                                                          --
 ------------------------------------------------------------------------------
 
-with System.Storage_Elements;
-with System.Task_Primitives.Operations;
 with System.Tasking;
 with System.Tasking.Initialization;
 with System.Tasking.Task_Attributes;
+pragma Elaborate_All (System.Tasking.Task_Attributes);
+
+with System.Task_Primitives.Operations;
 
-with Ada.Exceptions;
+with Ada.Finalization; use Ada.Finalization;
 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,
+   use System,
+       System.Tasking.Initialization,
        System.Tasking,
-       System.Tasking.Task_Attributes,
-       Ada.Exceptions;
+       System.Tasking.Task_Attributes;
+
+   package STPO renames System.Task_Primitives.Operations;
+
+   type Attribute_Cleanup is new Limited_Controlled with null record;
+   procedure Finalize (Cleanup : in out Attribute_Cleanup);
+   --  Finalize all tasks' attribute for this package
 
-   package POP renames System.Task_Primitives.Operations;
+   Cleanup : Attribute_Cleanup;
+   pragma Unreferenced (Cleanup);
+   --  Will call Finalize when this instantiation gets out of scope
 
    ---------------------------
    -- Unchecked Conversions --
    ---------------------------
 
-   --  The following type corresponds to Dummy_Wrapper, declared in
-   --  System.Tasking.Task_Attributes.
-
-   type Wrapper;
-   type Access_Wrapper is access all Wrapper;
-
+   type Real_Attribute is record
+      Free  : Deallocator;
+      Value : Attribute;
+   end record;
+   type Real_Attribute_Access is access all Real_Attribute;
+   pragma No_Strict_Aliasing (Real_Attribute_Access);
+   --  Each value in the task control block's Attributes array is either
+   --  mapped to the attribute value directly if Fast_Path is True, or
+   --  is in effect a Real_Attribute_Access.
+   --  Note: the Deallocator field must be first, for compatibility with
+   --  System.Tasking.Task_Attributes.Attribute_Record and to allow unchecked
+   --  conversions between Attribute_Access and Real_Attribute_Access.
+
+   function New_Attribute (Val : Attribute) return Atomic_Address;
+   --  Create a new Real_Attribute using Val, and return its address.
+   --  The returned value can be converted via To_Real_Attribute.
+
+   procedure Deallocate (Ptr : Atomic_Address);
+   --  Free memory associated with Ptr, a Real_Attribute_Access in reality
+
+   function To_Real_Attribute is new
+     Ada.Unchecked_Conversion (Atomic_Address, Real_Attribute_Access);
+
+   --  Kill warning about possible size mismatch
    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
-
+   function To_Address is new
+     Ada.Unchecked_Conversion (Attribute, Atomic_Address);
+   function To_Attribute is new
+     Ada.Unchecked_Conversion (Atomic_Address, Attribute);
    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
+   function To_Address is new
+     Ada.Unchecked_Conversion (Real_Attribute_Access, Atomic_Address);
 
+   --  Kill warning about possible aliasing
    pragma Warnings (Off);
-   function To_Access_Wrapper is new Ada.Unchecked_Conversion
-     (Access_Dummy_Wrapper, Access_Wrapper);
+   function To_Handle is new
+     Ada.Unchecked_Conversion (System.Address, Attribute_Handle);
    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);
+   procedure Free is new
+     Ada.Unchecked_Deallocation (Real_Attribute, Real_Attribute_Access);
 
-   function To_Lib_Level_Deallocator is new Ada.Unchecked_Conversion
-     (Local_Deallocator, Deallocator);
-   --  To defeat accessibility check
+   Fast_Path : constant Boolean :=
+     Attribute'Size <= Atomic_Address'Size and then
+     To_Address (Initial_Value) = 0;
+   --  If the attribute fits in an Atomic_Address and Initial_Value is 0 (or
+   --  null), then we will map the attribute directly into
+   --  ATCB.Attributes (Index), otherwise we will create a level of indirection
+   --  and instead use Attributes (Index) as a Real_Attribute_Access.
 
-   ------------------------
-   -- Storage Management --
-   ------------------------
+   Index : constant Integer :=
+     Next_Index (Require_Finalization => not Fast_Path);
+   --  Index in the task control block's Attributes array
 
-   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.
+   --------------
+   -- Finalize --
+   --------------
 
-   --------------------------
-   -- Instantiation Record --
-   --------------------------
+   procedure Finalize (Cleanup : in out Attribute_Cleanup) is
+      pragma Unreferenced (Cleanup);
+   begin
+      STPO.Lock_RTS;
 
-   Local : aliased Instance;
-   --  Initialized in package body
+      declare
+         C : System.Tasking.Task_Id := System.Tasking.All_Tasks_List;
+      begin
+         while C /= null loop
+            STPO.Write_Lock (C);
+
+            if C.Attributes (Index) /= 0
+              and then Require_Finalization (Index)
+            then
+               Deallocate (C.Attributes (Index));
+               C.Attributes (Index) := 0;
+            end if;
 
-   type Wrapper is record
-      Dummy_Node : aliased Node;
+            STPO.Unlock (C);
+            C := C.Common.All_Tasks_Link;
+         end loop;
+      end;
 
-      Value : aliased Attribute := Initial_Value;
-      --  The generic formal type, may be controlled
-   end record;
+      Finalize (Index);
+      STPO.Unlock_RTS;
+   end Finalize;
 
-   --  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.
+   ----------------
+   -- Deallocate --
+   ----------------
 
-   for Wrapper'Alignment use Standard'Maximum_Alignment;
+   procedure Deallocate (Ptr : Atomic_Address) is
+      Obj : Real_Attribute_Access := To_Real_Attribute (Ptr);
+   begin
+      Free (Obj);
+   end Deallocate;
 
-   procedure Free is
-      new Ada.Unchecked_Deallocation (Wrapper, Access_Wrapper);
+   -------------------
+   -- New_Attribute --
+   -------------------
 
-   procedure Deallocate (P : in out Access_Node) is
-      T : Access_Wrapper := To_Access_Wrapper (P.Wrapper);
+   function New_Attribute (Val : Attribute) return Atomic_Address is
+      Tmp : Real_Attribute_Access;
    begin
-      Free (T);
-   end Deallocate;
+      Tmp := new Real_Attribute'
+        (Free  => Deallocate'Unrestricted_Access,
+         Value => Val);
+      return To_Address (Tmp);
+   end New_Attribute;
 
    ---------------
    -- Reference --
    ---------------
 
    function Reference
-     (T    : Task_Identification.Task_Id := Task_Identification.Current_Task)
+     (T : Task_Identification.Task_Id := Task_Identification.Current_Task)
       return Attribute_Handle
    is
+      Self_Id       : Task_Id;
       TT            : constant Task_Id := To_Task_Id (T);
       Error_Message : constant String  := "Trying to get the reference of a ";
+      Result        : Attribute_Handle;
 
    begin
       if TT = null then
-         Raise_Exception (Program_Error'Identity, Error_Message & "null task");
+         raise Program_Error with Error_Message & "null task";
       end if;
 
       if TT.Common.State = Terminated then
-         Raise_Exception (Tasking_Error'Identity,
-           Error_Message & "terminated task");
+         raise Tasking_Error with 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
-
+      if Fast_Path then
+         return To_Handle (TT.Attributes (Index)'Address);
       else
-         declare
-            P       : Access_Node := To_Access_Node (TT.Indirect_Attributes);
-            W       : Access_Wrapper;
-            Self_Id : constant Task_Id := POP.Self;
+         Self_Id := STPO.Self;
+         Task_Lock (Self_Id);
 
-         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;
+         if TT.Attributes (Index) = 0 then
+            TT.Attributes (Index) := New_Attribute (Initial_Value);
+         end if;
 
-   exception
-      when Tasking_Error | Program_Error =>
-         raise;
+         Result := To_Handle
+           (To_Real_Attribute (TT.Attributes (Index)).Value'Address);
+         Task_Unlock (Self_Id);
 
-      when others =>
-         raise Program_Error;
+         return Result;
+      end if;
    end Reference;
 
    ------------------
@@ -246,68 +221,37 @@ package body Ada.Task_Attributes is
    procedure Reinitialize
      (T : Task_Identification.Task_Id := Task_Identification.Current_Task)
    is
+      Self_Id       : Task_Id;
       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");
+         raise Program_Error with Error_Message & "null task";
       end if;
 
       if TT.Common.State = Terminated then
-         Raise_Exception (Tasking_Error'Identity,
-           Error_Message & "terminated task");
+         raise Tasking_Error with Error_Message & "terminated task";
       end if;
 
-      if Local.Index /= 0 then
-         Set_Value (Initial_Value, T);
+      if Fast_Path then
+         --  No finalization needed, simply reset to Initial_Value
+         TT.Attributes (Index) := To_Address (Initial_Value);
       else
-         declare
-            P, Q    : Access_Node;
-            W       : Access_Wrapper;
-            Self_Id : constant Task_Id := POP.Self;
+         Self_Id := STPO.Self;
+         Task_Lock (Self_Id);
 
+         declare
+            Attr : Atomic_Address renames TT.Attributes (Index);
          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;
+            if Attr /= 0 then
+               Deallocate (Attr);
+               Attr := 0;
+            end if;
          end;
-      end if;
-
-   exception
-      when Tasking_Error | Program_Error =>
-         raise;
 
-      when others =>
-         raise Program_Error;
+         Task_Unlock (Self_Id);
+      end if;
    end Reinitialize;
 
    ---------------
@@ -318,85 +262,38 @@ package body Ada.Task_Attributes is
      (Val : Attribute;
       T   : Task_Identification.Task_Id := Task_Identification.Current_Task)
    is
+      Self_Id       : Task_Id;
       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");
+         raise Program_Error with Error_Message & "null task";
       end if;
 
       if TT.Common.State = Terminated then
-         Raise_Exception (Tasking_Error'Identity,
-           Error_Message & "terminated task");
+         raise Tasking_Error with 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 Fast_Path then
+         --  No finalization needed, simply set to Val
+         TT.Attributes (Index) := To_Address (Val);
+      else
+         Self_Id := STPO.Self;
+         Task_Lock (Self_Id);
 
-            if P.Instance = Access_Instance'(Local'Unchecked_Access) then
-               To_Access_Wrapper (P.Wrapper).Value := Val;
-               POP.Unlock_RTS;
-               Undefer_Abort (Self_Id);
-               return;
+         declare
+            Attr : Atomic_Address renames TT.Attributes (Index);
+         begin
+            if Attr /= 0 then
+               Deallocate (Attr);
             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;
+            Attr := New_Attribute (Val);
+         end;
 
-      when others =>
-         raise Program_Error;
+         Task_Unlock (Self_Id);
+      end if;
    end Set_Value;
 
    -----------
@@ -407,167 +304,42 @@ package body Ada.Task_Attributes is
      (T : Task_Identification.Task_Id := Task_Identification.Current_Task)
       return Attribute
    is
+      Self_Id       : Task_Id;
       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");
+         raise Program_Error with Error_Message & "null task";
       end if;
 
       if TT.Common.State = Terminated then
-         Raise_Exception
-           (Program_Error'Identity, Error_Message & "terminated task");
+         raise Tasking_Error with 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
+      if Fast_Path then
+         return To_Attribute (TT.Attributes (Index));
+      else
+         Self_Id := STPO.Self;
+         Task_Lock (Self_Id);
 
          declare
-            C : System.Tasking.Task_Id := System.Tasking.All_Tasks_List;
+            Attr : Atomic_Address renames TT.Attributes (Index);
          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;
+            if Attr = 0 then
+               Task_Unlock (Self_Id);
+               return Initial_Value;
+            else
+               declare
+                  Result : constant Attribute :=
+                    To_Real_Attribute (Attr).Value;
+               begin
+                  Task_Unlock (Self_Id);
+                  return Result;
+               end;
+            end if;
          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;
+   end Value;
 
-      POP.Unlock_RTS;
-      Undefer_Abort (Self_Id);
-   end;
 end Ada.Task_Attributes;