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-2019, 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