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-- 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
32package 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;
201end System.Atomic_Primitives;
202