public inbox for gcc-cvs@sourceware.org
help / color / mirror / Atom feed
* [gcc r12-4539] [Ada] Expose and use type-generic GCC atomic builtins
@ 2021-10-20 10:17 Pierre-Marie de Rodat
0 siblings, 0 replies; only message in thread
From: Pierre-Marie de Rodat @ 2021-10-20 10:17 UTC (permalink / raw)
To: gcc-cvs
https://gcc.gnu.org/g:d24e5767fe780653d5601b69d981f33e2a62e47e
commit r12-4539-gd24e5767fe780653d5601b69d981f33e2a62e47e
Author: Eric Botcazou <ebotcazou@adacore.com>
Date: Mon Oct 11 16:16:41 2021 +0200
[Ada] Expose and use type-generic GCC atomic builtins
gcc/ada/
* sem_ch12.adb (Analyze_Subprogram_Instantiation): Also propagate an
interface name on an intrinsic subprogram. Remove obsolete comment.
* libgnat/s-atopri.ads (Atomic_Load): New generic intrinsic function
(Atomic_Load_8): Rewrite into instantiation.
(Atomic_Load_16): Likewise.
(Atomic_Load_32): Likewise.
(Atomic_Load_64): Likewise.
(Sync_Compare_And_Swap): New generic intrinsic function.
(Sync_Compare_And_Swap_8): Rewrite into instantiation.
(Sync_Compare_And_Swap_16): Likewise.
(Sync_Compare_And_Swap_32): Likewise.
(Sync_Compare_And_Swap_64): Likewise.
(Lock_Free_Read): New generic inline function.
(Lock_Free_Read_8): Rewrite into instantiation.
(Lock_Free_Read_16): Likewise.
(Lock_Free_Read_32): Likewise.
(Lock_Free_Read_64): Likewise.
(Lock_Free_Try_Write): New generic inline function.
(Lock_Free_Try_Write_8): Rewrite into instantiation.
(Lock_Free_Try_Write_16): Likewise.
(Lock_Free_Try_Write_32): Likewise.
(Lock_Free_Try_Write_64): Likewise.
* libgnat/s-atopri.adb (Lock_Free_Read): New function body.
(Lock_Free_Read_8): Delete.
(Lock_Free_Read_16): Likewise.
(Lock_Free_Read_32): Likewise.
(Lock_Free_Read_64): Likewise.
(Lock_Free_Try_Write): New function body.
(Lock_Free_Try_Write_8): Delete.
(Lock_Free_Try_Write_16): Likewise.
(Lock_Free_Try_Write_32): Likewise.
(Lock_Free_Try_Write_64): Likewise.
* libgnat/s-aoinar.adb (Atomic_Fetch_And_Add): Use type-generic GCC
atomic builtin and tidy up implementation.
(Atomic_Fetch_And_Subtract): Likewise.
* libgnat/s-aomoar.adb (Atomic_Fetch_And_Add): Likewise.
(Atomic_Fetch_And_Subtract): Likewise.
* libgnat/s-atopex.adb (Atomic_Exchange): Likewise.
(Atomic_Compare_And_Exchange): Likewise.
Diff:
---
gcc/ada/libgnat/s-aoinar.adb | 74 +++++---------------
gcc/ada/libgnat/s-aomoar.adb | 80 +++++----------------
gcc/ada/libgnat/s-atopex.adb | 83 ++++------------------
gcc/ada/libgnat/s-atopri.adb | 161 ++++++-------------------------------------
gcc/ada/libgnat/s-atopri.ads | 145 +++++++++++++-------------------------
gcc/ada/sem_ch12.adb | 10 +--
6 files changed, 123 insertions(+), 430 deletions(-)
diff --git a/gcc/ada/libgnat/s-aoinar.adb b/gcc/ada/libgnat/s-aoinar.adb
index 2f430ed4efe..41d0cda2cde 100644
--- a/gcc/ada/libgnat/s-aoinar.adb
+++ b/gcc/ada/libgnat/s-aoinar.adb
@@ -72,22 +72,10 @@ package body System.Atomic_Operations.Integer_Arithmetic is
Value : Atomic_Type) return Atomic_Type
is
pragma Warnings (Off);
- function Atomic_Fetch_Add_1
+ function Atomic_Fetch_Add
(Ptr : System.Address; Val : Atomic_Type; Model : Mem_Model := Seq_Cst)
return Atomic_Type;
- pragma Import (Intrinsic, Atomic_Fetch_Add_1, "__atomic_fetch_add_1");
- function Atomic_Fetch_Add_2
- (Ptr : System.Address; Val : Atomic_Type; Model : Mem_Model := Seq_Cst)
- return Atomic_Type;
- pragma Import (Intrinsic, Atomic_Fetch_Add_2, "__atomic_fetch_add_2");
- function Atomic_Fetch_Add_4
- (Ptr : System.Address; Val : Atomic_Type; Model : Mem_Model := Seq_Cst)
- return Atomic_Type;
- pragma Import (Intrinsic, Atomic_Fetch_Add_4, "__atomic_fetch_add_4");
- function Atomic_Fetch_Add_8
- (Ptr : System.Address; Val : Atomic_Type; Model : Mem_Model := Seq_Cst)
- return Atomic_Type;
- pragma Import (Intrinsic, Atomic_Fetch_Add_8, "__atomic_fetch_add_8");
+ pragma Import (Intrinsic, Atomic_Fetch_Add, "__atomic_fetch_add");
pragma Warnings (On);
begin
@@ -96,21 +84,14 @@ package body System.Atomic_Operations.Integer_Arithmetic is
if Atomic_Type'Base'Last = Atomic_Type'Last
and then Atomic_Type'Base'First = Atomic_Type'First
- and then Atomic_Type'Last
- in 2 ** 7 - 1 | 2 ** 15 - 1 | 2 ** 31 - 1 | 2 ** 63 - 1
+ and then Atomic_Type'Last = 2**(Atomic_Type'Object_Size - 1) - 1
then
- case Long_Long_Integer (Atomic_Type'Last) is
- when 2 ** 7 - 1 =>
- return Atomic_Fetch_Add_1 (Item'Address, Value);
- when 2 ** 15 - 1 =>
- return Atomic_Fetch_Add_2 (Item'Address, Value);
- when 2 ** 31 - 1 =>
- return Atomic_Fetch_Add_4 (Item'Address, Value);
- when 2 ** 63 - 1 =>
- return Atomic_Fetch_Add_8 (Item'Address, Value);
- when others =>
- raise Program_Error;
- end case;
+ if Atomic_Type'Object_Size in 8 | 16 | 32 | 64 then
+ return Atomic_Fetch_Add (Item'Address, Value);
+ else
+ raise Program_Error;
+ end if;
+
else
declare
Old_Value : aliased Atomic_Type := Item;
@@ -138,22 +119,10 @@ package body System.Atomic_Operations.Integer_Arithmetic is
Value : Atomic_Type) return Atomic_Type
is
pragma Warnings (Off);
- function Atomic_Fetch_Sub_1
+ function Atomic_Fetch_Sub
(Ptr : System.Address; Val : Atomic_Type; Model : Mem_Model := Seq_Cst)
return Atomic_Type;
- pragma Import (Intrinsic, Atomic_Fetch_Sub_1, "__atomic_fetch_sub_1");
- function Atomic_Fetch_Sub_2
- (Ptr : System.Address; Val : Atomic_Type; Model : Mem_Model := Seq_Cst)
- return Atomic_Type;
- pragma Import (Intrinsic, Atomic_Fetch_Sub_2, "__atomic_fetch_sub_2");
- function Atomic_Fetch_Sub_4
- (Ptr : System.Address; Val : Atomic_Type; Model : Mem_Model := Seq_Cst)
- return Atomic_Type;
- pragma Import (Intrinsic, Atomic_Fetch_Sub_4, "__atomic_fetch_sub_4");
- function Atomic_Fetch_Sub_8
- (Ptr : System.Address; Val : Atomic_Type; Model : Mem_Model := Seq_Cst)
- return Atomic_Type;
- pragma Import (Intrinsic, Atomic_Fetch_Sub_8, "__atomic_fetch_sub_8");
+ pragma Import (Intrinsic, Atomic_Fetch_Sub, "__atomic_fetch_sub");
pragma Warnings (On);
begin
@@ -162,21 +131,14 @@ package body System.Atomic_Operations.Integer_Arithmetic is
if Atomic_Type'Base'Last = Atomic_Type'Last
and then Atomic_Type'Base'First = Atomic_Type'First
- and then Atomic_Type'Last
- in 2 ** 7 - 1 | 2 ** 15 - 1 | 2 ** 31 - 1 | 2 ** 63 - 1
+ and then Atomic_Type'Last = 2**(Atomic_Type'Object_Size - 1) - 1
then
- case Long_Long_Integer (Atomic_Type'Last) is
- when 2 ** 7 - 1 =>
- return Atomic_Fetch_Sub_1 (Item'Address, Value);
- when 2 ** 15 - 1 =>
- return Atomic_Fetch_Sub_2 (Item'Address, Value);
- when 2 ** 31 - 1 =>
- return Atomic_Fetch_Sub_4 (Item'Address, Value);
- when 2 ** 63 - 1 =>
- return Atomic_Fetch_Sub_8 (Item'Address, Value);
- when others =>
- raise Program_Error;
- end case;
+ if Atomic_Type'Object_Size in 8 | 16 | 32 | 64 then
+ return Atomic_Fetch_Sub (Item'Address, Value);
+ else
+ raise Program_Error;
+ end if;
+
else
declare
Old_Value : aliased Atomic_Type := Item;
diff --git a/gcc/ada/libgnat/s-aomoar.adb b/gcc/ada/libgnat/s-aomoar.adb
index a6f4b0e61e8..617a5b30de3 100644
--- a/gcc/ada/libgnat/s-aomoar.adb
+++ b/gcc/ada/libgnat/s-aomoar.adb
@@ -72,48 +72,26 @@ package body System.Atomic_Operations.Modular_Arithmetic is
Value : Atomic_Type) return Atomic_Type
is
pragma Warnings (Off);
- function Atomic_Fetch_Add_1
+ function Atomic_Fetch_Add
(Ptr : System.Address; Val : Atomic_Type; Model : Mem_Model := Seq_Cst)
return Atomic_Type;
- pragma Import (Intrinsic, Atomic_Fetch_Add_1, "__atomic_fetch_add_1");
- function Atomic_Fetch_Add_2
- (Ptr : System.Address; Val : Atomic_Type; Model : Mem_Model := Seq_Cst)
- return Atomic_Type;
- pragma Import (Intrinsic, Atomic_Fetch_Add_2, "__atomic_fetch_add_2");
- function Atomic_Fetch_Add_4
- (Ptr : System.Address; Val : Atomic_Type; Model : Mem_Model := Seq_Cst)
- return Atomic_Type;
- pragma Import (Intrinsic, Atomic_Fetch_Add_4, "__atomic_fetch_add_4");
- function Atomic_Fetch_Add_8
- (Ptr : System.Address; Val : Atomic_Type; Model : Mem_Model := Seq_Cst)
- return Atomic_Type;
- pragma Import (Intrinsic, Atomic_Fetch_Add_8, "__atomic_fetch_add_8");
+ pragma Import (Intrinsic, Atomic_Fetch_Add, "__atomic_fetch_add");
pragma Warnings (On);
begin
-- Use the direct intrinsics when possible, and fallback to
-- compare-and-exchange otherwise.
- -- Also suppress spurious warnings.
- pragma Warnings (Off);
if Atomic_Type'Base'Last = Atomic_Type'Last
and then Atomic_Type'First = 0
- and then Atomic_Type'Last
- in 2 ** 8 - 1 | 2 ** 16 - 1 | 2 ** 32 - 1 | 2 ** 64 - 1
+ and then Atomic_Type'Last = 2**Atomic_Type'Object_Size - 1
then
- pragma Warnings (On);
- case Unsigned_64 (Atomic_Type'Last) is
- when 2 ** 8 - 1 =>
- return Atomic_Fetch_Add_1 (Item'Address, Value);
- when 2 ** 16 - 1 =>
- return Atomic_Fetch_Add_2 (Item'Address, Value);
- when 2 ** 32 - 1 =>
- return Atomic_Fetch_Add_4 (Item'Address, Value);
- when 2 ** 64 - 1 =>
- return Atomic_Fetch_Add_8 (Item'Address, Value);
- when others =>
- raise Program_Error;
- end case;
+ if Atomic_Type'Object_Size in 8 | 16 | 32 | 64 then
+ return Atomic_Fetch_Add (Item'Address, Value);
+ else
+ raise Program_Error;
+ end if;
+
else
declare
Old_Value : aliased Atomic_Type := Item;
@@ -141,48 +119,26 @@ package body System.Atomic_Operations.Modular_Arithmetic is
Value : Atomic_Type) return Atomic_Type
is
pragma Warnings (Off);
- function Atomic_Fetch_Sub_1
+ function Atomic_Fetch_Sub
(Ptr : System.Address; Val : Atomic_Type; Model : Mem_Model := Seq_Cst)
return Atomic_Type;
- pragma Import (Intrinsic, Atomic_Fetch_Sub_1, "__atomic_fetch_sub_1");
- function Atomic_Fetch_Sub_2
- (Ptr : System.Address; Val : Atomic_Type; Model : Mem_Model := Seq_Cst)
- return Atomic_Type;
- pragma Import (Intrinsic, Atomic_Fetch_Sub_2, "__atomic_fetch_sub_2");
- function Atomic_Fetch_Sub_4
- (Ptr : System.Address; Val : Atomic_Type; Model : Mem_Model := Seq_Cst)
- return Atomic_Type;
- pragma Import (Intrinsic, Atomic_Fetch_Sub_4, "__atomic_fetch_sub_4");
- function Atomic_Fetch_Sub_8
- (Ptr : System.Address; Val : Atomic_Type; Model : Mem_Model := Seq_Cst)
- return Atomic_Type;
- pragma Import (Intrinsic, Atomic_Fetch_Sub_8, "__atomic_fetch_sub_8");
+ pragma Import (Intrinsic, Atomic_Fetch_Sub, "__atomic_fetch_sub");
pragma Warnings (On);
begin
-- Use the direct intrinsics when possible, and fallback to
-- compare-and-exchange otherwise.
- -- Also suppress spurious warnings.
- pragma Warnings (Off);
if Atomic_Type'Base'Last = Atomic_Type'Last
and then Atomic_Type'First = 0
- and then Atomic_Type'Last
- in 2 ** 8 - 1 | 2 ** 16 - 1 | 2 ** 32 - 1 | 2 ** 64 - 1
+ and then Atomic_Type'Last = 2**Atomic_Type'Object_Size - 1
then
- pragma Warnings (On);
- case Unsigned_64 (Atomic_Type'Last) is
- when 2 ** 8 - 1 =>
- return Atomic_Fetch_Sub_1 (Item'Address, Value);
- when 2 ** 16 - 1 =>
- return Atomic_Fetch_Sub_2 (Item'Address, Value);
- when 2 ** 32 - 1 =>
- return Atomic_Fetch_Sub_4 (Item'Address, Value);
- when 2 ** 64 - 1 =>
- return Atomic_Fetch_Sub_8 (Item'Address, Value);
- when others =>
- raise Program_Error;
- end case;
+ if Atomic_Type'Object_Size in 8 | 16 | 32 | 64 then
+ return Atomic_Fetch_Sub (Item'Address, Value);
+ else
+ raise Program_Error;
+ end if;
+
else
declare
Old_Value : aliased Atomic_Type := Item;
diff --git a/gcc/ada/libgnat/s-atopex.adb b/gcc/ada/libgnat/s-atopex.adb
index b0aa9e593d1..65e943350dd 100644
--- a/gcc/ada/libgnat/s-atopex.adb
+++ b/gcc/ada/libgnat/s-atopex.adb
@@ -43,36 +43,19 @@ package body System.Atomic_Operations.Exchange is
Value : Atomic_Type) return Atomic_Type
is
pragma Warnings (Off);
- function Atomic_Exchange_1
+ function Atomic_Exchange
(Ptr : System.Address;
Val : Atomic_Type;
Model : Mem_Model := Seq_Cst) return Atomic_Type;
- pragma Import (Intrinsic, Atomic_Exchange_1, "__atomic_exchange_1");
- function Atomic_Exchange_2
- (Ptr : System.Address;
- Val : Atomic_Type;
- Model : Mem_Model := Seq_Cst) return Atomic_Type;
- pragma Import (Intrinsic, Atomic_Exchange_2, "__atomic_exchange_2");
- function Atomic_Exchange_4
- (Ptr : System.Address;
- Val : Atomic_Type;
- Model : Mem_Model := Seq_Cst) return Atomic_Type;
- pragma Import (Intrinsic, Atomic_Exchange_4, "__atomic_exchange_4");
- function Atomic_Exchange_8
- (Ptr : System.Address;
- Val : Atomic_Type;
- Model : Mem_Model := Seq_Cst) return Atomic_Type;
- pragma Import (Intrinsic, Atomic_Exchange_8, "__atomic_exchange_8");
+ pragma Import (Intrinsic, Atomic_Exchange, "__atomic_exchange_n");
pragma Warnings (On);
begin
- case Atomic_Type'Object_Size is
- when 8 => return Atomic_Exchange_1 (Item'Address, Value);
- when 16 => return Atomic_Exchange_2 (Item'Address, Value);
- when 32 => return Atomic_Exchange_4 (Item'Address, Value);
- when 64 => return Atomic_Exchange_8 (Item'Address, Value);
- when others => raise Program_Error;
- end case;
+ if Atomic_Type'Object_Size in 8 | 16 | 32 | 64 then
+ return Atomic_Exchange (Item'Address, Value);
+ else
+ raise Program_Error;
+ end if;
end Atomic_Exchange;
---------------------------------
@@ -85,34 +68,7 @@ package body System.Atomic_Operations.Exchange is
Desired : Atomic_Type) return Boolean
is
pragma Warnings (Off);
- function Atomic_Compare_Exchange_1
- (Ptr : System.Address;
- Expected : System.Address;
- Desired : Atomic_Type;
- Weak : Boolean := False;
- Success_Model : Mem_Model := Seq_Cst;
- Failure_Model : Mem_Model := Seq_Cst) return Boolean;
- pragma Import
- (Intrinsic, Atomic_Compare_Exchange_1, "__atomic_compare_exchange_1");
- function Atomic_Compare_Exchange_2
- (Ptr : System.Address;
- Expected : System.Address;
- Desired : Atomic_Type;
- Weak : Boolean := False;
- Success_Model : Mem_Model := Seq_Cst;
- Failure_Model : Mem_Model := Seq_Cst) return Boolean;
- pragma Import
- (Intrinsic, Atomic_Compare_Exchange_2, "__atomic_compare_exchange_2");
- function Atomic_Compare_Exchange_4
- (Ptr : System.Address;
- Expected : System.Address;
- Desired : Atomic_Type;
- Weak : Boolean := False;
- Success_Model : Mem_Model := Seq_Cst;
- Failure_Model : Mem_Model := Seq_Cst) return Boolean;
- pragma Import
- (Intrinsic, Atomic_Compare_Exchange_4, "__atomic_compare_exchange_4");
- function Atomic_Compare_Exchange_8
+ function Atomic_Compare_Exchange
(Ptr : System.Address;
Expected : System.Address;
Desired : Atomic_Type;
@@ -120,26 +76,15 @@ package body System.Atomic_Operations.Exchange is
Success_Model : Mem_Model := Seq_Cst;
Failure_Model : Mem_Model := Seq_Cst) return Boolean;
pragma Import
- (Intrinsic, Atomic_Compare_Exchange_8, "__atomic_compare_exchange_8");
+ (Intrinsic, Atomic_Compare_Exchange, "__atomic_compare_exchange_n");
pragma Warnings (On);
begin
- case Atomic_Type'Object_Size is
- when 8 =>
- return
- Atomic_Compare_Exchange_1 (Item'Address, Prior'Address, Desired);
- when 16 =>
- return
- Atomic_Compare_Exchange_2 (Item'Address, Prior'Address, Desired);
- when 32 =>
- return
- Atomic_Compare_Exchange_4 (Item'Address, Prior'Address, Desired);
- when 64 =>
- return
- Atomic_Compare_Exchange_8 (Item'Address, Prior'Address, Desired);
- when others =>
- raise Program_Error;
- end case;
+ if Atomic_Type'Object_Size in 8 | 16 | 32 | 64 then
+ return Atomic_Compare_Exchange (Item'Address, Prior'Address, Desired);
+ else
+ raise Program_Error;
+ end if;
end Atomic_Compare_And_Exchange;
------------------
diff --git a/gcc/ada/libgnat/s-atopri.adb b/gcc/ada/libgnat/s-atopri.adb
index ba284f06421..20aa6666c19 100644
--- a/gcc/ada/libgnat/s-atopri.adb
+++ b/gcc/ada/libgnat/s-atopri.adb
@@ -31,103 +31,39 @@
package body System.Atomic_Primitives is
- ----------------------
- -- Lock_Free_Read_8 --
- ----------------------
+ --------------------
+ -- Lock_Free_Read --
+ --------------------
- function Lock_Free_Read_8 (Ptr : Address) return uint8 is
- begin
- if uint8'Atomic_Always_Lock_Free then
- return Atomic_Load_8 (Ptr, Acquire);
- else
- raise Program_Error;
- end if;
- end Lock_Free_Read_8;
-
- -----------------------
- -- Lock_Free_Read_16 --
- -----------------------
+ function Lock_Free_Read (Ptr : Address) return Atomic_Type is
+ function My_Atomic_Load is new Atomic_Load (Atomic_Type);
- function Lock_Free_Read_16 (Ptr : Address) return uint16 is
begin
- if uint16'Atomic_Always_Lock_Free then
- return Atomic_Load_16 (Ptr, Acquire);
+ if Atomic_Type'Atomic_Always_Lock_Free then
+ return My_Atomic_Load (Ptr, Acquire);
else
raise Program_Error;
end if;
- end Lock_Free_Read_16;
+ end Lock_Free_Read;
- -----------------------
- -- Lock_Free_Read_32 --
- -----------------------
-
- function Lock_Free_Read_32 (Ptr : Address) return uint32 is
- begin
- if uint32'Atomic_Always_Lock_Free then
- return Atomic_Load_32 (Ptr, Acquire);
- else
- raise Program_Error;
- end if;
- end Lock_Free_Read_32;
+ -------------------------
+ -- Lock_Free_Try_Write --
+ -------------------------
- -----------------------
- -- Lock_Free_Read_64 --
- -----------------------
-
- function Lock_Free_Read_64 (Ptr : Address) return uint64 is
- begin
- if uint64'Atomic_Always_Lock_Free then
- return Atomic_Load_64 (Ptr, Acquire);
- else
- raise Program_Error;
- end if;
- end Lock_Free_Read_64;
-
- ---------------------------
- -- Lock_Free_Try_Write_8 --
- ---------------------------
-
- function Lock_Free_Try_Write_8
+ function Lock_Free_Try_Write
(Ptr : Address;
- Expected : in out uint8;
- Desired : uint8) return Boolean
+ Expected : in out Atomic_Type;
+ Desired : Atomic_Type) return Boolean
is
- Actual : uint8;
+ function My_Sync_Compare_And_Swap is
+ new Sync_Compare_And_Swap (Atomic_Type);
- begin
- if Expected /= Desired then
-
- if uint8'Atomic_Always_Lock_Free then
- Actual := Sync_Compare_And_Swap_8 (Ptr, Expected, Desired);
- else
- raise Program_Error;
- end if;
-
- if Actual /= Expected then
- Expected := Actual;
- return False;
- end if;
- end if;
-
- return True;
- end Lock_Free_Try_Write_8;
-
- ----------------------------
- -- Lock_Free_Try_Write_16 --
- ----------------------------
-
- function Lock_Free_Try_Write_16
- (Ptr : Address;
- Expected : in out uint16;
- Desired : uint16) return Boolean
- is
- Actual : uint16;
+ Actual : Atomic_Type;
begin
if Expected /= Desired then
-
- if uint16'Atomic_Always_Lock_Free then
- Actual := Sync_Compare_And_Swap_16 (Ptr, Expected, Desired);
+ if Atomic_Type'Atomic_Always_Lock_Free then
+ Actual := My_Sync_Compare_And_Swap (Ptr, Expected, Desired);
else
raise Program_Error;
end if;
@@ -139,63 +75,6 @@ package body System.Atomic_Primitives is
end if;
return True;
- end Lock_Free_Try_Write_16;
-
- ----------------------------
- -- Lock_Free_Try_Write_32 --
- ----------------------------
+ end Lock_Free_Try_Write;
- function Lock_Free_Try_Write_32
- (Ptr : Address;
- Expected : in out uint32;
- Desired : uint32) return Boolean
- is
- Actual : uint32;
-
- begin
- if Expected /= Desired then
-
- if uint32'Atomic_Always_Lock_Free then
- Actual := Sync_Compare_And_Swap_32 (Ptr, Expected, Desired);
- else
- raise Program_Error;
- end if;
-
- if Actual /= Expected then
- Expected := Actual;
- return False;
- end if;
- end if;
-
- return True;
- end Lock_Free_Try_Write_32;
-
- ----------------------------
- -- Lock_Free_Try_Write_64 --
- ----------------------------
-
- function Lock_Free_Try_Write_64
- (Ptr : Address;
- Expected : in out uint64;
- Desired : uint64) return Boolean
- is
- Actual : uint64;
-
- begin
- if Expected /= Desired then
-
- if uint64'Atomic_Always_Lock_Free then
- Actual := Sync_Compare_And_Swap_64 (Ptr, Expected, Desired);
- else
- raise Program_Error;
- end if;
-
- if Actual /= Expected then
- Expected := Actual;
- return False;
- end if;
- end if;
-
- return True;
- end Lock_Free_Try_Write_64;
end System.Atomic_Primitives;
diff --git a/gcc/ada/libgnat/s-atopri.ads b/gcc/ada/libgnat/s-atopri.ads
index 891b2edf061..ea03f1a7d50 100644
--- a/gcc/ada/libgnat/s-atopri.ads
+++ b/gcc/ada/libgnat/s-atopri.ads
@@ -29,7 +29,7 @@
-- --
------------------------------------------------------------------------------
--- This package contains both atomic primitives defined from gcc built-in
+-- This package contains both atomic primitives defined from GCC built-in
-- functions and operations used by the compiler to generate the lock-free
-- implementation of protected objects.
@@ -66,71 +66,31 @@ package System.Atomic_Primitives is
-- GCC built-in atomic primitives --
------------------------------------
- function Atomic_Load_8
+ generic
+ type Atomic_Type is mod <>;
+ function Atomic_Load
(Ptr : Address;
- Model : Mem_Model := Seq_Cst) return uint8;
- pragma Import (Intrinsic, Atomic_Load_8, "__atomic_load_1");
+ Model : Mem_Model := Seq_Cst) return Atomic_Type;
+ pragma Import (Intrinsic, Atomic_Load, "__atomic_load_n");
- function Atomic_Load_16
- (Ptr : Address;
- Model : Mem_Model := Seq_Cst) return uint16;
- pragma Import (Intrinsic, Atomic_Load_16, "__atomic_load_2");
-
- function Atomic_Load_32
- (Ptr : Address;
- Model : Mem_Model := Seq_Cst) return uint32;
- pragma Import (Intrinsic, Atomic_Load_32, "__atomic_load_4");
-
- function Atomic_Load_64
- (Ptr : Address;
- Model : Mem_Model := Seq_Cst) return uint64;
- pragma Import (Intrinsic, Atomic_Load_64, "__atomic_load_8");
-
- function Sync_Compare_And_Swap_8
- (Ptr : Address;
- Expected : uint8;
- Desired : uint8) return uint8;
- pragma Import (Intrinsic,
- Sync_Compare_And_Swap_8,
- "__sync_val_compare_and_swap_1");
-
- function Sync_Compare_And_Swap_16
- (Ptr : Address;
- Expected : uint16;
- Desired : uint16) return uint16;
- pragma Import (Intrinsic,
- Sync_Compare_And_Swap_16,
- "__sync_val_compare_and_swap_2");
+ function Atomic_Load_8 is new Atomic_Load (uint8);
+ function Atomic_Load_16 is new Atomic_Load (uint16);
+ function Atomic_Load_32 is new Atomic_Load (uint32);
+ function Atomic_Load_64 is new Atomic_Load (uint64);
- function Sync_Compare_And_Swap_32
+ generic
+ type Atomic_Type is mod <>;
+ function Sync_Compare_And_Swap
(Ptr : Address;
- Expected : uint32;
- Desired : uint32) return uint32;
- pragma Import (Intrinsic,
- Sync_Compare_And_Swap_32,
- "__sync_val_compare_and_swap_4");
+ Expected : Atomic_Type;
+ Desired : Atomic_Type) return Atomic_Type;
+ pragma Import
+ (Intrinsic, Sync_Compare_And_Swap, "__sync_val_compare_and_swap");
- function Sync_Compare_And_Swap_64
- (Ptr : Address;
- Expected : uint64;
- Desired : uint64) return uint64;
- pragma Import (Intrinsic,
- Sync_Compare_And_Swap_64,
- "__sync_val_compare_and_swap_8");
-
- -- ??? We might want to switch to the __atomic series of builtins for
- -- compare-and-swap operations at some point.
-
- -- function Atomic_Compare_Exchange_8
- -- (Ptr : Address;
- -- Expected : Address;
- -- Desired : uint8;
- -- Weak : Boolean := False;
- -- Success_Model : Mem_Model := Seq_Cst;
- -- Failure_Model : Mem_Model := Seq_Cst) return Boolean;
- -- pragma Import (Intrinsic,
- -- Atomic_Compare_Exchange_8,
- -- "__atomic_compare_exchange_1");
+ function Sync_Compare_And_Swap_8 is new Sync_Compare_And_Swap (uint8);
+ function Sync_Compare_And_Swap_16 is new Sync_Compare_And_Swap (uint16);
+ function Sync_Compare_And_Swap_32 is new Sync_Compare_And_Swap (uint32);
+ function Sync_Compare_And_Swap_64 is new Sync_Compare_And_Swap (uint64);
function Atomic_Test_And_Set
(Ptr : System.Address;
@@ -155,46 +115,37 @@ package System.Atomic_Primitives is
-- The lock-free implementation uses two atomic instructions for the
-- expansion of protected operations:
- -- * Lock_Free_Read_N atomically loads the value of the protected component
- -- accessed by the current protected operation.
-
- -- * Lock_Free_Try_Write_N tries to write the Desired value into Ptr only
- -- if Expected and Desired mismatch.
+ -- * Lock_Free_Read atomically loads the value contained in Ptr (with the
+ -- Acquire synchronization mode).
- function Lock_Free_Read_8 (Ptr : Address) return uint8;
+ -- * Lock_Free_Try_Write atomically tries to write the Desired value into
+ -- Ptr if Ptr contains the Expected value. It returns true if the value
+ -- in Ptr was changed, or False if it was not, in which case Expected is
+ -- updated to the unexpected value in Ptr. Note that it does nothing and
+ -- returns true if Desired and Expected are equal.
- function Lock_Free_Read_16 (Ptr : Address) return uint16;
+ generic
+ type Atomic_Type is mod <>;
+ function Lock_Free_Read (Ptr : Address) return Atomic_Type;
- function Lock_Free_Read_32 (Ptr : Address) return uint32;
+ function Lock_Free_Read_8 is new Lock_Free_Read (uint8);
+ function Lock_Free_Read_16 is new Lock_Free_Read (uint16);
+ function Lock_Free_Read_32 is new Lock_Free_Read (uint32);
+ function Lock_Free_Read_64 is new Lock_Free_Read (uint64);
- function Lock_Free_Read_64 (Ptr : Address) return uint64;
-
- function Lock_Free_Try_Write_8
- (Ptr : Address;
- Expected : in out uint8;
- Desired : uint8) return Boolean;
-
- function Lock_Free_Try_Write_16
- (Ptr : Address;
- Expected : in out uint16;
- Desired : uint16) return Boolean;
-
- function Lock_Free_Try_Write_32
- (Ptr : Address;
- Expected : in out uint32;
- Desired : uint32) return Boolean;
+ generic
+ type Atomic_Type is mod <>;
+ function Lock_Free_Try_Write
+ (Ptr : Address;
+ Expected : in out Atomic_Type;
+ Desired : Atomic_Type) return Boolean;
- function Lock_Free_Try_Write_64
- (Ptr : Address;
- Expected : in out uint64;
- Desired : uint64) return Boolean;
+ function Lock_Free_Try_Write_8 is new Lock_Free_Try_Write (uint8);
+ function Lock_Free_Try_Write_16 is new Lock_Free_Try_Write (uint16);
+ function Lock_Free_Try_Write_32 is new Lock_Free_Try_Write (uint32);
+ function Lock_Free_Try_Write_64 is new Lock_Free_Try_Write (uint64);
- pragma Inline (Lock_Free_Read_8);
- pragma Inline (Lock_Free_Read_16);
- pragma Inline (Lock_Free_Read_32);
- pragma Inline (Lock_Free_Read_64);
- pragma Inline (Lock_Free_Try_Write_8);
- pragma Inline (Lock_Free_Try_Write_16);
- pragma Inline (Lock_Free_Try_Write_32);
- pragma Inline (Lock_Free_Try_Write_64);
+private
+ pragma Inline (Lock_Free_Read);
+ pragma Inline (Lock_Free_Try_Write);
end System.Atomic_Primitives;
diff --git a/gcc/ada/sem_ch12.adb b/gcc/ada/sem_ch12.adb
index e4cb7e3229c..54406e9bbc5 100644
--- a/gcc/ada/sem_ch12.adb
+++ b/gcc/ada/sem_ch12.adb
@@ -5802,6 +5802,7 @@ package body Sem_Ch12 is
if Is_Intrinsic_Subprogram (Gen_Unit) then
Set_Is_Intrinsic_Subprogram (Anon_Id);
+ Set_Interface_Name (Anon_Id, Interface_Name (Gen_Unit));
end if;
Analyze_Instance_And_Renamings;
@@ -5818,14 +5819,13 @@ package body Sem_Ch12 is
end if;
-- If the generic is marked Import (Intrinsic), then so is the
- -- instance. This indicates that there is no body to instantiate. If
- -- generic is marked inline, so it the instance, and the anonymous
- -- subprogram it renames. If inlined, or else if inlining is enabled
- -- for the compilation, we generate the instance body even if it is
- -- not within the main unit.
+ -- instance; this indicates that there is no body to instantiate.
+ -- We also copy the interface name in case this is handled by the
+ -- back-end and deal with an instance of unchecked conversion.
if Is_Intrinsic_Subprogram (Gen_Unit) then
Set_Is_Intrinsic_Subprogram (Act_Decl_Id);
+ Set_Interface_Name (Act_Decl_Id, Interface_Name (Gen_Unit));
if Chars (Gen_Unit) = Name_Unchecked_Conversion then
Validate_Unchecked_Conversion (N, Act_Decl_Id);
^ permalink raw reply [flat|nested] only message in thread
only message in thread, other threads:[~2021-10-20 10:17 UTC | newest]
Thread overview: (only message) (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
2021-10-20 10:17 [gcc r12-4539] [Ada] Expose and use type-generic GCC atomic builtins Pierre-Marie de Rodat
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).