From patchwork Thu Jun 4 09:12:56 2020 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Pierre-Marie de Rodat X-Patchwork-Id: 1303404 Return-Path: X-Original-To: incoming@patchwork.ozlabs.org Delivered-To: patchwork-incoming@bilbo.ozlabs.org Authentication-Results: ozlabs.org; spf=pass (sender SPF authorized) smtp.mailfrom=gcc.gnu.org (client-ip=8.43.85.97; helo=sourceware.org; envelope-from=gcc-patches-bounces@gcc.gnu.org; receiver=) Authentication-Results: ozlabs.org; dmarc=none (p=none dis=none) header.from=adacore.com Received: from sourceware.org (server2.sourceware.org [8.43.85.97]) (using TLSv1.3 with cipher TLS_AES_256_GCM_SHA384 (256/256 bits) key-exchange X25519 server-signature RSA-PSS (4096 bits) server-digest SHA256) (No client certificate requested) by ozlabs.org (Postfix) with ESMTPS id 49d0Tj4HjHz9sSg for ; Thu, 4 Jun 2020 19:14:33 +1000 (AEST) Received: from server2.sourceware.org (localhost [IPv6:::1]) by sourceware.org (Postfix) with ESMTP id 35D88389042F; Thu, 4 Jun 2020 09:13:09 +0000 (GMT) X-Original-To: gcc-patches@gcc.gnu.org Delivered-To: gcc-patches@gcc.gnu.org Received: from rock.gnat.com (rock.gnat.com [205.232.38.15]) by sourceware.org (Postfix) with ESMTP id 3C7D5388F040 for ; Thu, 4 Jun 2020 09:12:58 +0000 (GMT) DMARC-Filter: OpenDMARC Filter v1.3.2 sourceware.org 3C7D5388F040 Authentication-Results: sourceware.org; dmarc=none (p=none dis=none) header.from=adacore.com Authentication-Results: sourceware.org; spf=pass smtp.mailfrom=derodat@adacore.com Received: from localhost (localhost.localdomain [127.0.0.1]) by filtered-rock.gnat.com (Postfix) with ESMTP id 15128117BB6; Thu, 4 Jun 2020 05:12:58 -0400 (EDT) X-Virus-Scanned: Debian amavisd-new at gnat.com Received: from rock.gnat.com ([127.0.0.1]) by localhost (rock.gnat.com [127.0.0.1]) (amavisd-new, port 10024) with LMTP id jAdJBYD-lE4d; Thu, 4 Jun 2020 05:12:58 -0400 (EDT) Received: from tron.gnat.com (tron.gnat.com [IPv6:2620:20:4000:0:46a8:42ff:fe0e:e294]) by rock.gnat.com (Postfix) with ESMTP id 2D9BC117C6C; Thu, 4 Jun 2020 05:12:56 -0400 (EDT) Received: by tron.gnat.com (Postfix, from userid 4862) id 2CC77112; Thu, 4 Jun 2020 05:12:56 -0400 (EDT) Date: Thu, 4 Jun 2020 05:12:56 -0400 From: Pierre-Marie de Rodat To: gcc-patches@gcc.gnu.org Subject: [Ada] New package Ada.Task_Initialization Message-ID: <20200604091256.GA134751@adacore.com> MIME-Version: 1.0 Content-Disposition: inline User-Agent: Mutt/1.5.23 (2014-03-12) X-Spam-Status: No, score=-3.3 required=5.0 tests=BAYES_00, KAM_ASCII_DIVIDERS, KAM_DMARC_STATUS, KAM_SHORT, SPF_HELO_NONE, SPF_PASS, TXREP autolearn=no autolearn_force=no version=3.4.2 X-Spam-Checker-Version: SpamAssassin 3.4.2 (2018-09-13) on server2.sourceware.org X-BeenThere: gcc-patches@gcc.gnu.org X-Mailman-Version: 2.1.29 Precedence: list List-Id: Gcc-patches mailing list List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Cc: Arnaud Charlet Errors-To: gcc-patches-bounces@gcc.gnu.org Sender: "Gcc-patches" 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 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 -- +-- . -- +-- -- +------------------------------------------------------------------------------ + +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 -- +-- . -- +-- -- +------------------------------------------------------------------------------ + +-- 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