diff options
author | Eric Botcazou <ebotcazou@adacore.com> | 2023-02-24 17:08:01 +0100 |
---|---|---|
committer | Marc Poulhiès <poulhies@adacore.com> | 2023-05-23 09:59:07 +0200 |
commit | e15ce6502c7b607f2ca0ee178a715d6fc13ac6b6 (patch) | |
tree | 7dc57090942cb4a1a62051908d247b384af8245b /gcc/ada/libgnarl | |
parent | 1dd52433d2d1c122c7338ddb350f8691f084e0cf (diff) | |
download | gcc-e15ce6502c7b607f2ca0ee178a715d6fc13ac6b6.zip gcc-e15ce6502c7b607f2ca0ee178a715d6fc13ac6b6.tar.gz gcc-e15ce6502c7b607f2ca0ee178a715d6fc13ac6b6.tar.bz2 |
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.
Diffstat (limited to 'gcc/ada/libgnarl')
-rw-r--r-- | gcc/ada/libgnarl/a-tasatt.adb | 51 | ||||
-rw-r--r-- | gcc/ada/libgnarl/s-tasini.adb | 2 | ||||
-rw-r--r-- | gcc/ada/libgnarl/s-taskin.ads | 9 | ||||
-rw-r--r-- | 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 fb3ca68..6111f29 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 24f4ba2..2000543 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 47c5ca2..5aa3e37 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 002a7ce..e6d597c 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 |