+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
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) \
("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 --
--- /dev/null
+------------------------------------------------------------------------------
+-- --
+-- 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;
--- /dev/null
+------------------------------------------------------------------------------
+-- --
+-- 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;
--- /dev/null
+------------------------------------------------------------------------------
+-- --
+-- 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;
--- /dev/null
+------------------------------------------------------------------------------
+-- --
+-- 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;
--- /dev/null
+------------------------------------------------------------------------------
+-- --
+-- 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;
--- /dev/null
+------------------------------------------------------------------------------
+-- --
+-- 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;
--- /dev/null
+------------------------------------------------------------------------------
+-- --
+-- 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;
-- 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;
subtype Mem_Model is Integer range Relaxed .. Last;
+ type bool is new Boolean;
+ pragma Convention (C, bool);
+
------------------------------------
-- GCC built-in atomic primitives --
------------------------------------
-- 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 --
--------------------------
projects / gcc.git / commitdiff