File : 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 -- --
19 -- --
20 -- --
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;