ada: Tweak handling of thread ID on POSIX

This patch changes the task initialization subprograms on POSIX
platforms so that the thread ID of an ATCB is only set once.
This has the advantage of getting rid of the Atomic aspect on
the corresponding record component, and silences a Helgrind
warning about a data race.

gcc/ada/

	* libgnarl/s-taprop__linux.adb (Enter_Task): Move setting
	of thread ID out of Enter_Task.
	(Initialize): Set thread ID for the environment task.
	(Create_Task): Remove now unnecessary Unrestricted_Access
	attribute and add justification for a memory write.
	* libgnarl/s-taprop__posix.adb: Likewise.
	* libgnarl/s-taprop__qnx.adb: Likewise.
	* libgnarl/s-taprop__rtems.adb: Likewise.
	* libgnarl/s-taprop__solaris.adb: Likewise.
	* libgnarl/s-taspri__posix.ads: Remove pragma Atomic for
	Private_Data.Thread, and update documentation comment.
	* libgnarl/s-taspri__lynxos.ads: Likewise.
	* libgnarl/s-taspri__posix-noaltstack.ads: Likewise.
	* libgnarl/s-taspri__solaris.ads: Likewise.
	* libgnarl/s-tporft.adb (Register_Foreign_Thread): Adapt to
	Enter_Task not setting the thread ID anymore.
	* libgnarl/s-tassta.adb (Task_Wrapper): Update comment.

11 files changed, 78 insertions, 61 deletions

diff --git a/gcc/ada/libgnarl/s-taprop__linux.adb b/gcc/ada/libgnarl/s-taprop__linux.adb
index 0c09817..0a51b36 100644
--- a/gcc/ada/libgnarl/s-taprop__linux.adb
+++ b/gcc/ada/libgnarl/s-taprop__linux.adb
@@ -730,7 +730,6 @@ package body System.Task_Primitives.Operations is
          raise Invalid_CPU_Number;
       end if;
 
-      Self_ID.Common.LL.Thread := pthread_self;
       Self_ID.Common.LL.LWP := lwp_self;
 
       --  Set thread name to ease debugging. If the name of the task is
@@ -1004,14 +1003,14 @@ package body System.Task_Primitives.Operations is
       --  do not need to manipulate caller's signal mask at this point.
       --  All tasks in RTS will have All_Tasks_Mask initially.
 
-      --  Note: the use of Unrestricted_Access in the following call is needed
-      --  because otherwise we have an error of getting a access-to-volatile
-      --  value which points to a non-volatile object. But in this case it is
-      --  safe to do this, since we know we have no problems with aliasing and
-      --  Unrestricted_Access bypasses this check.
+      --  The write to T.Common.LL.Thread is not racy with regard to the
+      --  created thread because the created thread will not access it until
+      --  we release the RTS lock (or the current task's lock when
+      --  Restricted.Stages is used). One can verify that by inspecting the
+      --  Task_Wrapper procedures.
 
       Result := pthread_create
-        (T.Common.LL.Thread'Unrestricted_Access,
+        (T.Common.LL.Thread'Access,
          Thread_Attr'Access,
          Thread_Body_Access (Wrapper),
          To_Address (T));
@@ -1385,6 +1384,7 @@ package body System.Task_Primitives.Operations is
 
    begin
       Environment_Task_Id := Environment_Task;
+      Environment_Task.Common.LL.Thread := pthread_self;
 
       Interrupt_Management.Initialize;
 
diff --git a/gcc/ada/libgnarl/s-taprop__posix.adb b/gcc/ada/libgnarl/s-taprop__posix.adb
index 7ed52ea..fb70aaf 100644
--- a/gcc/ada/libgnarl/s-taprop__posix.adb
+++ b/gcc/ada/libgnarl/s-taprop__posix.adb
@@ -636,7 +636,6 @@ package body System.Task_Primitives.Operations is
 
    procedure Enter_Task (Self_ID : Task_Id) is
    begin
-      Self_ID.Common.LL.Thread := pthread_self;
       Self_ID.Common.LL.LWP := lwp_self;
 
       Specific.Set (Self_ID);
@@ -841,14 +840,14 @@ package body System.Task_Primitives.Operations is
       --  do not need to manipulate caller's signal mask at this point.
       --  All tasks in RTS will have All_Tasks_Mask initially.
 
-      --  Note: the use of Unrestricted_Access in the following call is needed
-      --  because otherwise we have an error of getting a access-to-volatile
-      --  value which points to a non-volatile object. But in this case it is
-      --  safe to do this, since we know we have no problems with aliasing and
-      --  Unrestricted_Access bypasses this check.
+      --  The write to T.Common.LL.Thread is not racy with regard to the
+      --  created thread because the created thread will not access it until
+      --  we release the RTS lock (or the current task's lock when
+      --  Restricted.Stages is used). One can verify that by inspecting the
+      --  Task_Wrapper procedures.
 
       Result := pthread_create
-        (T.Common.LL.Thread'Unrestricted_Access,
+        (T.Common.LL.Thread'Access,
          Attributes'Access,
          Thread_Body_Access (Wrapper),
          To_Address (T));
@@ -1260,6 +1259,7 @@ package body System.Task_Primitives.Operations is
 
    begin
       Environment_Task_Id := Environment_Task;
+      Environment_Task.Common.LL.Thread := pthread_self;
 
       Interrupt_Management.Initialize;
 
diff --git a/gcc/ada/libgnarl/s-taprop__qnx.adb b/gcc/ada/libgnarl/s-taprop__qnx.adb
index 108180d..f475c05 100644
--- a/gcc/ada/libgnarl/s-taprop__qnx.adb
+++ b/gcc/ada/libgnarl/s-taprop__qnx.adb
@@ -654,7 +654,6 @@ package body System.Task_Primitives.Operations is
 
    procedure Enter_Task (Self_ID : Task_Id) is
    begin
-      Self_ID.Common.LL.Thread := pthread_self;
       Self_ID.Common.LL.LWP := lwp_self;
 
       Specific.Set (Self_ID);
@@ -846,14 +845,14 @@ package body System.Task_Primitives.Operations is
       --  do not need to manipulate caller's signal mask at this point.
       --  All tasks in RTS will have All_Tasks_Mask initially.
 
-      --  Note: the use of Unrestricted_Access in the following call is needed
-      --  because otherwise we have an error of getting a access-to-volatile
-      --  value which points to a non-volatile object. But in this case it is
-      --  safe to do this, since we know we have no problems with aliasing and
-      --  Unrestricted_Access bypasses this check.
+      --  The write to T.Common.LL.Thread is not racy with regard to the
+      --  created thread because the created thread will not access it until
+      --  we release the RTS lock (or the current task's lock when
+      --  Restricted.Stages is used). One can verify that by inspecting the
+      --  Task_Wrapper procedures.
 
       Result := pthread_create
-        (T.Common.LL.Thread'Unrestricted_Access,
+        (T.Common.LL.Thread'Access,
          Attributes'Access,
          Thread_Body_Access (Wrapper),
          To_Address (T));
@@ -1261,6 +1260,7 @@ package body System.Task_Primitives.Operations is
 
    begin
       Environment_Task_Id := Environment_Task;
+      Environment_Task.Common.LL.Thread := pthread_self;
 
       Interrupt_Management.Initialize;
 
diff --git a/gcc/ada/libgnarl/s-taprop__rtems.adb b/gcc/ada/libgnarl/s-taprop__rtems.adb
index 3feafd8..ea8422c 100644
--- a/gcc/ada/libgnarl/s-taprop__rtems.adb
+++ b/gcc/ada/libgnarl/s-taprop__rtems.adb
@@ -646,7 +646,6 @@ package body System.Task_Primitives.Operations is
 
    procedure Enter_Task (Self_ID : Task_Id) is
    begin
-      Self_ID.Common.LL.Thread := pthread_self;
       Self_ID.Common.LL.LWP := lwp_self;
 
       Specific.Set (Self_ID);
@@ -851,14 +850,14 @@ package body System.Task_Primitives.Operations is
       --  do not need to manipulate caller's signal mask at this point.
       --  All tasks in RTS will have All_Tasks_Mask initially.
 
-      --  Note: the use of Unrestricted_Access in the following call is needed
-      --  because otherwise we have an error of getting a access-to-volatile
-      --  value which points to a non-volatile object. But in this case it is
-      --  safe to do this, since we know we have no problems with aliasing and
-      --  Unrestricted_Access bypasses this check.
+      --  The write to T.Common.LL.Thread is not racy with regard to the
+      --  created thread because the created thread will not access it until
+      --  we release the RTS lock (or the current task's lock when
+      --  Restricted.Stages is used). One can verify that by inspecting the
+      --  Task_Wrapper procedures.
 
       Result := pthread_create
-        (T.Common.LL.Thread'Unrestricted_Access,
+        (T.Common.LL.Thread'Access,
          Attributes'Access,
          Thread_Body_Access (Wrapper),
          To_Address (T));
@@ -1270,6 +1269,7 @@ package body System.Task_Primitives.Operations is
 
    begin
       Environment_Task_Id := Environment_Task;
+      Environment_Task.Common.LL.Thread := pthread_self;
 
       Interrupt_Management.Initialize;
 
diff --git a/gcc/ada/libgnarl/s-taprop__solaris.adb b/gcc/ada/libgnarl/s-taprop__solaris.adb
index 82e51b8..09f90e6 100644
--- a/gcc/ada/libgnarl/s-taprop__solaris.adb
+++ b/gcc/ada/libgnarl/s-taprop__solaris.adb
@@ -424,6 +424,7 @@ package body System.Task_Primitives.Operations is
 
    begin
       Environment_Task_Id := Environment_Task;
+      Self_ID.Common.LL.Thread := thr_self;
 
       Interrupt_Management.Initialize;
 
@@ -868,8 +869,7 @@ package body System.Task_Primitives.Operations is
 
    procedure Enter_Task (Self_ID : Task_Id) is
    begin
-      Self_ID.Common.LL.Thread := thr_self;
-      Self_ID.Common.LL.LWP    := lwp_self;
+      Self_ID.Common.LL.LWP := lwp_self;
 
       Set_Task_Affinity (Self_ID);
       Specific.Set (Self_ID);
@@ -997,11 +997,11 @@ package body System.Task_Primitives.Operations is
          Opts := THR_DETACHED + THR_BOUND;
       end if;
 
-      --  Note: the use of Unrestricted_Access in the following call is needed
-      --  because otherwise we have an error of getting a access-to-volatile
-      --  value which points to a non-volatile object. But in this case it is
-      --  safe to do this, since we know we have no problems with aliasing and
-      --  Unrestricted_Access bypasses this check.
+      --  The write to T.Common.LL.Thread is not racy with regard to the
+      --  created thread because the created thread will not access it until
+      --  we release the RTS lock (or the current task's lock when
+      --  Restricted.Stages is used). One can verify that by inspecting the
+      --  Task_Wrapper procedures.
 
       Result :=
         thr_create
@@ -1010,7 +1010,7 @@ package body System.Task_Primitives.Operations is
            Thread_Body_Access (Wrapper),
            To_Address (T),
            Opts,
-           T.Common.LL.Thread'Unrestricted_Access);
+           T.Common.LL.Thread'Access);
 
       Succeeded := Result = 0;
       pragma Assert
diff --git a/gcc/ada/libgnarl/s-taspri__lynxos.ads b/gcc/ada/libgnarl/s-taspri__lynxos.ads
index a330700..f5e434e 100644
--- a/gcc/ada/libgnarl/s-taspri__lynxos.ads
+++ b/gcc/ada/libgnarl/s-taspri__lynxos.ads
@@ -86,12 +86,16 @@ private
 
    type Private_Data is limited record
       Thread : aliased System.OS_Interface.pthread_t;
-      pragma Atomic (Thread);
-      --  Thread field may be updated by two different threads of control.
-      --  (See, Enter_Task and Create_Task in s-taprop.adb). They put the same
-      --  value (thr_self value). We do not want to use lock on those
-      --  operations and the only thing we have to make sure is that they are
-      --  updated in atomic fashion.
+      --  This component is written to once before concurrent access to it is
+      --  possible, and then remains constant. The place where it is written to
+      --  depends on how the enclosing ATCB comes into existence:
+      --
+      --  1. For the environment task, the component is set in
+      --     System.Task_Primitive.Operations.Initialize.
+      --  2. For foreign threads, it happens in
+      --     System.Task_Primitives.Operations.Register_Foreign_Thread.
+      --  3. For others tasks, it's in
+      --     System.Task_Primitives.Operations.Create_Task.
 
       LWP : aliased System.OS_Interface.pthread_t;
       --  The purpose of this field is to provide a better tasking support on
diff --git a/gcc/ada/libgnarl/s-taspri__posix-noaltstack.ads b/gcc/ada/libgnarl/s-taspri__posix-noaltstack.ads
index b92f1dd..fb7e07d 100644
--- a/gcc/ada/libgnarl/s-taspri__posix-noaltstack.ads
+++ b/gcc/ada/libgnarl/s-taspri__posix-noaltstack.ads
@@ -89,12 +89,16 @@ private
 
    type Private_Data is limited record
       Thread : aliased System.OS_Interface.pthread_t;
-      pragma Atomic (Thread);
-      --  Thread field may be updated by two different threads of control.
-      --  (See, Enter_Task and Create_Task in s-taprop.adb). They put the same
-      --  value (thr_self value). We do not want to use lock on those
-      --  operations and the only thing we have to make sure is that they are
-      --  updated in atomic fashion.
+      --  This component is written to once before concurrent access to it is
+      --  possible, and then remains constant. The place where it is written to
+      --  depends on how the enclosing ATCB comes into existence:
+      --
+      --  1. For the environment task, the component is set in
+      --     System.Task_Primitive.Operations.Initialize.
+      --  2. For foreign threads, it happens in
+      --     System.Task_Primitives.Operations.Register_Foreign_Thread.
+      --  3. For others tasks, it's in
+      --     System.Task_Primitives.Operations.Create_Task.
 
       LWP : aliased System.Address;
       --  The purpose of this field is to provide a better tasking support on
diff --git a/gcc/ada/libgnarl/s-taspri__posix.ads b/gcc/ada/libgnarl/s-taspri__posix.ads
index 4d0b379..3453f4f 100644
--- a/gcc/ada/libgnarl/s-taspri__posix.ads
+++ b/gcc/ada/libgnarl/s-taspri__posix.ads
@@ -88,12 +88,16 @@ private
 
    type Private_Data is limited record
       Thread : aliased System.OS_Interface.pthread_t;
-      pragma Atomic (Thread);
-      --  Thread field may be updated by two different threads of control.
-      --  (See, Enter_Task and Create_Task in s-taprop.adb). They put the same
-      --  value (thr_self value). We do not want to use lock on those
-      --  operations and the only thing we have to make sure is that they are
-      --  updated in atomic fashion.
+      --  This component is written to once before concurrent access to it is
+      --  possible, and then remains constant. The place where it is written to
+      --  depends on how the enclosing ATCB comes into existence:
+      --
+      --  1. For the environment task, the component is set in
+      --     System.Task_Primitive.Operations.Initialize.
+      --  2. For foreign threads, it happens in
+      --     System.Task_Primitives.Operations.Register_Foreign_Thread.
+      --  3. For others tasks, it's in
+      --     System.Task_Primitives.Operations.Create_Task.
 
       LWP : aliased System.Address;
       --  The purpose of this field is to provide a better tasking support on
diff --git a/gcc/ada/libgnarl/s-taspri__solaris.ads b/gcc/ada/libgnarl/s-taspri__solaris.ads
index 16fc419..586c971 100644
--- a/gcc/ada/libgnarl/s-taspri__solaris.ads
+++ b/gcc/ada/libgnarl/s-taspri__solaris.ads
@@ -95,12 +95,16 @@ private
 
    type Private_Data is limited record
       Thread : aliased System.OS_Interface.thread_t;
-      pragma Atomic (Thread);
-      --  Thread field may be updated by two different threads of control.
-      --  (See, Enter_Task and Create_Task in s-taprop.adb). They put the same
-      --  value (thr_self value). We do not want to use lock on those
-      --  operations and the only thing we have to make sure is that they are
-      --  updated in atomic fashion.
+      --  This component is written to once before concurrent access to it is
+      --  possible, and then remains constant. The place where it is written to
+      --  depends on how the enclosing ATCB comes into existence:
+      --
+      --  1. For the environment task, the component is set in
+      --     System.Task_Primitive.Operations.Initialize.
+      --  2. For foreign threads, it happens in
+      --     System.Task_Primitives.Operations.Register_Foreign_Thread.
+      --  3. For others tasks, it's in
+      --     System.Task_Primitives.Operations.Create_Task.
 
       LWP : System.OS_Interface.lwpid_t;
       --  The LWP id of the thread. Set by self in Enter_Task
diff --git a/gcc/ada/libgnarl/s-tassta.adb b/gcc/ada/libgnarl/s-tassta.adb
index 01c94b9..594a167 100644
--- a/gcc/ada/libgnarl/s-tassta.adb
+++ b/gcc/ada/libgnarl/s-tassta.adb
@@ -1079,7 +1079,7 @@ package body System.Tasking.Stages is
       Stack_Guard (Self_ID, True);
 
       --  Initialize low-level TCB components, that cannot be initialized by
-      --  the creator. Enter_Task sets Self_ID.LL.Thread.
+      --  the creator.
 
       Enter_Task (Self_ID);
 
diff --git a/gcc/ada/libgnarl/s-tporft.adb b/gcc/ada/libgnarl/s-tporft.adb
index a7b4ce5..66a9f02 100644
--- a/gcc/ada/libgnarl/s-tporft.adb
+++ b/gcc/ada/libgnarl/s-tporft.adb
@@ -98,6 +98,7 @@ begin
    System.Soft_Links.Create_TSD
      (Self_Id.Common.Compiler_Data, null, Sec_Stack_Size);
 
+   Self_Id.Common.LL.Thread := Thread;
    Enter_Task (Self_Id);
 
    return Self_Id;