https://gcc.gnu.org/g:fc477a3f361dd5e72512e4ad42ef204af7c4c3e5
commit r15-619-gfc477a3f361dd5e72512e4ad42ef204af7c4c3e5
Author: Eric Botcazou <ebotca...@adacore.com>
Date: Fri Mar 15 16:46:16 2024 +0100
ada: Start the initialization of the tasking runtime earlier
This installs the tasking versions of the RTS_Lock manipulation routines
very early, before the elaboration of all the Ada units of the program,
including those of the runtime, because this elaboration may require the
initialization of RTS_Lock objects.
gcc/ada/
* bindgen.adb (Gen_Adainit): Generate declaration and call to the
imported procedure __gnat_tasking_runtime_initialize if need be.
* libgnat/s-soflin.ads (Locking Soft-Links): Add commentary.
* libgnarl/s-tasini.adb (Tasking_Runtime_Initialize): New procedure
exported as __gnat_tasking_runtime_initialize. Initialize RTS_Lock
manipulation routines here instead of...
(Init_RTS): ...here.
Diff:
---
gcc/ada/bindgen.adb | 18 ++++++++++++++++--
gcc/ada/libgnarl/s-tasini.adb | 30 +++++++++++++++++++++---------
gcc/ada/libgnat/s-soflin.ads | 4 +++-
3 files changed, 40 insertions(+), 12 deletions(-)
diff --git a/gcc/ada/bindgen.adb b/gcc/ada/bindgen.adb
index fc834e3a9b6b..f15f96495df2 100644
--- a/gcc/ada/bindgen.adb
+++ b/gcc/ada/bindgen.adb
@@ -819,8 +819,7 @@ package body Bindgen is
WBI (" pragma Import (C, XDR_Stream, ""__gl_xdr_stream"");");
end if;
- -- Import entry point for elaboration time signal handler
- -- installation, and indication of if it's been called previously.
+ -- Import entry point for initialization of the runtime
WBI ("");
WBI (" procedure Runtime_Initialize " &
@@ -828,6 +827,15 @@ package body Bindgen is
WBI (" pragma Import (C, Runtime_Initialize, " &
"""__gnat_runtime_initialize"");");
+ -- Import entry point for initialization of the tasking runtime
+
+ if With_GNARL then
+ WBI ("");
+ WBI (" procedure Tasking_Runtime_Initialize;");
+ WBI (" pragma Import (C, Tasking_Runtime_Initialize, " &
+ """__gnat_tasking_runtime_initialize"");");
+ end if;
+
-- Import handlers attach procedure for sequential elaboration policy
if System_Interrupts_Used
@@ -1090,6 +1098,12 @@ package body Bindgen is
-- Generate call to Runtime_Initialize
WBI (" Runtime_Initialize (1);");
+
+ -- Generate call to Tasking_Runtime_Initialize
+
+ if With_GNARL then
+ WBI (" Tasking_Runtime_Initialize;");
+ end if;
end if;
-- Generate call to set Initialize_Scalar values if active
diff --git a/gcc/ada/libgnarl/s-tasini.adb b/gcc/ada/libgnarl/s-tasini.adb
index 22294145bed7..794183f5356a 100644
--- a/gcc/ada/libgnarl/s-tasini.adb
+++ b/gcc/ada/libgnarl/s-tasini.adb
@@ -102,10 +102,6 @@ package body System.Tasking.Initialization is
procedure Release_RTS_Lock (Addr : Address);
-- Release the RTS lock at Addr
- ------------------------
- -- Local Subprograms --
- ------------------------
-
----------------------------
-- Tasking Initialization --
----------------------------
@@ -116,6 +112,15 @@ package body System.Tasking.Initialization is
-- of initializing global locks, and installing tasking versions of certain
-- operations used by the compiler. Init_RTS is called during elaboration.
+ procedure Tasking_Runtime_Initialize;
+ pragma Export (Ada, Tasking_Runtime_Initialize,
+ "__gnat_tasking_runtime_initialize");
+ -- This procedure starts the initialization of the GNARL. It installs the
+ -- tasking versions of the RTS_Lock manipulation routines. It is called
+ -- very early before the elaboration of all the Ada units of the program,
+ -- including those of the runtime, because this elaboration may require
+ -- the initialization of RTS_Lock objects.
+
--------------------------
-- Change_Base_Priority --
--------------------------
@@ -414,11 +419,6 @@ package body System.Tasking.Initialization is
SSL.Task_Name := Task_Name'Access;
SSL.Get_Current_Excep := Get_Current_Excep'Access;
- SSL.Initialize_RTS_Lock := Initialize_RTS_Lock'Access;
- SSL.Finalize_RTS_Lock := Finalize_RTS_Lock'Access;
- SSL.Acquire_RTS_Lock := Acquire_RTS_Lock'Access;
- SSL.Release_RTS_Lock := Release_RTS_Lock'Access;
-
-- Initialize the tasking soft links (if not done yet) that are common
-- to the full and the restricted run times.
@@ -430,6 +430,18 @@ package body System.Tasking.Initialization is
Undefer_Abort (Environment_Task);
end Init_RTS;
+ --------------------------------
+ -- Tasking_Runtime_Initialize --
+ --------------------------------
+
+ procedure Tasking_Runtime_Initialize is
+ begin
+ SSL.Initialize_RTS_Lock := Initialize_RTS_Lock'Access;
+ SSL.Finalize_RTS_Lock := Finalize_RTS_Lock'Access;
+ SSL.Acquire_RTS_Lock := Acquire_RTS_Lock'Access;
+ SSL.Release_RTS_Lock := Release_RTS_Lock'Access;
+ end Tasking_Runtime_Initialize;
+
---------------------------
-- Locked_Abort_To_Level--
---------------------------
diff --git a/gcc/ada/libgnat/s-soflin.ads b/gcc/ada/libgnat/s-soflin.ads
index e88268081d8c..c2d947535d9a 100644
--- a/gcc/ada/libgnat/s-soflin.ads
+++ b/gcc/ada/libgnat/s-soflin.ads
@@ -258,12 +258,14 @@ package System.Soft_Links is
procedure Null_Set_Address (Addr : Address) is null;
-- Soft-Links are used for procedures that manipulate locks to avoid
- -- dragging the tasking run time when using access-to-controlled types.
+ -- dragging the tasking runtime when using access-to-controlled types.
Initialize_RTS_Lock : Set_Address_Call := Null_Set_Address'Access;
Finalize_RTS_Lock : Set_Address_Call := Null_Set_Address'Access;
Acquire_RTS_Lock : Set_Address_Call := Null_Set_Address'Access;
Release_RTS_Lock : Set_Address_Call := Null_Set_Address'Access;
+ -- The initialization of these variables must be static because the value
+ -- needs to be overridden very early when the tasking runtime is dragged.
--------------------------
-- Master_Id Soft-Links --
