This package provides a way to set up a global initialization handler
when tasks start.
Tested on x86_64-pc-linux-gnu, committed on trunk
2020-06-04 Arnaud Charlet <char...@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.--- gcc/ada/Makefile.rtl
+++ 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) \
--- gcc/ada/impunit.adb
+++ 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
--- /dev/null
new file mode 100644
+++ 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;
--- /dev/null
new file mode 100644
+++ 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;
--- gcc/ada/libgnarl/s-taskin.ads
+++ 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 --
------------------------------------
--- gcc/ada/libgnarl/s-tassta.adb
+++ 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
