From: Arnaud Charlet Date: Thu, 23 Jan 2020 15:48:08 +0000 (-0500) Subject: [Ada] New package Ada.Task_Initialization X-Git-Url: https://git.libre-soc.org/?a=commitdiff_plain;h=301e2a16c443924c90e0d038862e957165dd899d;p=gcc.git [Ada] New package Ada.Task_Initialization 2020-06-04 Arnaud Charlet 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 e1b30b95a92..b09159e7e9a 100644 --- 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 70c0b0b7326..7561a198a36 100644 --- 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 index 00000000000..b1f898f5416 --- /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 -- +-- . -- +-- -- +------------------------------------------------------------------------------ + +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 index 00000000000..867f8c51994 --- /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 -- +-- . -- +-- -- +------------------------------------------------------------------------------ + +-- 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 f01dbdcdeda..db1e3b9df32 100644 --- 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 4c7029eee8c..c5940270f6b 100644 --- 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