gcc/ada/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, 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 package System.Atomic_Primitives is
  37    pragma Preelaborate;
  38
  39    type uint is mod 2 ** Long_Integer'Size;
  40
  41    type uint8  is mod 2**8
  42      with Size => 8;
  43
  44    type uint16 is mod 2**16
  45      with Size => 16;
  46
  47    type uint32 is mod 2**32
  48      with Size => 32;
  49
  50    type uint64 is mod 2**64
  51      with Size => 64;
  52
  53    Relaxed : constant := 0;
  54    Consume : constant := 1;
  55    Acquire : constant := 2;
  56    Release : constant := 3;
  57    Acq_Rel : constant := 4;
  58    Seq_Cst : constant := 5;
  59    Last    : constant := 6;
  60
  61    subtype Mem_Model is Integer range Relaxed .. Last;
  62
  63    ------------------------------------
  64    -- GCC built-in atomic primitives --
  65    ------------------------------------
  66
  67    function Atomic_Load_8
  68      (Ptr   : Address;
  69       Model : Mem_Model := Seq_Cst) return uint8;
  70    pragma Import (Intrinsic, Atomic_Load_8, "__atomic_load_1");
  71
  72    function Atomic_Load_16
  73      (Ptr   : Address;
  74       Model : Mem_Model := Seq_Cst) return uint16;
  75    pragma Import (Intrinsic, Atomic_Load_16, "__atomic_load_2");
  76
  77    function Atomic_Load_32
  78      (Ptr   : Address;
  79       Model : Mem_Model := Seq_Cst) return uint32;
  80    pragma Import (Intrinsic, Atomic_Load_32, "__atomic_load_4");
  81
  82    function Atomic_Load_64
  83      (Ptr   : Address;
  84       Model : Mem_Model := Seq_Cst) return uint64;
  85    pragma Import (Intrinsic, Atomic_Load_64, "__atomic_load_8");
  86
  87    function Sync_Compare_And_Swap_8
  88      (Ptr      : Address;
  89       Expected : uint8;
  90       Desired  : uint8) return uint8;
  91    pragma Import (Intrinsic,
  92                   Sync_Compare_And_Swap_8,
  93                   "__sync_val_compare_and_swap_1");
  94
  95    --  ??? Should use __atomic_compare_exchange_1 (doesn't work yet):
  96    --  function Sync_Compare_And_Swap_8
  97    --    (Ptr           : Address;
  98    --     Expected      : Address;
  99    --     Desired       : uint8;
 100    --     Weak          : Boolean   := False;
 101    --     Success_Model : Mem_Model := Seq_Cst;
 102    --     Failure_Model : Mem_Model := Seq_Cst) return Boolean;
 103    --  pragma Import (Intrinsic,
 104    --                 Sync_Compare_And_Swap_8,
 105    --                 "__atomic_compare_exchange_1");
 106
 107    function Sync_Compare_And_Swap_16
 108      (Ptr      : Address;
 109       Expected : uint16;
 110       Desired  : uint16) return uint16;
 111    pragma Import (Intrinsic,
 112                   Sync_Compare_And_Swap_16,
 113                   "__sync_val_compare_and_swap_2");
 114
 115    function Sync_Compare_And_Swap_32
 116      (Ptr      : Address;
 117       Expected : uint32;
 118       Desired  : uint32) return uint32;
 119    pragma Import (Intrinsic,
 120                   Sync_Compare_And_Swap_32,
 121                   "__sync_val_compare_and_swap_4");
 122
 123    function Sync_Compare_And_Swap_64
 124      (Ptr      : Address;
 125       Expected : uint64;
 126       Desired  : uint64) return uint64;
 127    pragma Import (Intrinsic,
 128                   Sync_Compare_And_Swap_64,
 129                   "__sync_val_compare_and_swap_8");
 130
 131    --------------------------
 132    -- Lock-free operations --
 133    --------------------------
 134
 135    --  The lock-free implementation uses two atomic instructions for the
 136    --  expansion of protected operations:
 137
 138    --  * Lock_Free_Read_N atomically loads the value of the protected component
 139    --    accessed by the current protected operation.
 140
 141    --  * Lock_Free_Try_Write_N tries to write the Desired value into Ptr only
 142    --    if Expected and Desired mismatch.
 143
 144    function Lock_Free_Read_8 (Ptr : Address) return uint8;
 145
 146    function Lock_Free_Read_16 (Ptr : Address) return uint16;
 147
 148    function Lock_Free_Read_32 (Ptr : Address) return uint32;
 149
 150    function Lock_Free_Read_64 (Ptr : Address) return uint64;
 151
 152    function Lock_Free_Try_Write_8
 153       (Ptr      : Address;
 154        Expected : in out uint8;
 155        Desired  : uint8) return Boolean;
 156
 157    function Lock_Free_Try_Write_16
 158       (Ptr      : Address;
 159        Expected : in out uint16;
 160        Desired  : uint16) return Boolean;
 161
 162    function Lock_Free_Try_Write_32
 163       (Ptr      : Address;
 164        Expected : in out uint32;
 165        Desired  : uint32) return Boolean;
 166
 167    function Lock_Free_Try_Write_64
 168       (Ptr      : Address;
 169        Expected : in out uint64;
 170        Desired  : uint64) return Boolean;
 171
 172    pragma Inline (Lock_Free_Read_8);
 173    pragma Inline (Lock_Free_Read_16);
 174    pragma Inline (Lock_Free_Read_32);
 175    pragma Inline (Lock_Free_Read_64);
 176    pragma Inline (Lock_Free_Try_Write_8);
 177    pragma Inline (Lock_Free_Try_Write_16);
 178    pragma Inline (Lock_Free_Try_Write_32);
 179    pragma Inline (Lock_Free_Try_Write_64);
 180 end System.Atomic_Primitives;