gcc/ada/libgnat/s-atopri.ads

   1 ------------------------------------------------------------------------------
   2 --                                                                          --
   3 --                         GNAT RUN-TIME COMPONENTS                         --
   4 --                                                                          --
   5 --               S Y S T E M . A T O M I C _ P R I M I T I V E S            --
   6 --                                                                          --
   7 --                                 S p e c                                  --
   8 --                                                                          --
   9 --              Copyright (C) 2012-2020, 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
  32 --  This package contains both atomic primitives defined from gcc built-in
  33 --  functions and operations used by the compiler to generate the lock-free
  34 --  implementation of protected objects.
  35
  36 with Interfaces.C;
  37
  38 package System.Atomic_Primitives is
  39    pragma Pure;
  40
  41    type uint is mod 2 ** Long_Integer'Size;
  42
  43    type uint8  is mod 2**8
  44      with Size => 8;
  45
  46    type uint16 is mod 2**16
  47      with Size => 16;
  48
  49    type uint32 is mod 2**32
  50      with Size => 32;
  51
  52    type uint64 is mod 2**64
  53      with Size => 64;
  54
  55    Relaxed : constant := 0;
  56    Consume : constant := 1;
  57    Acquire : constant := 2;
  58    Release : constant := 3;
  59    Acq_Rel : constant := 4;
  60    Seq_Cst : constant := 5;
  61    Last    : constant := 6;
  62
  63    subtype Mem_Model is Integer range Relaxed .. Last;
  64
  65    type bool is new Boolean;
  66    pragma Convention (C, bool);
  67
  68    ------------------------------------
  69    -- GCC built-in atomic primitives --
  70    ------------------------------------
  71
  72    function Atomic_Load_8
  73      (Ptr   : Address;
  74       Model : Mem_Model := Seq_Cst) return uint8;
  75    pragma Import (Intrinsic, Atomic_Load_8, "__atomic_load_1");
  76
  77    function Atomic_Load_16
  78      (Ptr   : Address;
  79       Model : Mem_Model := Seq_Cst) return uint16;
  80    pragma Import (Intrinsic, Atomic_Load_16, "__atomic_load_2");
  81
  82    function Atomic_Load_32
  83      (Ptr   : Address;
  84       Model : Mem_Model := Seq_Cst) return uint32;
  85    pragma Import (Intrinsic, Atomic_Load_32, "__atomic_load_4");
  86
  87    function Atomic_Load_64
  88      (Ptr   : Address;
  89       Model : Mem_Model := Seq_Cst) return uint64;
  90    pragma Import (Intrinsic, Atomic_Load_64, "__atomic_load_8");
  91
  92    function Sync_Compare_And_Swap_8
  93      (Ptr      : Address;
  94       Expected : uint8;
  95       Desired  : uint8) return uint8;
  96    pragma Import (Intrinsic,
  97                   Sync_Compare_And_Swap_8,
  98                   "__sync_val_compare_and_swap_1");
  99
 100    function Sync_Compare_And_Swap_16
 101      (Ptr      : Address;
 102       Expected : uint16;
 103       Desired  : uint16) return uint16;
 104    pragma Import (Intrinsic,
 105                   Sync_Compare_And_Swap_16,
 106                   "__sync_val_compare_and_swap_2");
 107
 108    function Sync_Compare_And_Swap_32
 109      (Ptr      : Address;
 110       Expected : uint32;
 111       Desired  : uint32) return uint32;
 112    pragma Import (Intrinsic,
 113                   Sync_Compare_And_Swap_32,
 114                   "__sync_val_compare_and_swap_4");
 115
 116    function Sync_Compare_And_Swap_64
 117      (Ptr      : Address;
 118       Expected : uint64;
 119       Desired  : uint64) return uint64;
 120    pragma Import (Intrinsic,
 121                   Sync_Compare_And_Swap_64,
 122                   "__sync_val_compare_and_swap_8");
 123
 124    --  ??? We might want to switch to the __atomic series of builtins for
 125    --  compare-and-swap operations at some point.
 126
 127    --  function Atomic_Compare_Exchange_8
 128    --    (Ptr           : Address;
 129    --     Expected      : Address;
 130    --     Desired       : uint8;
 131    --     Weak          : Boolean   := False;
 132    --     Success_Model : Mem_Model := Seq_Cst;
 133    --     Failure_Model : Mem_Model := Seq_Cst) return Boolean;
 134    --  pragma Import (Intrinsic,
 135    --                 Atomic_Compare_Exchange_8,
 136    --                 "__atomic_compare_exchange_1");
 137
 138    function Atomic_Test_And_Set
 139      (Ptr   : System.Address;
 140       Model : Mem_Model := Seq_Cst) return bool;
 141    pragma Import (Intrinsic, Atomic_Test_And_Set, "__atomic_test_and_set");
 142
 143    procedure Atomic_Clear
 144      (Ptr   : System.Address;
 145       Model : Mem_Model := Seq_Cst);
 146    pragma Import (Intrinsic, Atomic_Clear, "__atomic_clear");
 147
 148    function Atomic_Always_Lock_Free
 149      (Size : Interfaces.C.size_t;
 150       Ptr  : System.Address := System.Null_Address) return bool;
 151    pragma Import
 152      (Intrinsic, Atomic_Always_Lock_Free, "__atomic_always_lock_free");
 153
 154    --------------------------
 155    -- Lock-free operations --
 156    --------------------------
 157
 158    --  The lock-free implementation uses two atomic instructions for the
 159    --  expansion of protected operations:
 160
 161    --  * Lock_Free_Read_N atomically loads the value of the protected component
 162    --    accessed by the current protected operation.
 163
 164    --  * Lock_Free_Try_Write_N tries to write the Desired value into Ptr only
 165    --    if Expected and Desired mismatch.
 166
 167    function Lock_Free_Read_8 (Ptr : Address) return uint8;
 168
 169    function Lock_Free_Read_16 (Ptr : Address) return uint16;
 170
 171    function Lock_Free_Read_32 (Ptr : Address) return uint32;
 172
 173    function Lock_Free_Read_64 (Ptr : Address) return uint64;
 174
 175    function Lock_Free_Try_Write_8
 176       (Ptr      : Address;
 177        Expected : in out uint8;
 178        Desired  : uint8) return Boolean;
 179
 180    function Lock_Free_Try_Write_16
 181       (Ptr      : Address;
 182        Expected : in out uint16;
 183        Desired  : uint16) return Boolean;
 184
 185    function Lock_Free_Try_Write_32
 186       (Ptr      : Address;
 187        Expected : in out uint32;
 188        Desired  : uint32) return Boolean;
 189
 190    function Lock_Free_Try_Write_64
 191       (Ptr      : Address;
 192        Expected : in out uint64;
 193        Desired  : uint64) return Boolean;
 194
 195    pragma Inline (Lock_Free_Read_8);
 196    pragma Inline (Lock_Free_Read_16);
 197    pragma Inline (Lock_Free_Read_32);
 198    pragma Inline (Lock_Free_Read_64);
 199    pragma Inline (Lock_Free_Try_Write_8);
 200    pragma Inline (Lock_Free_Try_Write_16);
 201    pragma Inline (Lock_Free_Try_Write_32);
 202    pragma Inline (Lock_Free_Try_Write_64);
 203 end System.Atomic_Primitives;