File : s-atopri.adb
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 -- B o d y --
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 package body System.Atomic_Primitives is
33
34 ----------------------
35 -- Lock_Free_Read_8 --
36 ----------------------
37
38 function Lock_Free_Read_8 (Ptr : Address) return uint8 is
39 begin
40 if uint8'Atomic_Always_Lock_Free then
41 return Atomic_Load_8 (Ptr, Acquire);
42 else
43 raise Program_Error;
44 end if;
45 end Lock_Free_Read_8;
46
47 -----------------------
48 -- Lock_Free_Read_16 --
49 -----------------------
50
51 function Lock_Free_Read_16 (Ptr : Address) return uint16 is
52 begin
53 if uint16'Atomic_Always_Lock_Free then
54 return Atomic_Load_16 (Ptr, Acquire);
55 else
56 raise Program_Error;
57 end if;
58 end Lock_Free_Read_16;
59
60 -----------------------
61 -- Lock_Free_Read_32 --
62 -----------------------
63
64 function Lock_Free_Read_32 (Ptr : Address) return uint32 is
65 begin
66 if uint32'Atomic_Always_Lock_Free then
67 return Atomic_Load_32 (Ptr, Acquire);
68 else
69 raise Program_Error;
70 end if;
71 end Lock_Free_Read_32;
72
73 -----------------------
74 -- Lock_Free_Read_64 --
75 -----------------------
76
77 function Lock_Free_Read_64 (Ptr : Address) return uint64 is
78 begin
79 if uint64'Atomic_Always_Lock_Free then
80 return Atomic_Load_64 (Ptr, Acquire);
81 else
82 raise Program_Error;
83 end if;
84 end Lock_Free_Read_64;
85
86 ---------------------------
87 -- Lock_Free_Try_Write_8 --
88 ---------------------------
89
90 function Lock_Free_Try_Write_8
91 (Ptr : Address;
92 Expected : in out uint8;
93 Desired : uint8) return Boolean
94 is
95 Actual : uint8;
96
97 begin
98 if Expected /= Desired then
99
100 if uint8'Atomic_Always_Lock_Free then
101 Actual := Sync_Compare_And_Swap_8 (Ptr, Expected, Desired);
102 else
103 raise Program_Error;
104 end if;
105
106 if Actual /= Expected then
107 Expected := Actual;
108 return False;
109 end if;
110 end if;
111
112 return True;
113 end Lock_Free_Try_Write_8;
114
115 ----------------------------
116 -- Lock_Free_Try_Write_16 --
117 ----------------------------
118
119 function Lock_Free_Try_Write_16
120 (Ptr : Address;
121 Expected : in out uint16;
122 Desired : uint16) return Boolean
123 is
124 Actual : uint16;
125
126 begin
127 if Expected /= Desired then
128
129 if uint16'Atomic_Always_Lock_Free then
130 Actual := Sync_Compare_And_Swap_16 (Ptr, Expected, Desired);
131 else
132 raise Program_Error;
133 end if;
134
135 if Actual /= Expected then
136 Expected := Actual;
137 return False;
138 end if;
139 end if;
140
141 return True;
142 end Lock_Free_Try_Write_16;
143
144 ----------------------------
145 -- Lock_Free_Try_Write_32 --
146 ----------------------------
147
148 function Lock_Free_Try_Write_32
149 (Ptr : Address;
150 Expected : in out uint32;
151 Desired : uint32) return Boolean
152 is
153 Actual : uint32;
154
155 begin
156 if Expected /= Desired then
157
158 if uint32'Atomic_Always_Lock_Free then
159 Actual := Sync_Compare_And_Swap_32 (Ptr, Expected, Desired);
160 else
161 raise Program_Error;
162 end if;
163
164 if Actual /= Expected then
165 Expected := Actual;
166 return False;
167 end if;
168 end if;
169
170 return True;
171 end Lock_Free_Try_Write_32;
172
173 ----------------------------
174 -- Lock_Free_Try_Write_64 --
175 ----------------------------
176
177 function Lock_Free_Try_Write_64
178 (Ptr : Address;
179 Expected : in out uint64;
180 Desired : uint64) return Boolean
181 is
182 Actual : uint64;
183
184 begin
185 if Expected /= Desired then
186
187 if uint64'Atomic_Always_Lock_Free then
188 Actual := Sync_Compare_And_Swap_64 (Ptr, Expected, Desired);
189 else
190 raise Program_Error;
191 end if;
192
193 if Actual /= Expected then
194 Expected := Actual;
195 return False;
196 end if;
197 end if;
198
199 return True;
200 end Lock_Free_Try_Write_64;
201 end System.Atomic_Primitives;