1------------------------------------------------------------------------------ 2-- -- 3-- GNAT RUN-TIME COMPONENTS -- 4-- -- 5-- S Y S T E M . B I T F I E L D _ U T I L S -- 6-- -- 7-- B o d y -- 8-- -- 9-- Copyright (C) 2019-2020, 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.Bitfield_Utils is 33 34 -- ??? 35 -- 36 -- This code does not yet work for overlapping bit fields. We need to copy 37 -- backwards in some cases (i.e. from higher to lower bit addresses). 38 -- Alternatively, we could avoid calling this if Forwards_OK is False. 39 -- 40 -- ??? 41 42 package body G is 43 44 Val_Bytes : constant Address := Address (Val'Size / Storage_Unit); 45 46 -- A Val_2 can cross a memory page boundary (e.g. an 8-byte Val_2 that 47 -- starts 4 bytes before the end of a page). If the bit field also 48 -- crosses that boundary, then the second page is known to exist, and we 49 -- can safely load or store the Val_2. On the other hand, if the bit 50 -- field is entirely within the first half of the Val_2, then it is 51 -- possible (albeit highly unlikely) that the second page does not 52 -- exist, so we must load or store only the first half of the Val_2. 53 -- Get_Val_2 and Set_Val_2 take care of all this. 54 55 function Get_Val_2 56 (Src_Address : Address; 57 Src_Offset : Bit_Offset; 58 Size : Small_Size) 59 return Val_2; 60 -- Get the Val_2, taking care to only load the first half when 61 -- necessary. 62 63 procedure Set_Val_2 64 (Dest_Address : Address; 65 Dest_Offset : Bit_Offset; 66 V : Val_2; 67 Size : Small_Size); 68 -- Set the Val_2, taking care to only store the first half when 69 -- necessary. 70 71 -- Get_Bitfield and Set_Bitfield are helper functions that get/set small 72 -- bit fields -- the value fits in Val, and the bit field is placed 73 -- starting at some offset within the first half of a Val_2. 74 -- Copy_Bitfield, on the other hand, supports arbitrarily large bit 75 -- fields. All operations require bit offsets to point within the first 76 -- Val pointed to by the address. 77 78 function Get_Bitfield 79 (Src : Val_2; Src_Offset : Bit_Offset; Size : Small_Size) 80 return Val; 81 -- Returns the bit field in Src starting at Src_Offset, of the given 82 -- Size. If Size < Small_Size'Last, then high order bits are zero. 83 84 function Set_Bitfield 85 (Src_Value : Val; 86 Dest : Val_2; 87 Dest_Offset : Bit_Offset; 88 Size : Small_Size) 89 return Val_2; 90 -- The bit field in Dest starting at Dest_Offset, of the given Size, is 91 -- set to Src_Value. Src_Value must have high order bits (Size and 92 -- above) zero. The result is returned as the function result. 93 94 procedure Set_Bitfield 95 (Src_Value : Val; 96 Dest_Address : Address; 97 Dest_Offset : Bit_Offset; 98 Size : Small_Size); 99 -- This version takes the bit address and size of the destination. 100 101 procedure Copy_Small_Bitfield 102 (Src_Address : Address; 103 Src_Offset : Bit_Offset; 104 Dest_Address : Address; 105 Dest_Offset : Bit_Offset; 106 Size : Small_Size); 107 -- Copy_Bitfield in the case where Size <= Val'Size. 108 -- The Address values must be aligned as for Val and Val_2. 109 -- This works for overlapping bit fields. 110 111 procedure Copy_Large_Bitfield 112 (Src_Address : Address; 113 Src_Offset : Bit_Offset; 114 Dest_Address : Address; 115 Dest_Offset : Bit_Offset; 116 Size : Bit_Size); 117 -- Copy_Bitfield in the case where Size > Val'Size. 118 -- The Address values must be aligned as for Val and Val_2. 119 -- This works for overlapping bit fields only if the source 120 -- bit address is greater than or equal to the destination 121 -- bit address, because it copies forward (from lower to higher 122 -- bit addresses). 123 124 function Get_Val_2 125 (Src_Address : Address; 126 Src_Offset : Bit_Offset; 127 Size : Small_Size) 128 return Val_2 is 129 begin 130 pragma Assert (Src_Address mod Val'Alignment = 0); 131 132 -- Bit field fits in first half; fetch just one Val. On little 133 -- endian, we want that in the low half, but on big endian, we 134 -- want it in the high half. 135 136 if Src_Offset + Size <= Val'Size then 137 declare 138 Result : aliased constant Val with 139 Import, Address => Src_Address; 140 begin 141 return (case Endian is 142 when Little => Val_2 (Result), 143 when Big => Shift_Left (Val_2 (Result), Val'Size)); 144 end; 145 146 -- Bit field crosses into the second half, so it's safe to fetch the 147 -- whole Val_2. 148 149 else 150 declare 151 Result : aliased constant Val_2 with 152 Import, Address => Src_Address; 153 begin 154 return Result; 155 end; 156 end if; 157 end Get_Val_2; 158 159 procedure Set_Val_2 160 (Dest_Address : Address; 161 Dest_Offset : Bit_Offset; 162 V : Val_2; 163 Size : Small_Size) is 164 begin 165 pragma Assert (Dest_Address mod Val'Alignment = 0); 166 167 -- Comments in Get_Val_2 apply, except we're storing instead of 168 -- fetching. 169 170 if Dest_Offset + Size <= Val'Size then 171 declare 172 Dest : aliased Val with Import, Address => Dest_Address; 173 begin 174 Dest := (case Endian is 175 when Little => Val'Mod (V), 176 when Big => Val (Shift_Right (V, Val'Size))); 177 end; 178 else 179 declare 180 Dest : aliased Val_2 with Import, Address => Dest_Address; 181 begin 182 Dest := V; 183 end; 184 end if; 185 end Set_Val_2; 186 187 function Get_Bitfield 188 (Src : Val_2; Src_Offset : Bit_Offset; Size : Small_Size) 189 return Val 190 is 191 L_Shift_Amount : constant Natural := 192 (case Endian is 193 when Little => Val_2'Size - (Src_Offset + Size), 194 when Big => Src_Offset); 195 Temp1 : constant Val_2 := 196 Shift_Left (Src, L_Shift_Amount); 197 Temp2 : constant Val_2 := 198 Shift_Right (Temp1, Val_2'Size - Size); 199 begin 200 return Val (Temp2); 201 end Get_Bitfield; 202 203 function Set_Bitfield 204 (Src_Value : Val; 205 Dest : Val_2; 206 Dest_Offset : Bit_Offset; 207 Size : Small_Size) 208 return Val_2 209 is 210 pragma Assert (Size = Val'Size or else Src_Value < 2**Size); 211 L_Shift_Amount : constant Natural := 212 (case Endian is 213 when Little => Dest_Offset, 214 when Big => Val_2'Size - (Dest_Offset + Size)); 215 Mask : constant Val_2 := 216 Shift_Left (Shift_Left (1, Size) - 1, L_Shift_Amount); 217 Temp1 : constant Val_2 := Dest and not Mask; 218 Temp2 : constant Val_2 := 219 Shift_Left (Val_2 (Src_Value), L_Shift_Amount); 220 Result : constant Val_2 := Temp1 or Temp2; 221 begin 222 return Result; 223 end Set_Bitfield; 224 225 procedure Set_Bitfield 226 (Src_Value : Val; 227 Dest_Address : Address; 228 Dest_Offset : Bit_Offset; 229 Size : Small_Size) 230 is 231 Old_Dest : constant Val_2 := 232 Get_Val_2 (Dest_Address, Dest_Offset, Size); 233 New_Dest : constant Val_2 := 234 Set_Bitfield (Src_Value, Old_Dest, Dest_Offset, Size); 235 begin 236 Set_Val_2 (Dest_Address, Dest_Offset, New_Dest, Size); 237 end Set_Bitfield; 238 239 procedure Copy_Small_Bitfield 240 (Src_Address : Address; 241 Src_Offset : Bit_Offset; 242 Dest_Address : Address; 243 Dest_Offset : Bit_Offset; 244 Size : Small_Size) 245 is 246 Src : constant Val_2 := Get_Val_2 (Src_Address, Src_Offset, Size); 247 V : constant Val := Get_Bitfield (Src, Src_Offset, Size); 248 begin 249 Set_Bitfield (V, Dest_Address, Dest_Offset, Size); 250 end Copy_Small_Bitfield; 251 252 -- Copy_Large_Bitfield does the main work. Copying aligned Vals is more 253 -- efficient than fiddling with shifting and whatnot. But we can't align 254 -- both source and destination. We choose to align the destination, 255 -- because that's more efficient -- Set_Bitfield needs to read, then 256 -- modify, then write, whereas Get_Bitfield does not. 257 -- 258 -- So the method is: 259 -- 260 -- Step 1: 261 -- If the destination is not already aligned, copy Initial_Size 262 -- bits, and increment the bit addresses. Initial_Size is chosen to 263 -- be the smallest size that will cause the destination bit address 264 -- to be aligned (i.e. have zero bit offset from the already-aligned 265 -- Address). Get_Bitfield and Set_Bitfield are used here. 266 -- 267 -- Step 2: 268 -- Loop, copying Vals. Get_Bitfield is used to fetch a Val-sized 269 -- bit field, but Set_Bitfield is not needed -- we can set the 270 -- aligned Val with an array indexing. 271 -- 272 -- Step 3: 273 -- Copy remaining smaller-than-Val bits, if any 274 275 procedure Copy_Large_Bitfield 276 (Src_Address : Address; 277 Src_Offset : Bit_Offset; 278 Dest_Address : Address; 279 Dest_Offset : Bit_Offset; 280 Size : Bit_Size) 281 is 282 Sz : Bit_Size := Size; 283 S_Addr : Address := Src_Address; 284 S_Off : Bit_Offset := Src_Offset; 285 D_Addr : Address := Dest_Address; 286 D_Off : Bit_Offset := Dest_Offset; 287 begin 288 if S_Addr < D_Addr or else (S_Addr = D_Addr and then S_Off < D_Off) 289 then 290 -- Here, the source bit address is less than the destination bit 291 -- address. Assert that there is no overlap. 292 293 declare 294 Temp_Off : constant Bit_Offset'Base := S_Off + Size; 295 After_S_Addr : constant Address := 296 S_Addr + Address (Temp_Off / Storage_Unit); 297 After_S_Off : constant Bit_Offset_In_Byte := 298 Temp_Off mod Storage_Unit; 299 -- (After_S_Addr, After_S_Off) is the bit address of the bit 300 -- just after the source bit field. Assert that it's less than 301 -- or equal to the destination bit address. 302 Overlap_OK : constant Boolean := 303 After_S_Addr < D_Addr 304 or else 305 (After_S_Addr = D_Addr and then After_S_Off <= D_Off); 306 begin 307 pragma Assert (Overlap_OK); 308 end; 309 end if; 310 311 if D_Off /= 0 then 312 -- Step 1: 313 314 declare 315 Initial_Size : constant Small_Size := Val'Size - D_Off; 316 Initial_Val_2 : constant Val_2 := 317 Get_Val_2 (S_Addr, S_Off, Initial_Size); 318 Initial_Val : constant Val := 319 Get_Bitfield (Initial_Val_2, S_Off, Initial_Size); 320 321 begin 322 Set_Bitfield 323 (Initial_Val, D_Addr, D_Off, Initial_Size); 324 325 Sz := Sz - Initial_Size; 326 declare 327 New_S_Off : constant Bit_Offset'Base := S_Off + Initial_Size; 328 begin 329 if New_S_Off > Bit_Offset'Last then 330 S_Addr := S_Addr + Val_Bytes; 331 S_Off := New_S_Off - Small_Size'Last; 332 else 333 S_Off := New_S_Off; 334 end if; 335 end; 336 D_Addr := D_Addr + Val_Bytes; 337 pragma Assert (D_Off + Initial_Size = Val'Size); 338 D_Off := 0; 339 end; 340 end if; 341 342 -- Step 2: 343 344 declare 345 Dest_Arr : Val_Array (1 .. Sz / Val'Size) with Import, 346 Address => D_Addr; 347 begin 348 for Dest_Comp of Dest_Arr loop 349 declare 350 pragma Warnings (Off); 351 pragma Assert (Dest_Comp in Val); 352 pragma Warnings (On); 353 pragma Assert (Dest_Comp'Valid); 354 Src_V_2 : constant Val_2 := 355 Get_Val_2 (S_Addr, S_Off, Val'Size); 356 Full_V : constant Val := 357 Get_Bitfield (Src_V_2, S_Off, Val'Size); 358 begin 359 Dest_Comp := Full_V; 360 S_Addr := S_Addr + Val_Bytes; 361 -- S_Off remains the same 362 end; 363 end loop; 364 365 Sz := Sz mod Val'Size; 366 if Sz /= 0 then 367 -- Step 3: 368 369 declare 370 Final_Val_2 : constant Val_2 := 371 Get_Val_2 (S_Addr, S_Off, Sz); 372 Final_Val : constant Val := 373 Get_Bitfield (Final_Val_2, S_Off, Sz); 374 begin 375 Set_Bitfield 376 (Final_Val, D_Addr + Dest_Arr'Length * Val_Bytes, 0, Sz); 377 end; 378 end if; 379 end; 380 end Copy_Large_Bitfield; 381 382 procedure Copy_Bitfield 383 (Src_Address : Address; 384 Src_Offset : Bit_Offset_In_Byte; 385 Dest_Address : Address; 386 Dest_Offset : Bit_Offset_In_Byte; 387 Size : Bit_Size) 388 is 389 -- Align the Address values as for Val and Val_2, and adjust the 390 -- Bit_Offsets accordingly. 391 392 Src_Adjust : constant Address := Src_Address mod Val_Bytes; 393 Al_Src_Address : constant Address := Src_Address - Src_Adjust; 394 Al_Src_Offset : constant Bit_Offset := 395 Src_Offset + Bit_Offset (Src_Adjust * Storage_Unit); 396 397 Dest_Adjust : constant Address := Dest_Address mod Val_Bytes; 398 Al_Dest_Address : constant Address := Dest_Address - Dest_Adjust; 399 Al_Dest_Offset : constant Bit_Offset := 400 Dest_Offset + Bit_Offset (Dest_Adjust * Storage_Unit); 401 402 pragma Assert (Al_Src_Address mod Val'Alignment = 0); 403 pragma Assert (Al_Dest_Address mod Val'Alignment = 0); 404 begin 405 if Size in Small_Size then 406 Copy_Small_Bitfield 407 (Al_Src_Address, Al_Src_Offset, 408 Al_Dest_Address, Al_Dest_Offset, 409 Size); 410 else 411 Copy_Large_Bitfield 412 (Al_Src_Address, Al_Src_Offset, 413 Al_Dest_Address, Al_Dest_Offset, 414 Size); 415 end if; 416 end Copy_Bitfield; 417 418 end G; 419 420end System.Bitfield_Utils; 421