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