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-2023, 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    ------------------------------------
  66    -- GCC built-in atomic primitives --
  67    ------------------------------------
  68
  69    generic
  70       type Atomic_Type is mod <>;
  71    function Atomic_Load
  72      (Ptr   : Address;
  73       Model : Mem_Model := Seq_Cst) return Atomic_Type;
  74    pragma Import (Intrinsic, Atomic_Load, "__atomic_load_n");
  75
  76    function Atomic_Load_8  is new Atomic_Load (uint8);
  77    function Atomic_Load_16 is new Atomic_Load (uint16);
  78    function Atomic_Load_32 is new Atomic_Load (uint32);
  79    function Atomic_Load_64 is new Atomic_Load (uint64);
  80
  81    generic
  82       type Atomic_Type is mod <>;
  83    procedure Atomic_Store
  84      (Ptr   : Address;
  85       Value : Atomic_Type;
  86       Model : Mem_Model := Seq_Cst);
  87    pragma Import (Intrinsic, Atomic_Store, "__atomic_store_n");
  88
  89    procedure Atomic_Store_8  is new Atomic_Store (uint8);
  90    procedure Atomic_Store_16 is new Atomic_Store (uint16);
  91    procedure Atomic_Store_32 is new Atomic_Store (uint32);
  92    procedure Atomic_Store_64 is new Atomic_Store (uint64);
  93
  94    generic
  95       type Atomic_Type is mod <>;
  96    function Atomic_Compare_Exchange
  97      (Ptr           : Address;
  98       Expected      : Address;
  99       Desired       : Atomic_Type;
 100       Weak          : Boolean   := False;
 101       Success_Model : Mem_Model := Seq_Cst;
 102       Failure_Model : Mem_Model := Seq_Cst) return Boolean;
 103    pragma Import
 104      (Intrinsic, Atomic_Compare_Exchange, "__atomic_compare_exchange_n");
 105
 106    function Atomic_Compare_Exchange_8  is new Atomic_Compare_Exchange (uint8);
 107    function Atomic_Compare_Exchange_16 is new Atomic_Compare_Exchange (uint16);
 108    function Atomic_Compare_Exchange_32 is new Atomic_Compare_Exchange (uint32);
 109    function Atomic_Compare_Exchange_64 is new Atomic_Compare_Exchange (uint64);
 110
 111    function Atomic_Test_And_Set
 112      (Ptr   : System.Address;
 113       Model : Mem_Model := Seq_Cst) return Boolean;
 114    pragma Import (Intrinsic, Atomic_Test_And_Set, "__atomic_test_and_set");
 115
 116    procedure Atomic_Clear
 117      (Ptr   : System.Address;
 118       Model : Mem_Model := Seq_Cst);
 119    pragma Import (Intrinsic, Atomic_Clear, "__atomic_clear");
 120
 121    function Atomic_Always_Lock_Free
 122      (Size : Interfaces.C.size_t;
 123       Ptr  : System.Address := System.Null_Address) return Boolean;
 124    pragma Import
 125      (Intrinsic, Atomic_Always_Lock_Free, "__atomic_always_lock_free");
 126
 127    --------------------------
 128    -- Lock-free operations --
 129    --------------------------
 130
 131    --  The lock-free implementation uses two atomic instructions for the
 132    --  expansion of protected operations:
 133
 134    --  * Lock_Free_Read atomically loads the value contained in Ptr (with the
 135    --    Acquire synchronization mode).
 136
 137    --  * Lock_Free_Try_Write atomically tries to write the Desired value into
 138    --    Ptr if Ptr contains the Expected value. It returns true if the value
 139    --    in Ptr was changed, or False if it was not, in which case Expected is
 140    --    updated to the unexpected value in Ptr. Note that it does nothing and
 141    --    returns true if Desired and Expected are equal.
 142
 143    generic
 144       type Atomic_Type is mod <>;
 145    function Lock_Free_Read (Ptr : Address) return Atomic_Type;
 146
 147    function Lock_Free_Read_8  is new Lock_Free_Read (uint8);
 148    function Lock_Free_Read_16 is new Lock_Free_Read (uint16);
 149    function Lock_Free_Read_32 is new Lock_Free_Read (uint32);
 150    function Lock_Free_Read_64 is new Lock_Free_Read (uint64);
 151
 152    generic
 153       type Atomic_Type is mod <>;
 154    function Lock_Free_Try_Write
 155      (Ptr      : Address;
 156       Expected : in out Atomic_Type;
 157       Desired  : Atomic_Type) return Boolean;
 158
 159    function Lock_Free_Try_Write_8  is new Lock_Free_Try_Write (uint8);
 160    function Lock_Free_Try_Write_16 is new Lock_Free_Try_Write (uint16);
 161    function Lock_Free_Try_Write_32 is new Lock_Free_Try_Write (uint32);
 162    function Lock_Free_Try_Write_64 is new Lock_Free_Try_Write (uint64);
 163
 164 private
 165    pragma Inline (Lock_Free_Read);
 166    pragma Inline (Lock_Free_Try_Write);
 167 end System.Atomic_Primitives;