[Ada] New package Ada.Task_Initialization

2020-06-04  Arnaud Charlet  <charlet@adacore.com>

gcc/ada/

	* Makefile.rtl: add a-tasini object
	* impunit.adb (Non_Imp_File_Names_95): Add s-tasini.
	* libgnarl/a-tasini.ads, libgnarl/a-tasini.adb: New files.
	* libgnarl/s-taskin.ads (Global_Initialization_Handler): New.
	* libgnarl/s-tassta.adb (Task_Wrapper): Call
	Global_Initialization_Handler if non null.

diff --git a/gcc/ada/Makefile.rtl b/gcc/ada/Makefile.rtl
index e1b30b9..b09159e 100644 (file)
--- a/gcc/ada/Makefile.rtl
+++ b/gcc/ada/Makefile.rtl
@@ -39,6 +39,7 @@ GNATRTL_TASKING_OBJS= \
   a-sytaco$(objext) \
   a-tasatt$(objext) \
   a-taside$(objext) \
+  a-tasini$(objext) \
   a-taster$(objext) \
   g-boubuf$(objext) \
   g-boumai$(objext) \

diff --git a/gcc/ada/impunit.adb b/gcc/ada/impunit.adb
index 70c0b0b..7561a19 100644 (file)
--- a/gcc/ada/impunit.adb
+++ b/gcc/ada/impunit.adb
@@ -181,6 +181,7 @@ package body Impunit is
     ("a-ssicst", F),  -- Ada.Streams.Stream_IO.C_Streams
     ("a-suteio", F),  -- Ada.Strings.Unbounded.Text_IO
     ("a-swuwti", F),  -- Ada.Strings.Wide_Unbounded.Wide_Text_IO
+    ("a-tasini", F),  -- Ada.Task_Initialization
     ("a-tiocst", F),  -- Ada.Text_IO.C_Streams
     ("a-wtcstr", F),  -- Ada.Wide_Text_IO.C_Streams
 

diff --git a/gcc/ada/libgnarl/a-tasini.adb b/gcc/ada/libgnarl/a-tasini.adb
new file mode 100644 (file)
index 0000000..b1f898f
--- /dev/null
+++ b/gcc/ada/libgnarl/a-tasini.adb
@@ -0,0 +1,46 @@
+------------------------------------------------------------------------------
+--                                                                          --
+--                 GNAT RUN-TIME LIBRARY (GNARL) COMPONENTS                 --
+--                                                                          --
+--              A D A . T A S K _ I N I T I A L I Z A T I O N               --
+--                                                                          --
+--                                  B o d y                                 --
+--                                                                          --
+--             Copyright (C) 2020, Free Software Foundation, Inc.           --
+--                                                                          --
+-- 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 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    --
+-- <http://www.gnu.org/licenses/>.                                          --
+--                                                                          --
+------------------------------------------------------------------------------
+
+with Ada.Unchecked_Conversion;
+with System.Tasking;
+
+package body Ada.Task_Initialization is
+
+   function To_STIH is new Ada.Unchecked_Conversion
+     (Initialization_Handler, System.Tasking.Initialization_Handler);
+
+   --------------------------------
+   -- Set_Initialization_Handler --
+   --------------------------------
+
+   procedure Set_Initialization_Handler (Handler : Initialization_Handler) is
+   begin
+      System.Tasking.Global_Initialization_Handler := To_STIH (Handler);
+   end Set_Initialization_Handler;
+
+end Ada.Task_Initialization;

diff --git a/gcc/ada/libgnarl/a-tasini.ads b/gcc/ada/libgnarl/a-tasini.ads
new file mode 100644 (file)
index 0000000..867f8c5
--- /dev/null
+++ b/gcc/ada/libgnarl/a-tasini.ads
@@ -0,0 +1,42 @@
+------------------------------------------------------------------------------
+--                                                                          --
+--                 GNAT RUN-TIME LIBRARY (GNARL) COMPONENTS                 --
+--                                                                          --
+--              A D A . T A S K _ I N I T I A L I Z A T I O N               --
+--                                                                          --
+--                                  S p e c                                 --
+--                                                                          --
+--             Copyright (C) 2020, Free Software Foundation, Inc.           --
+--                                                                          --
+-- 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 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    --
+-- <http://www.gnu.org/licenses/>.                                          --
+--                                                                          --
+------------------------------------------------------------------------------
+
+--  This package provides a way to set up a global initialization handler
+--  when tasks start.
+
+package Ada.Task_Initialization is
+   pragma Preelaborate (Task_Initialization);
+
+   type Initialization_Handler is access procedure;
+
+   procedure Set_Initialization_Handler (Handler : Initialization_Handler);
+   --  Set the global task initialization handler to Handler
+
+private
+   pragma Favor_Top_Level (Initialization_Handler);
+end Ada.Task_Initialization;

diff --git a/gcc/ada/libgnarl/s-taskin.ads b/gcc/ada/libgnarl/s-taskin.ads
index f01dbdc..db1e3b9 100644 (file)
--- a/gcc/ada/libgnarl/s-taskin.ads
+++ b/gcc/ada/libgnarl/s-taskin.ads
@@ -368,6 +368,14 @@ package System.Tasking is
    --  Used to represent protected procedures to be executed when task
    --  terminates.
 
+   type Initialization_Handler is access procedure;
+   pragma Favor_Top_Level (Initialization_Handler);
+   --  Use to represent procedures to be executed at task initialization.
+
+   Global_Initialization_Handler : Initialization_Handler := null;
+   pragma Atomic (Global_Initialization_Handler);
+   --  Global handler called when each task initializes.
+
    ------------------------------------
    -- Dispatching domain definitions --
    ------------------------------------

diff --git a/gcc/ada/libgnarl/s-tassta.adb b/gcc/ada/libgnarl/s-tassta.adb
index 4c7029e..c594027 100644 (file)
--- a/gcc/ada/libgnarl/s-tassta.adb
+++ b/gcc/ada/libgnarl/s-tassta.adb
@@ -1187,6 +1187,12 @@ package body System.Tasking.Stages is
          --  we do not call Set_Jmpbuf_Address (which needs Self) before we
          --  set Self in Enter_Task
 
+         --  Call the initialization hook if any
+
+         if Global_Initialization_Handler /= null then
+            Global_Initialization_Handler.all;
+         end if;
+
          --  Call the task body procedure
 
          --  The task body is called with abort still deferred. That