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
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;
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
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;
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;
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;
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;
---------------------------------
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;
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;
------------------
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;
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;
-- --
------------------------------------------------------------------------------
--- 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.
-- 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;
-- 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;
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;
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);
projects / thirdparty / gcc.git / commitdiff
