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.

diff --git a/gcc/ada/libgnarl/a-tasatt.adb b/gcc/ada/libgnarl/a-tasatt.adb
index fb3ca682f156ea79b9332202dbec7168328054ea..6111f2987a591963511632be3f36b8efea8dff6b 100644 (file)
--- 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 24f4ba2085acb1d2a297e01c0fb6d2aa383fa294..2000543ee2bb88e13c3552afd56bb82d5a277318 100644 (file)
--- 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 47c5ca25a03b20fe219cdf734f9d98070eefa92e..5aa3e37a9047754291aa152e52b410d267ba509a 100644 (file)
--- 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 002a7cec1fe6b18785bed2a41def9bb36adff405..e6d597cf9075369d78cfce2034f3958567db15d8 100644 (file)
--- 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