Skip to content

R
riscv-gcc-1
Commit 019c74bb by Arnaud Charlet Committed by Pierre-Marie de Rodat
Options

[Ada] AI12-0234/321 atomic operations 

2019-12-16  Arnaud Charlet  <charlet@adacore.com>

gcc/ada/

	* libgnat/s-aotase.adb, libgnat/s-aotase.ads,
	libgnat/s-atoope.ads, libgnat/s-atopar.adb,
	libgnat/s-atopar.ads, libgnat/s-atopex.adb,
	libgnat/s-atopex.ads: New files.
	* libgnat/s-atopri.ads: Add new intrinsics.
	* Makefile.rtl: Add new runtime files.
	* impunit.adb: Add new units to Ada 2020 list.

From-SVN: r279434
parent 1dcdd961
Showing with 620 additions and 2 deletions
gcc/ada/ChangeLog
2019-12-16 Arnaud Charlet <charlet@adacore.com>
* libgnat/s-aotase.adb, libgnat/s-aotase.ads,
libgnat/s-atoope.ads, libgnat/s-atopar.adb,
libgnat/s-atopar.ads, libgnat/s-atopex.adb,
libgnat/s-atopex.ads: New files.
* libgnat/s-atopri.ads: Add new intrinsics.
* Makefile.rtl: Add new runtime files.
* impunit.adb: Add new units to Ada 2020 list.
2019-12-16 Eric Botcazou <ebotcazou@adacore.com>
* freeze.adb (Check_Strict_Alignment): Remove new check on
......
gcc/ada/Makefile.rtl
......@@ -498,10 +498,14 @@ GNATRTL_NONTASKING_OBJS= \
machcode$(objext) \
s-addima$(objext) \
s-addope$(objext) \
s-aotase$(objext) \
s-arit64$(objext) \
s-assert$(objext) \
s-atacco$(objext) \
s-atocou$(objext) \
s-atoope$(objext) \
s-atopar$(objext) \
s-atopex$(objext) \
s-atopri$(objext) \
s-auxdec$(objext) \
s-bignum$(objext) \
......
gcc/ada/impunit.adb
......@@ -623,7 +623,11 @@ package body Impunit is
("a-stteou", T), -- Ada.Strings.Text_Output
("a-nubinu", T), -- Ada.Numerics.Big_Numbers
("a-nbnbin", T), -- Ada.Numerics.Big_Numbers.Big_Integers
("a-nbnbre", T)); -- Ada.Numerics.Big_Numbers.Big_Reals
("a-nbnbre", T), -- Ada.Numerics.Big_Numbers.Big_Reals
("s-aotase", T), -- System.Atomic_Operations.Test_And_Set
("s-atoope", T), -- System.Atomic_Operations
("s-atopar", T), -- System.Atomic_Operations.Arithmetic
("s-atopex", T)); -- System.Atomic_Operations.Exchange
-----------------------
-- Alternative Units --
......
gcc/ada/libgnat/s-aotase.adb 0 → 100644
------------------------------------------------------------------------------
-- --
-- GNAT RUN-TIME COMPONENTS --
-- --
-- System.Atomic_Operations.Test_And_Set --
-- --
-- B o d y --
-- --
-- Copyright (C) 2019, Free Software Foundation, Inc. --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
-- ware Foundation; either version 3, or (at your option) any later ver- --
-- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
-- or FITNESS FOR A PARTICULAR PURPOSE. --
-- --
-- As a special exception under Section 7 of GPL version 3, you are granted --
-- additional permissions described in the GCC Runtime Library Exception, --
-- version 3.1, as published by the Free Software Foundation. --
-- --
-- You should have received a copy of the GNU General Public License and --
-- a copy of the GCC Runtime Library Exception along with this program; --
-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
-- <http://www.gnu.org/licenses/>. --
-- --
-- GNAT was originally developed by the GNAT team at New York University. --
-- Extensive contributions were provided by Ada Core Technologies Inc. --
-- --
------------------------------------------------------------------------------
with System.Atomic_Primitives; use System.Atomic_Primitives;
package body System.Atomic_Operations.Test_And_Set is
-------------------------
-- Atomic_Test_And_Set --
-------------------------
function Atomic_Test_And_Set
(Item : aliased in out Test_And_Set_Flag) return Boolean is
begin
return Boolean (Atomic_Test_And_Set (Item'Address));
end Atomic_Test_And_Set;
------------------
-- Atomic_Clear --
------------------
procedure Atomic_Clear
(Item : aliased in out Test_And_Set_Flag) is
begin
Atomic_Clear (Item'Address);
end Atomic_Clear;
------------------
-- Is_Lock_Free --
------------------
function Is_Lock_Free (Item : aliased Test_And_Set_Flag) return Boolean is
pragma Unreferenced (Item);
begin
return True;
end Is_Lock_Free;
end System.Atomic_Operations.Test_And_Set;
gcc/ada/libgnat/s-aotase.ads 0 → 100644
------------------------------------------------------------------------------
-- --
-- GNAT RUN-TIME COMPONENTS --
-- --
-- System.Atomic_Operations.Test_And_Set --
-- --
-- S p e c --
-- --
-- Copyright (C) 2019, Free Software Foundation, Inc. --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
-- ware Foundation; either version 3, or (at your option) any later ver- --
-- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
-- or FITNESS FOR A PARTICULAR PURPOSE. --
-- --
-- As a special exception under Section 7 of GPL version 3, you are granted --
-- additional permissions described in the GCC Runtime Library Exception, --
-- version 3.1, as published by the Free Software Foundation. --
-- --
-- You should have received a copy of the GNU General Public License and --
-- a copy of the GCC Runtime Library Exception along with this program; --
-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
-- <http://www.gnu.org/licenses/>. --
-- --
-- GNAT was originally developed by the GNAT team at New York University. --
-- Extensive contributions were provided by Ada Core Technologies Inc. --
-- --
------------------------------------------------------------------------------
package System.Atomic_Operations.Test_And_Set
with Pure
-- Nonblocking
is
type Test_And_Set_Flag is mod 2 ** 8
with Atomic, Default_Value => 0, Size => 8;
function Atomic_Test_And_Set
(Item : aliased in out Test_And_Set_Flag) return Boolean
with Convention => Intrinsic;
procedure Atomic_Clear
(Item : aliased in out Test_And_Set_Flag)
with Convention => Intrinsic;
function Is_Lock_Free
(Item : aliased Test_And_Set_Flag) return Boolean
with Convention => Intrinsic;
private
pragma Inline_Always (Atomic_Test_And_Set);
pragma Inline_Always (Atomic_Clear);
pragma Inline_Always (Is_Lock_Free);
end System.Atomic_Operations.Test_And_Set;
gcc/ada/libgnat/s-atoope.ads 0 → 100644
------------------------------------------------------------------------------
-- --
-- GNAT RUN-TIME COMPONENTS --
-- --
-- S Y S T E M . A T O M I C _ O P E R A T I O N S --
-- --
-- S p e c --
-- --
-- Copyright (C) 2019, Free Software Foundation, Inc. --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
-- ware Foundation; either version 3, or (at your option) any later ver- --
-- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
-- or FITNESS FOR A PARTICULAR PURPOSE. --
-- --
-- As a special exception under Section 7 of GPL version 3, you are granted --
-- additional permissions described in the GCC Runtime Library Exception, --
-- version 3.1, as published by the Free Software Foundation. --
-- --
-- You should have received a copy of the GNU General Public License and --
-- a copy of the GCC Runtime Library Exception along with this program; --
-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
-- <http://www.gnu.org/licenses/>. --
-- --
-- GNAT was originally developed by the GNAT team at New York University. --
-- Extensive contributions were provided by Ada Core Technologies Inc. --
-- --
------------------------------------------------------------------------------
package System.Atomic_Operations
with Pure
is
end System.Atomic_Operations;
gcc/ada/libgnat/s-atopar.adb 0 → 100644
------------------------------------------------------------------------------
-- --
-- GNAT RUN-TIME COMPONENTS --
-- --
-- System.Atomic_Operations.Arithmetic --
-- --
-- B o d y --
-- --
-- Copyright (C) 2019, Free Software Foundation, Inc. --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
-- ware Foundation; either version 3, or (at your option) any later ver- --
-- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
-- or FITNESS FOR A PARTICULAR PURPOSE. --
-- --
-- As a special exception under Section 7 of GPL version 3, you are granted --
-- additional permissions described in the GCC Runtime Library Exception, --
-- version 3.1, as published by the Free Software Foundation. --
-- --
-- You should have received a copy of the GNU General Public License and --
-- a copy of the GCC Runtime Library Exception along with this program; --
-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
-- <http://www.gnu.org/licenses/>. --
-- --
-- GNAT was originally developed by the GNAT team at New York University. --
-- Extensive contributions were provided by Ada Core Technologies Inc. --
-- --
------------------------------------------------------------------------------
with System.Atomic_Primitives; use System.Atomic_Primitives;
with Interfaces.C;
package body System.Atomic_Operations.Arithmetic is
----------------
-- Atomic_Add --
----------------
procedure Atomic_Add
(Item : aliased in out Atomic_Type;
Value : Atomic_Type)
is
Ignore : constant Atomic_Type := Atomic_Fetch_And_Add (Item, Value);
begin
null;
end Atomic_Add;
---------------------
-- Atomic_Subtract --
---------------------
procedure Atomic_Subtract
(Item : aliased in out Atomic_Type;
Value : Atomic_Type)
is
Ignore : constant Atomic_Type := Atomic_Fetch_And_Subtract (Item, Value);
begin
null;
end Atomic_Subtract;
--------------------------
-- Atomic_Fetch_And_Add --
--------------------------
function Atomic_Fetch_And_Add
(Item : aliased in out Atomic_Type;
Value : Atomic_Type) return Atomic_Type
is
pragma Warnings (Off);
function Atomic_Fetch_Add_1
(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 Warnings (On);
begin
case Item'Size is
when 8 => return Atomic_Fetch_Add_1 (Item'Address, Value);
when 16 => return Atomic_Fetch_Add_2 (Item'Address, Value);
when 32 => return Atomic_Fetch_Add_4 (Item'Address, Value);
when 64 => return Atomic_Fetch_Add_8 (Item'Address, Value);
when others => raise Program_Error;
end case;
end Atomic_Fetch_And_Add;
-------------------------------
-- Atomic_Fetch_And_Subtract --
-------------------------------
function Atomic_Fetch_And_Subtract
(Item : aliased in out Atomic_Type;
Value : Atomic_Type) return Atomic_Type
is
pragma Warnings (Off);
function Atomic_Fetch_Sub_1
(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 Warnings (On);
begin
case Item'Size is
when 8 => return Atomic_Fetch_Sub_1 (Item'Address, Value);
when 16 => return Atomic_Fetch_Sub_2 (Item'Address, Value);
when 32 => return Atomic_Fetch_Sub_4 (Item'Address, Value);
when 64 => return Atomic_Fetch_Sub_8 (Item'Address, Value);
when others => raise Program_Error;
end case;
end Atomic_Fetch_And_Subtract;
------------------
-- Is_Lock_Free --
------------------
function Is_Lock_Free (Item : aliased Atomic_Type) return Boolean is
use type Interfaces.C.size_t;
begin
return Boolean (Atomic_Always_Lock_Free (Item'Size / 8));
end Is_Lock_Free;
end System.Atomic_Operations.Arithmetic;
gcc/ada/libgnat/s-atopar.ads 0 → 100644
------------------------------------------------------------------------------
-- --
-- GNAT RUN-TIME COMPONENTS --
-- --
-- System.Atomic_Operations.Arithmetic --
-- --
-- S p e c --
-- --
-- Copyright (C) 2019, Free Software Foundation, Inc. --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
-- ware Foundation; either version 3, or (at your option) any later ver- --
-- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
-- or FITNESS FOR A PARTICULAR PURPOSE. --
-- --
-- As a special exception under Section 7 of GPL version 3, you are granted --
-- additional permissions described in the GCC Runtime Library Exception, --
-- version 3.1, as published by the Free Software Foundation. --
-- --
-- You should have received a copy of the GNU General Public License and --
-- a copy of the GCC Runtime Library Exception along with this program; --
-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
-- <http://www.gnu.org/licenses/>. --
-- --
-- GNAT was originally developed by the GNAT team at New York University. --
-- Extensive contributions were provided by Ada Core Technologies Inc. --
-- --
------------------------------------------------------------------------------
generic
type Atomic_Type is range <>; -- ??? with Atomic;
package System.Atomic_Operations.Arithmetic
with Pure
-- Nonblocking
is
procedure Atomic_Add
(Item : aliased in out Atomic_Type;
Value : Atomic_Type) with Convention => Intrinsic;
procedure Atomic_Subtract
(Item : aliased in out Atomic_Type;
Value : Atomic_Type) with Convention => Intrinsic;
function Atomic_Fetch_And_Add
(Item : aliased in out Atomic_Type;
Value : Atomic_Type) return Atomic_Type with Convention => Intrinsic;
function Atomic_Fetch_And_Subtract
(Item : aliased in out Atomic_Type;
Value : Atomic_Type) return Atomic_Type with Convention => Intrinsic;
function Is_Lock_Free
(Item : aliased Atomic_Type) return Boolean with Convention => Intrinsic;
private
pragma Inline_Always (Atomic_Add);
pragma Inline_Always (Atomic_Subtract);
pragma Inline_Always (Atomic_Fetch_And_Add);
pragma Inline_Always (Atomic_Fetch_And_Subtract);
pragma Inline_Always (Is_Lock_Free);
end System.Atomic_Operations.Arithmetic;
gcc/ada/libgnat/s-atopex.adb 0 → 100644
------------------------------------------------------------------------------
-- --
-- GNAT RUN-TIME COMPONENTS --
-- --
-- System.Atomic_Operations.Exchange --
-- --
-- B o d y --
-- --
-- Copyright (C) 2019, Free Software Foundation, Inc. --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
-- ware Foundation; either version 3, or (at your option) any later ver- --
-- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
-- or FITNESS FOR A PARTICULAR PURPOSE. --
-- --
-- As a special exception under Section 7 of GPL version 3, you are granted --
-- additional permissions described in the GCC Runtime Library Exception, --
-- version 3.1, as published by the Free Software Foundation. --
-- --
-- You should have received a copy of the GNU General Public License and --
-- a copy of the GCC Runtime Library Exception along with this program; --
-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
-- <http://www.gnu.org/licenses/>. --
-- --
-- GNAT was originally developed by the GNAT team at New York University. --
-- Extensive contributions were provided by Ada Core Technologies Inc. --
-- --
------------------------------------------------------------------------------
with System.Atomic_Primitives; use System.Atomic_Primitives;
with Interfaces.C;
package body System.Atomic_Operations.Exchange is
---------------------
-- Atomic_Exchange --
---------------------
function Atomic_Exchange
(Item : aliased in out Atomic_Type;
Value : Atomic_Type) return Atomic_Type
is
pragma Warnings (Off);
function Atomic_Exchange_1
(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 Warnings (On);
begin
case Item'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;
end Atomic_Exchange;
---------------------------------
-- Atomic_Compare_And_Exchange --
---------------------------------
function Atomic_Compare_And_Exchange
(Item : aliased in out Atomic_Type;
Prior : aliased in out Atomic_Type;
Desired : Atomic_Type) return Boolean
is
pragma Warnings (Off);
function Atomic_Compare_Exchange_1
(Ptr : System.Address;
Expected : System.Address;
Desired : Atomic_Type;
Weak : bool := False;
Success_Model : Mem_Model := Seq_Cst;
Failure_Model : Mem_Model := Seq_Cst) return bool;
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 : bool := False;
Success_Model : Mem_Model := Seq_Cst;
Failure_Model : Mem_Model := Seq_Cst) return bool;
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 : bool := False;
Success_Model : Mem_Model := Seq_Cst;
Failure_Model : Mem_Model := Seq_Cst) return bool;
pragma Import
(Intrinsic, Atomic_Compare_Exchange_4, "__atomic_compare_exchange_4");
function Atomic_Compare_Exchange_8
(Ptr : System.Address;
Expected : System.Address;
Desired : Atomic_Type;
Weak : bool := False;
Success_Model : Mem_Model := Seq_Cst;
Failure_Model : Mem_Model := Seq_Cst) return bool;
pragma Import
(Intrinsic, Atomic_Compare_Exchange_8, "__atomic_compare_exchange_8");
pragma Warnings (On);
begin
case Item'Size is
when 8 =>
return Boolean
(Atomic_Compare_Exchange_1
(Item'Address, Prior'Address, Desired));
when 16 =>
return Boolean
(Atomic_Compare_Exchange_2
(Item'Address, Prior'Address, Desired));
when 32 =>
return Boolean
(Atomic_Compare_Exchange_4
(Item'Address, Prior'Address, Desired));
when 64 =>
return Boolean
(Atomic_Compare_Exchange_8
(Item'Address, Prior'Address, Desired));
when others =>
raise Program_Error;
end case;
end Atomic_Compare_And_Exchange;
------------------
-- Is_Lock_Free --
------------------
function Is_Lock_Free (Item : aliased Atomic_Type) return Boolean is
use type Interfaces.C.size_t;
begin
return Boolean (Atomic_Always_Lock_Free (Item'Size / 8));
end Is_Lock_Free;
end System.Atomic_Operations.Exchange;
gcc/ada/libgnat/s-atopex.ads 0 → 100644
------------------------------------------------------------------------------
-- --
-- GNAT RUN-TIME COMPONENTS --
-- --
-- System.Atomic_Operations.Exchange --
-- --
-- S p e c --
-- --
-- Copyright (C) 2019, Free Software Foundation, Inc. --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
-- ware Foundation; either version 3, or (at your option) any later ver- --
-- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
-- or FITNESS FOR A PARTICULAR PURPOSE. --
-- --
-- As a special exception under Section 7 of GPL version 3, you are granted --
-- additional permissions described in the GCC Runtime Library Exception, --
-- version 3.1, as published by the Free Software Foundation. --
-- --
-- You should have received a copy of the GNU General Public License and --
-- a copy of the GCC Runtime Library Exception along with this program; --
-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
-- <http://www.gnu.org/licenses/>. --
-- --
-- GNAT was originally developed by the GNAT team at New York University. --
-- Extensive contributions were provided by Ada Core Technologies Inc. --
-- --
------------------------------------------------------------------------------
generic
type Atomic_Type is private; -- with Atomic;
package System.Atomic_Operations.Exchange
with Pure
-- Blocking
is
function Atomic_Exchange
(Item : aliased in out Atomic_Type;
Value : Atomic_Type) return Atomic_Type with Convention => Intrinsic;
function Atomic_Compare_And_Exchange
(Item : aliased in out Atomic_Type;
Prior : aliased in out Atomic_Type;
Desired : Atomic_Type) return Boolean with Convention => Intrinsic;
function Is_Lock_Free
(Item : aliased Atomic_Type) return Boolean with Convention => Intrinsic;
private
pragma Inline_Always (Atomic_Exchange);
pragma Inline_Always (Atomic_Compare_And_Exchange);
pragma Inline_Always (Is_Lock_Free);
end System.Atomic_Operations.Exchange;
gcc/ada/libgnat/s-atopri.ads
......@@ -33,8 +33,10 @@
-- functions and operations used by the compiler to generate the lock-free
-- implementation of protected objects.
with Interfaces.C;
package System.Atomic_Primitives is
pragma Preelaborate;
pragma Pure;
type uint is mod 2 ** Long_Integer'Size;
......@@ -60,6 +62,9 @@ package System.Atomic_Primitives is
subtype Mem_Model is Integer range Relaxed .. Last;
type bool is new Boolean;
pragma Convention (C, bool);
------------------------------------
-- GCC built-in atomic primitives --
------------------------------------
......@@ -130,6 +135,22 @@ package System.Atomic_Primitives is
-- Atomic_Compare_Exchange_8,
-- "__atomic_compare_exchange_1");
function Atomic_Test_And_Set
(Ptr : System.Address;
Model : Mem_Model := Seq_Cst) return bool;
pragma Import (Intrinsic, Atomic_Test_And_Set, "__atomic_test_and_set");
procedure Atomic_Clear
(Ptr : System.Address;
Model : Mem_Model := Seq_Cst);
pragma Import (Intrinsic, Atomic_Clear, "__atomic_clear");
function Atomic_Always_Lock_Free
(Size : Interfaces.C.size_t;
Ptr : System.Address := System.Null_Address) return bool;
pragma Import
(Intrinsic, Atomic_Always_Lock_Free, "__atomic_always_lock_free");
--------------------------
-- Lock-free operations --
--------------------------
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment