* [COMMITTED] ada: Fix address manipulation issue in the tasking runtime
@ 2023-05-23 8:09 Marc Poulhiès
0 siblings, 0 replies; only message in thread
From: Marc Poulhiès @ 2023-05-23 8:09 UTC (permalink / raw)
To: gcc-patches; +Cc: Eric Botcazou
From: Eric Botcazou <ebotcazou@adacore.com>
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.
Tested on x86_64-pc-linux-gnu, committed on master.
---
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 fb3ca682f15..6111f2987a5 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 24f4ba2085a..2000543ee2b 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 47c5ca25a03..5aa3e37a904 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 002a7cec1fe..e6d597cf907 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.40.0
^ permalink raw reply [flat|nested] only message in thread
only message in thread, other threads:[~2023-05-23 8:09 UTC | newest]
Thread overview: (only message) (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
2023-05-23 8:09 [COMMITTED] ada: Fix address manipulation issue in the tasking runtime Marc Poulhiès
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).