[gcc r12-4314] [Ada] Runtime transition: System.Threads

[gcc r12-4314] [Ada] Runtime transition: System.Threads

[Pierre-Marie de Rodat]

https://gcc.gnu.org/g:547513eeab951fddeb53baaa577de32dc8b779de

commit r12-4314-g547513eeab951fddeb53baaa577de32dc8b779de
Author: Doug Rupp <rupp@adacore.com>
Date:   Wed Oct 6 13:03:56 2021 -0700

    [Ada] Runtime transition: System.Threads
    
    gcc/ada/
    
            * libgnat/s-thread.ads: Fix comments.  Remove unused package
            imports.
            (Thread_Body_Exception_Exit): Remove Exception_Occurrence
            parameter.
            (ATSD): Declare type locally.
            * libgnat/s-thread__ae653.adb: Fix comments.  Remove unused
            package imports.  Remove package references to Stack_Limit
            checking.
            (Install_Handler): Remove.
            (Set_Sec_Stack): Likewise.
            (Thread_Body_Enter): Remove calls to Install_Handler and
            Stack_Limit checking.
            (Thread_Body_Exception_Exit): Remove Exception_Occurrence
            parameter.
            (Init_RTS): Call local Get_Sec_Stack.  Remove call to
            Install_Handler.  Remove references to accessors for
            Get_Sec_Stack and Set_Sec_Stack.  Remove OS check.
            (Set_Sec_Stack): Remove.

Diff:
---
 gcc/ada/libgnat/s-thread.ads        | 14 +++----
 gcc/ada/libgnat/s-thread__ae653.adb | 78 ++++---------------------------------
 2 files changed, 14 insertions(+), 78 deletions(-)

diff --git a/gcc/ada/libgnat/s-thread.ads b/gcc/ada/libgnat/s-thread.ads
index 5d0a3c14baf..6508df50c3f 100644
--- a/gcc/ada/libgnat/s-thread.ads
+++ b/gcc/ada/libgnat/s-thread.ads
@@ -34,16 +34,13 @@
 
 --  This package is currently implemented for:
 
---    VxWorks AE653 rts-cert
---    VxWorks AE653 rts-full (not rts-kernel)
+--    VxWorks7r2Cert Light
 
-with Ada.Exceptions;
 with Ada.Unchecked_Conversion;
 
 with Interfaces.C;
 
 with System.Secondary_Stack;
-with System.Soft_Links;
 
 package System.Threads is
 
@@ -81,12 +78,15 @@ package System.Threads is
    procedure Thread_Body_Leave;
    --  Leave thread body (normally), see above for details
 
-   procedure Thread_Body_Exceptional_Exit
-     (EO : Ada.Exceptions.Exception_Occurrence);
+   procedure Thread_Body_Exceptional_Exit;
    --  Leave thread body (abnormally on exception), see above for details
 
 private
 
-   type ATSD is new System.Soft_Links.TSD;
+   type ATSD is record
+      Sec_Stack_Ptr : SST.SS_Stack_Ptr;
+      --  Pointer of the allocated secondary stack
+
+   end record;
 
 end System.Threads;
diff --git a/gcc/ada/libgnat/s-thread__ae653.adb b/gcc/ada/libgnat/s-thread__ae653.adb
index ecbd415c728..2282a66c87a 100644
--- a/gcc/ada/libgnat/s-thread__ae653.adb
+++ b/gcc/ada/libgnat/s-thread__ae653.adb
@@ -29,22 +29,19 @@
 --                                                                          --
 ------------------------------------------------------------------------------
 
---  This is the VxWorks 653 version of this package
+--  This is the VxWorks7r2Cert Light version of this package
 
 pragma Restrictions (No_Tasking);
---  The VxWorks 653 version of this package is intended only for programs
---  which do not use Ada tasking. This restriction ensures that this
---  will be checked by the binder.
+--  The VxWorks7r2Cert Light version of this package is intended only
+--  for programs which do not use Ada tasking. This restriction ensures
+--  that this will be checked by the binder.
 
 with System.Storage_Elements; use System.Storage_Elements;
-with System.OS_Versions; use System.OS_Versions;
 
 package body System.Threads is
 
    use Interfaces.C;
 
-   package SSL renames System.Soft_Links;
-
    Main_ATSD : aliased ATSD;
    --  TSD for environment task
 
@@ -52,21 +49,7 @@ package body System.Threads is
    pragma Thread_Local_Storage (Current_ATSD);
    --  pragma TLS needed since TaskVarAdd no longer available
 
-   --  Assume guard pages for Helix APEX partitions, but leave
-   --  checking mechanism in for now, in case of surprises. ???
-   Stack_Limit : Address;
-   pragma Import (C, Stack_Limit, "__gnat_stack_limit");
-
-   type Set_Stack_Limit_Proc_Acc is access procedure;
-   pragma Convention (C, Set_Stack_Limit_Proc_Acc);
-
-   Set_Stack_Limit_Hook : Set_Stack_Limit_Proc_Acc;
-   pragma Import (C, Set_Stack_Limit_Hook, "__gnat_set_stack_limit_hook");
-   --  Procedure to be called when a task is created to set stack limit if
-   --  limit checking is used.
-
    --  VxWorks specific API
-
    ERROR : constant STATUS := Interfaces.C.int (-1);
    OK    : constant STATUS := Interfaces.C.int (0);
 
@@ -85,13 +68,8 @@ package body System.Threads is
    --  It installs System.Threads versions of certain operations of the
    --  run-time lib.
 
-   procedure Install_Handler;
-   pragma Import (C, Install_Handler, "__gnat_install_handler");
-
    function  Get_Sec_Stack return SST.SS_Stack_Ptr;
 
-   procedure Set_Sec_Stack (Stack : SST.SS_Stack_Ptr);
-
    -----------------------
    -- Thread_Body_Enter --
    -----------------------
@@ -108,27 +86,14 @@ package body System.Threads is
       ATSD.Sec_Stack_Ptr := Sec_Stack_Ptr;
       SST.SS_Init (ATSD.Sec_Stack_Ptr);
       Current_ATSD := Process_ATSD_Address;
-      Install_Handler;
-
-      --  Assume guard pages for Helix/Vx7, but leave in for now ???
-      --  Initialize stack limit if needed.
 
-      if Current_ATSD /= Main_ATSD'Address
-        and then Set_Stack_Limit_Hook /= null
-      then
-         Set_Stack_Limit_Hook.all;
-      end if;
    end Thread_Body_Enter;
 
    ----------------------------------
    -- Thread_Body_Exceptional_Exit --
    ----------------------------------
 
-   procedure Thread_Body_Exceptional_Exit
-     (EO : Ada.Exceptions.Exception_Occurrence)
-   is
-      pragma Unreferenced (EO);
-
+   procedure Thread_Body_Exceptional_Exit is
    begin
       --  No action for this target
 
@@ -156,11 +121,8 @@ package body System.Threads is
       pragma Assert (Result /= ERROR);
 
    begin
-      Main_ATSD.Sec_Stack_Ptr := SSL.Get_Sec_Stack_NT;
+      Main_ATSD.Sec_Stack_Ptr := Get_Sec_Stack;
       Current_ATSD := Main_ATSD'Address;
-      Install_Handler;
-      SSL.Get_Sec_Stack := Get_Sec_Stack'Access;
-      SSL.Set_Sec_Stack := Set_Sec_Stack'Access;
    end Init_RTS;
 
    -------------------
@@ -190,38 +152,12 @@ package body System.Threads is
 
       Current_ATSD := To_Address (Integer_Address (T));
 
-      --  The same issue applies to the task variable that contains the stack
-      --  limit when that overflow checking mechanism is used instead of
-      --  probing. If stack checking is enabled and limit checking is used,
-      --  allocate the limit for this task. The environment task has this
-      --  initialized by the binder-generated main when
-      --  System.Stack_Check_Limits = True.
-
-      pragma Warnings (Off);
-
-      --  OS is a constant
-      if OS /= VxWorks_653 and then Set_Stack_Limit_Hook /= null then
-         --  Check that this is correct if limit checking left in. ???
-         Stack_Limit := To_Address (Integer_Address (T));
-      end if;
-      pragma Warnings (On);
-
       return OK;
    end Register;
 
-   -------------------
-   -- Set_Sec_Stack --
-   -------------------
-
-   procedure Set_Sec_Stack (Stack : SST.SS_Stack_Ptr) is
-      CTSD : constant ATSD_Access := From_Address (Current_ATSD);
-   begin
-      pragma Assert (CTSD /= null);
-      CTSD.Sec_Stack_Ptr := Stack;
-   end Set_Sec_Stack;
-
 begin
    --  Initialize run-time library
 
    Init_RTS;
+
 end System.Threads;