1------------------------------------------------------------------------------
2--                                                                          --
3--                         GNAT RUN-TIME COMPONENTS                         --
4--                                                                          --
5--                    System.Atomic_Operations.Exchange                     --
6--                                                                          --
7--                                 B o d y                                  --
8--                                                                          --
9--                 Copyright (C) 2019-2021, Free Software Foundation, Inc.  --
10--                                                                          --
11-- GNAT is free software;  you can  redistribute it  and/or modify it under --
12-- terms of the  GNU General Public License as published  by the Free Soft- --
13-- ware  Foundation;  either version 3,  or (at your option) any later ver- --
14-- sion.  GNAT is distributed in the hope that it will be useful, but WITH- --
15-- OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY --
16-- or FITNESS FOR A PARTICULAR PURPOSE.                                     --
17--                                                                          --
18-- As a special exception under Section 7 of GPL version 3, you are granted --
19-- additional permissions described in the GCC Runtime Library Exception,   --
20-- version 3.1, as published by the Free Software Foundation.               --
21--                                                                          --
22-- You should have received a copy of the GNU General Public License and    --
23-- a copy of the GCC Runtime Library Exception along with this program;     --
24-- see the files COPYING3 and COPYING.RUNTIME respectively.  If not, see    --
25-- <http://www.gnu.org/licenses/>.                                          --
26--                                                                          --
27-- GNAT was originally developed  by the GNAT team at  New York University. --
28-- Extensive contributions were provided by Ada Core Technologies Inc.      --
29--                                                                          --
30------------------------------------------------------------------------------
31
32with System.Atomic_Primitives; use System.Atomic_Primitives;
33with Interfaces.C;
34
35package body System.Atomic_Operations.Exchange is
36
37   ---------------------
38   -- Atomic_Exchange --
39   ---------------------
40
41   function Atomic_Exchange
42     (Item  : aliased in out Atomic_Type;
43      Value : Atomic_Type) return Atomic_Type
44   is
45      pragma Warnings (Off);
46      function Atomic_Exchange
47        (Ptr   : System.Address;
48         Val   : Atomic_Type;
49         Model : Mem_Model := Seq_Cst) return Atomic_Type;
50      pragma Import (Intrinsic, Atomic_Exchange, "__atomic_exchange_n");
51      pragma Warnings (On);
52
53   begin
54      if Atomic_Type'Object_Size in 8 | 16 | 32 | 64 then
55         return Atomic_Exchange (Item'Address, Value);
56      else
57         raise Program_Error;
58      end if;
59   end Atomic_Exchange;
60
61   ---------------------------------
62   -- Atomic_Compare_And_Exchange --
63   ---------------------------------
64
65   function Atomic_Compare_And_Exchange
66     (Item    : aliased in out Atomic_Type;
67      Prior   : aliased in out Atomic_Type;
68      Desired : Atomic_Type) return Boolean
69   is
70      pragma Warnings (Off);
71      function Atomic_Compare_Exchange
72        (Ptr           : System.Address;
73         Expected      : System.Address;
74         Desired       : Atomic_Type;
75         Weak          : Boolean := False;
76         Success_Model : Mem_Model := Seq_Cst;
77         Failure_Model : Mem_Model := Seq_Cst) return Boolean;
78      pragma Import
79        (Intrinsic, Atomic_Compare_Exchange, "__atomic_compare_exchange_n");
80      pragma Warnings (On);
81
82   begin
83      if Atomic_Type'Object_Size in 8 | 16 | 32 | 64 then
84         return Atomic_Compare_Exchange (Item'Address, Prior'Address, Desired);
85      else
86         raise Program_Error;
87      end if;
88   end Atomic_Compare_And_Exchange;
89
90   ------------------
91   -- Is_Lock_Free --
92   ------------------
93
94   function Is_Lock_Free (Item : aliased Atomic_Type) return Boolean is
95      pragma Unreferenced (Item);
96      use type Interfaces.C.size_t;
97   begin
98      return Atomic_Always_Lock_Free (Atomic_Type'Object_Size / 8);
99   end Is_Lock_Free;
100
101end System.Atomic_Operations.Exchange;
102