------------------------------------------------------------------------------ -- G N A T C O L L -- -- -- -- Copyright (C) 2010-2017, AdaCore -- -- -- -- This library is free software; you can redistribute it and/or modify it -- -- under terms of the GNU General Public License as published by the Free -- -- Software Foundation; either version 3, or (at your option) any later -- -- version. This library is distributed in the hope that it will be useful, -- -- but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHAN- -- -- TABILITY or FITNESS FOR A PARTICULAR PURPOSE. -- -- -- -- -- -- -- -- -- -- -- -- 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 -- -- . -- -- -- ------------------------------------------------------------------------------ with Interfaces; use Interfaces; package body GNATCOLL.Atomic is function Intrinsic_Sync_Bool_Compare_And_Swap (Ptr : access Atomic_Counter; Oldval : Atomic_Counter; Newval : Atomic_Counter) return Boolean; pragma Import (Intrinsic, Intrinsic_Sync_Bool_Compare_And_Swap, External_Name => "__sync_bool_compare_and_swap_4"); function Intrinsic_Sync_Val_Compare_And_Swap (Ptr : access Atomic_Counter; Oldval : Atomic_Counter; Newval : Atomic_Counter) return Atomic_Counter; pragma Import (Intrinsic, Intrinsic_Sync_Val_Compare_And_Swap, External_Name => "__sync_val_compare_and_swap_4"); function Intrinsic_Sync_Add_And_Fetch (Ptr : access Atomic_Counter; Value : Atomic_Counter) return Atomic_Counter; pragma Import (Intrinsic, Intrinsic_Sync_Add_And_Fetch, External_Name => "__sync_add_and_fetch_4"); function Intrinsic_Sync_Sub_And_Fetch (Ptr : access Atomic_Counter; Value : Atomic_Counter) return Atomic_Counter; pragma Import (Intrinsic, Intrinsic_Sync_Sub_And_Fetch, External_Name => "__sync_sub_and_fetch_4"); ------------------ -- Is_Lock_Free -- ------------------ function Is_Lock_Free return Boolean is (True); ------------------------ -- Sync_Add_And_Fetch -- ------------------------ function Sync_Add_And_Fetch (Ptr : access Atomic_Counter; Value : Atomic_Counter) return Atomic_Counter is begin return Intrinsic_Sync_Add_And_Fetch (Ptr, Value); end Sync_Add_And_Fetch; procedure Sync_Add_And_Fetch (Ptr : access Atomic_Counter; Value : Atomic_Counter) is Dummy : Atomic_Counter with Unreferenced; begin Dummy := Intrinsic_Sync_Add_And_Fetch (Ptr, Value); end Sync_Add_And_Fetch; ------------------------ -- Sync_Sub_And_Fetch -- ------------------------ function Sync_Sub_And_Fetch (Ptr : access Atomic_Counter; Value : Atomic_Counter) return Atomic_Counter is begin return Intrinsic_Sync_Sub_And_Fetch (Ptr, Value); end Sync_Sub_And_Fetch; procedure Sync_Sub_And_Fetch (Ptr : access Atomic_Counter; Value : Atomic_Counter) is Dummy : Atomic_Counter with Unreferenced; begin Dummy := Intrinsic_Sync_Sub_And_Fetch (Ptr, Value); end Sync_Sub_And_Fetch; --------------- -- Increment -- --------------- procedure Increment (Value : aliased in out Atomic_Counter) is begin System.Atomic_Counters.Increment (Value); end Increment; --------------- -- Decrement -- --------------- procedure Decrement (Value : aliased in out Atomic_Counter) is begin System.Atomic_Counters.Decrement (Value); end Decrement; function Decrement (Value : aliased in out Atomic_Counter) return Boolean is begin return System.Atomic_Counters.Decrement (Value); end Decrement; ---------------------- -- Unsafe_Increment -- ---------------------- procedure Unsafe_Increment (Value : in out Atomic_Counter) is begin Value := Atomic_Counter'Succ (Value); end Unsafe_Increment; ---------------------- -- Unsafe_Decrement -- ---------------------- function Unsafe_Decrement (Value : in out Atomic_Counter) return Boolean is begin Value := Atomic_Counter'Pred (Value); return Value = 0; end Unsafe_Decrement; -------------------------------- -- Sync_Bool_Compare_And_Swap -- -------------------------------- function Sync_Bool_Compare_And_Swap (Ptr : access Element_Access; Oldval : Element_Access; Newval : Element_Access) return Boolean is function Intrinsic_Sync_Bool_And_Swap_Access (Ptr : access Element_Access; Oldval, Newval : Element_Access) return Interfaces.Integer_8; pragma Import (Intrinsic, Intrinsic_Sync_Bool_And_Swap_Access, External_Name => "gnatcoll_sync_bool_compare_and_swap_access"); begin return Intrinsic_Sync_Bool_And_Swap_Access (Ptr, Oldval, Newval) /= 0; end Sync_Bool_Compare_And_Swap; ---------------------------------------- -- Sync_Bool_Compare_And_Swap_Counter -- ---------------------------------------- function Sync_Bool_Compare_And_Swap_Counter (Ptr : access Atomic_Counter; Oldval : Atomic_Counter; Newval : Atomic_Counter) return Boolean is begin return Intrinsic_Sync_Bool_Compare_And_Swap (Ptr, Oldval, Newval); end Sync_Bool_Compare_And_Swap_Counter; --------------------------------------- -- Sync_Val_Compare_And_Swap_Counter -- --------------------------------------- function Sync_Val_Compare_And_Swap_Counter (Ptr : access Atomic_Counter; Oldval : Atomic_Counter; Newval : Atomic_Counter) return Atomic_Counter is begin return Intrinsic_Sync_Val_Compare_And_Swap (Ptr, Oldval, Newval); end Sync_Val_Compare_And_Swap_Counter; end GNATCOLL.Atomic;