From e15ce6502c7b607f2ca0ee178a715d6fc13ac6b6 Mon Sep 17 00:00:00 2001 From: Eric Botcazou Date: Fri, 24 Feb 2023 17:08:01 +0100 Subject: [PATCH] ada: Fix address manipulation issue in the tasking runtime The implementation of task attributes in the runtime defines an atomic clone of System.Address, which is awkward for targets where addresses and pointers have a specific representation, so this change replaces that with a pragma Atomic_Components on the Attribute_Array type. gcc/ada/ * libgnarl/s-taskin.ads (Atomic_Address): Delete. (Attribute_Array): Add pragma Atomic_Components. (Ada_Task_Control_Block): Adjust default value of Attributes. * libgnarl/s-tasini.adb (Finalize_Attributes): Adjust type of local variable. * libgnarl/s-tataat.ads (Deallocator): Adjust type of parameter. (To_Attribute): Adjust source type. * libgnarl/a-tasatt.adb: Add clauses for System.Storage_Elements. (New_Attribute): Adjust return type. (Deallocate): Adjust type of parameter. (To_Real_Attribute): Adjust source type. (To_Address): Add target type. (To_Attribute): Adjust source type. (Fast_Path): Adjust tested type. (Finalize): Compare with Null_Address. (Reference): Likewise. (Reinitialize): Likewise. (Set_Value): Likewise. Add conversion to Integer_Address. (Value): Likewise. --- gcc/ada/libgnarl/a-tasatt.adb | 51 ++++++++++++++++++----------------- gcc/ada/libgnarl/s-tasini.adb | 2 +- gcc/ada/libgnarl/s-taskin.ads | 9 +++---- gcc/ada/libgnarl/s-tataat.ads | 4 +-- 4 files changed, 33 insertions(+), 33 deletions(-) diff --git a/gcc/ada/libgnarl/a-tasatt.adb b/gcc/ada/libgnarl/a-tasatt.adb index fb3ca682f156..6111f2987a59 100644 --- a/gcc/ada/libgnarl/a-tasatt.adb +++ b/gcc/ada/libgnarl/a-tasatt.adb @@ -29,6 +29,7 @@ -- -- ------------------------------------------------------------------------------ +with System.Storage_Elements; with System.Tasking; with System.Tasking.Initialization; with System.Tasking.Task_Attributes; @@ -43,6 +44,7 @@ with Ada.Unchecked_Deallocation; package body Ada.Task_Attributes is use System, + System.Storage_Elements, System.Tasking.Initialization, System.Tasking, System.Tasking.Task_Attributes; @@ -75,34 +77,32 @@ package body Ada.Task_Attributes is -- System.Tasking.Task_Attributes.Attribute_Record and to allow unchecked -- conversions between Attribute_Access and Real_Attribute_Access. - function New_Attribute (Val : Attribute) return Atomic_Address; + function New_Attribute (Val : Attribute) return System.Address; -- Create a new Real_Attribute using Val, and return its address. The -- returned value can be converted via To_Real_Attribute. - procedure Deallocate (Ptr : Atomic_Address); + procedure Deallocate (Ptr : System.Address); -- Free memory associated with Ptr, a Real_Attribute_Access in reality function To_Real_Attribute is new - Ada.Unchecked_Conversion (Atomic_Address, Real_Attribute_Access); + Ada.Unchecked_Conversion (System.Address, Real_Attribute_Access); pragma Warnings (Off); -- Kill warning about possible size mismatch function To_Address is new - Ada.Unchecked_Conversion (Attribute, Atomic_Address); + Ada.Unchecked_Conversion (Attribute, System.Address); function To_Attribute is new - Ada.Unchecked_Conversion (Atomic_Address, Attribute); + Ada.Unchecked_Conversion (System.Address, Attribute); type Unsigned is mod 2 ** Integer'Size; - function To_Address is new - Ada.Unchecked_Conversion (Attribute, System.Address); function To_Unsigned is new Ada.Unchecked_Conversion (Attribute, Unsigned); pragma Warnings (On); function To_Address is new - Ada.Unchecked_Conversion (Real_Attribute_Access, Atomic_Address); + Ada.Unchecked_Conversion (Real_Attribute_Access, System.Address); pragma Warnings (Off); -- Kill warning about possible aliasing @@ -121,12 +121,12 @@ package body Ada.Task_Attributes is Fast_Path : constant Boolean := (Attribute'Size = Integer'Size - and then Attribute'Alignment <= Atomic_Address'Alignment + and then Attribute'Alignment <= System.Address'Alignment and then To_Unsigned (Initial_Value) = 0) or else (Attribute'Size = System.Address'Size - and then Attribute'Alignment <= Atomic_Address'Alignment - and then To_Address (Initial_Value) = System.Null_Address); - -- If the attribute fits in an Atomic_Address (both size and alignment) + and then Attribute'Alignment <= System.Address'Alignment + and then To_Address (Initial_Value) = Null_Address); + -- If the attribute fits in a System.Address (both size and alignment) -- and Initial_Value is 0 (or null), then we will map the attribute -- directly into ATCB.Attributes (Index), otherwise we will create -- a level of indirection and instead use Attributes (Index) as a @@ -153,11 +153,11 @@ package body Ada.Task_Attributes is while C /= null loop STPO.Write_Lock (C); - if C.Attributes (Index) /= 0 + if C.Attributes (Index) /= Null_Address and then Require_Finalization (Index) then Deallocate (C.Attributes (Index)); - C.Attributes (Index) := 0; + C.Attributes (Index) := Null_Address; end if; STPO.Unlock (C); @@ -173,7 +173,7 @@ package body Ada.Task_Attributes is -- Deallocate -- ---------------- - procedure Deallocate (Ptr : Atomic_Address) is + procedure Deallocate (Ptr : System.Address) is Obj : Real_Attribute_Access := To_Real_Attribute (Ptr); begin Free (Obj); @@ -183,7 +183,7 @@ package body Ada.Task_Attributes is -- New_Attribute -- ------------------- - function New_Attribute (Val : Attribute) return Atomic_Address is + function New_Attribute (Val : Attribute) return System.Address is Tmp : Real_Attribute_Access; begin Tmp := new Real_Attribute'(Free => Deallocate'Unrestricted_Access, @@ -223,7 +223,7 @@ package body Ada.Task_Attributes is Self_Id := STPO.Self; Task_Lock (Self_Id); - if TT.Attributes (Index) = 0 then + if TT.Attributes (Index) = Null_Address then TT.Attributes (Index) := New_Attribute (Initial_Value); end if; @@ -266,11 +266,11 @@ package body Ada.Task_Attributes is Task_Lock (Self_Id); declare - Attr : Atomic_Address renames TT.Attributes (Index); + Attr : System.Address renames TT.Attributes (Index); begin - if Attr /= 0 then + if Attr /= Null_Address then Deallocate (Attr); - Attr := 0; + Attr := Null_Address; end if; end; @@ -304,7 +304,8 @@ package body Ada.Task_Attributes is -- No finalization needed, simply set to Val if Attribute'Size = Integer'Size then - TT.Attributes (Index) := Atomic_Address (To_Unsigned (Val)); + TT.Attributes (Index) := + To_Address (Integer_Address (To_Unsigned (Val))); else TT.Attributes (Index) := To_Address (Val); end if; @@ -314,10 +315,10 @@ package body Ada.Task_Attributes is Task_Lock (Self_Id); declare - Attr : Atomic_Address renames TT.Attributes (Index); + Attr : System.Address renames TT.Attributes (Index); begin - if Attr /= 0 then + if Attr /= Null_Address then Deallocate (Attr); end if; @@ -357,10 +358,10 @@ package body Ada.Task_Attributes is Task_Lock (Self_Id); declare - Attr : Atomic_Address renames TT.Attributes (Index); + Attr : System.Address renames TT.Attributes (Index); begin - if Attr = 0 then + if Attr = Null_Address then Task_Unlock (Self_Id); return Initial_Value; diff --git a/gcc/ada/libgnarl/s-tasini.adb b/gcc/ada/libgnarl/s-tasini.adb index 24f4ba2085ac..2000543ee2bb 100644 --- a/gcc/ada/libgnarl/s-tasini.adb +++ b/gcc/ada/libgnarl/s-tasini.adb @@ -758,7 +758,7 @@ package body System.Tasking.Initialization is ------------------------- procedure Finalize_Attributes (T : Task_Id) is - Attr : Atomic_Address; + Attr : System.Address; begin for J in T.Attributes'Range loop diff --git a/gcc/ada/libgnarl/s-taskin.ads b/gcc/ada/libgnarl/s-taskin.ads index 47c5ca25a03b..5aa3e37a9047 100644 --- a/gcc/ada/libgnarl/s-taskin.ads +++ b/gcc/ada/libgnarl/s-taskin.ads @@ -958,11 +958,10 @@ package System.Tasking is type Entry_Call_Array is array (ATC_Level_Index) of aliased Entry_Call_Record; - type Atomic_Address is mod Memory_Size; - pragma Atomic (Atomic_Address); type Attribute_Array is - array (1 .. Parameters.Max_Attribute_Count) of Atomic_Address; - -- Array of task attributes. The value (Atomic_Address) will either be + array (1 .. Parameters.Max_Attribute_Count) of System.Address; + pragma Atomic_Components (Attribute_Array); + -- Array of task attributes. The value (System.Address) will either be -- converted to a task attribute if it fits, or to a pointer to a record -- by Ada.Task_Attributes. @@ -1157,7 +1156,7 @@ package System.Tasking is -- non-terminated task so that the associated storage is automatically -- reclaimed when the task terminates. - Attributes : Attribute_Array := [others => 0]; + Attributes : Attribute_Array := [others => Null_Address]; -- Task attributes -- IMPORTANT Note: the Entry_Queues field is last for efficiency of diff --git a/gcc/ada/libgnarl/s-tataat.ads b/gcc/ada/libgnarl/s-tataat.ads index 002a7cec1fe6..e6d597cf9075 100644 --- a/gcc/ada/libgnarl/s-tataat.ads +++ b/gcc/ada/libgnarl/s-tataat.ads @@ -35,7 +35,7 @@ with Ada.Unchecked_Conversion; package System.Tasking.Task_Attributes is - type Deallocator is access procedure (Ptr : Atomic_Address); + type Deallocator is access procedure (Ptr : System.Address); pragma Favor_Top_Level (Deallocator); type Attribute_Record is record @@ -48,7 +48,7 @@ package System.Tasking.Task_Attributes is pragma No_Strict_Aliasing (Attribute_Access); function To_Attribute is new - Ada.Unchecked_Conversion (Atomic_Address, Attribute_Access); + Ada.Unchecked_Conversion (System.Address, Attribute_Access); function Next_Index (Require_Finalization : Boolean) return Integer; -- Return the next attribute index available. Require_Finalization is True -- 2.47.2