1 ------------------------------------------------------------------------------
3 -- GNAT RUN-TIME COMPONENTS --
5 -- S Y S T E M . B I T F I E L D _ U T I L S --
9 -- Copyright (C) 2019-2023, Free Software Foundation, Inc. --
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. --
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. --
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/>. --
27 -- GNAT was originally developed by the GNAT team at New York University. --
28 -- Extensive contributions were provided by Ada Core Technologies Inc. --
30 ------------------------------------------------------------------------------
32 with System
.Storage_Elements
; use System
.Storage_Elements
;
34 package body System
.Bitfield_Utils
is
38 Val_Bytes
: constant Storage_Count
:= Val
'Size / Storage_Unit
;
40 -- A Val_2 can cross a memory page boundary (e.g. an 8-byte Val_2 that
41 -- starts 4 bytes before the end of a page). If the bit field also
42 -- crosses that boundary, then the second page is known to exist, and we
43 -- can safely load or store the Val_2. On the other hand, if the bit
44 -- field is entirely within the first half of the Val_2, then it is
45 -- possible (albeit highly unlikely) that the second page does not
46 -- exist, so we must load or store only the first half of the Val_2.
47 -- Get_Val_2 and Set_Val_2 take care of all this.
50 (Src_Address
: Address
;
51 Src_Offset
: Bit_Offset
;
54 -- Get the Val_2, taking care to only load the first half when
58 (Dest_Address
: Address
;
59 Dest_Offset
: Bit_Offset
;
62 -- Set the Val_2, taking care to only store the first half when
65 -- Get_Bitfield and Set_Bitfield are helper functions that get/set small
66 -- bit fields -- the value fits in Val, and the bit field is placed
67 -- starting at some offset within the first half of a Val_2.
68 -- Copy_Bitfield, on the other hand, supports arbitrarily large bit
69 -- fields. All operations require bit offsets to point within the first
70 -- Val pointed to by the address.
73 (Src
: Val_2
; Src_Offset
: Bit_Offset
; Size
: Small_Size
)
74 return Val
with Inline
;
75 -- Returns the bit field in Src starting at Src_Offset, of the given
76 -- Size. If Size < Small_Size'Last, then high order bits are zero.
81 Dest_Offset
: Bit_Offset
;
83 return Val_2
with Inline
;
84 -- The bit field in Dest starting at Dest_Offset, of the given Size, is
85 -- set to Src_Value. Src_Value must have high order bits (Size and
86 -- above) zero. The result is returned as the function result.
88 procedure Set_Bitfield
90 Dest_Address
: Address
;
91 Dest_Offset
: Bit_Offset
;
93 -- This version takes the bit address and size of the destination.
95 procedure Copy_Small_Bitfield
96 (Src_Address
: Address
;
97 Src_Offset
: Bit_Offset
;
98 Dest_Address
: Address
;
99 Dest_Offset
: Bit_Offset
;
101 -- Copy_Bitfield in the case where Size <= Val'Size.
102 -- The Address values must be aligned as for Val and Val_2.
103 -- This works for overlapping bit fields.
105 procedure Copy_Large_Bitfield
106 (Src_Address
: Address
;
107 Src_Offset
: Bit_Offset
;
108 Dest_Address
: Address
;
109 Dest_Offset
: Bit_Offset
;
111 -- Copy_Bitfield in the case where Size > Val'Size.
112 -- The Address values must be aligned as for Val and Val_2.
113 -- This works for overlapping bit fields only if the source
114 -- bit address is greater than or equal to the destination
115 -- bit address, because it copies forward (from lower to higher
119 (Src_Address
: Address
;
120 Src_Offset
: Bit_Offset
;
124 pragma Assert
(Src_Address
mod Storage_Count
'(Val'Alignment) = 0);
126 -- Bit field fits in first half; fetch just one Val. On little
127 -- endian, we want that in the low half, but on big endian, we
128 -- want it in the high half.
130 if Src_Offset + Size <= Val'Size then
132 Result : aliased constant Val with
133 Import, Address => Src_Address;
135 return (case Endian is
136 when Little => Val_2 (Result),
137 when Big => Shift_Left (Val_2 (Result), Val'Size));
140 -- Bit field crosses into the second half, so it's safe to fetch the
145 Result : aliased constant Val_2 with
146 Import, Address => Src_Address;
154 (Dest_Address : Address;
155 Dest_Offset : Bit_Offset;
157 Size : Small_Size) is
159 pragma Assert (Dest_Address mod Storage_Count'(Val
'Alignment) = 0);
161 -- Comments in Get_Val_2 apply, except we're storing instead of
164 if Dest_Offset
+ Size
<= Val
'Size then
166 Dest
: aliased Val
with Import
, Address
=> Dest_Address
;
168 Dest
:= (case Endian
is
169 when Little
=> Val
'Mod (V
),
170 when Big
=> Val
(Shift_Right
(V
, Val
'Size)));
174 Dest
: aliased Val_2
with Import
, Address
=> Dest_Address
;
181 function Get_Bitfield
182 (Src
: Val_2
; Src_Offset
: Bit_Offset
; Size
: Small_Size
)
185 L_Shift_Amount
: constant Natural :=
187 when Little
=> Val_2
'Size - (Src_Offset
+ Size
),
188 when Big
=> Src_Offset
);
189 Temp1
: constant Val_2
:=
190 Shift_Left
(Src
, L_Shift_Amount
);
191 Temp2
: constant Val_2
:=
192 Shift_Right
(Temp1
, Val_2
'Size - Size
);
197 function Set_Bitfield
200 Dest_Offset
: Bit_Offset
;
204 pragma Assert
(Size
= Val
'Size or else Src_Value
< 2**Size
);
205 L_Shift_Amount
: constant Natural :=
207 when Little
=> Dest_Offset
,
208 when Big
=> Val_2
'Size - (Dest_Offset
+ Size
));
209 Mask
: constant Val_2
:=
210 Shift_Left
(Shift_Left
(1, Size
) - 1, L_Shift_Amount
);
211 Temp1
: constant Val_2
:= Dest
and not Mask
;
212 Temp2
: constant Val_2
:=
213 Shift_Left
(Val_2
(Src_Value
), L_Shift_Amount
);
214 Result
: constant Val_2
:= Temp1
or Temp2
;
219 procedure Set_Bitfield
221 Dest_Address
: Address
;
222 Dest_Offset
: Bit_Offset
;
225 Old_Dest
: constant Val_2
:=
226 Get_Val_2
(Dest_Address
, Dest_Offset
, Size
);
227 New_Dest
: constant Val_2
:=
228 Set_Bitfield
(Src_Value
, Old_Dest
, Dest_Offset
, Size
);
230 Set_Val_2
(Dest_Address
, Dest_Offset
, New_Dest
, Size
);
233 procedure Copy_Small_Bitfield
234 (Src_Address
: Address
;
235 Src_Offset
: Bit_Offset
;
236 Dest_Address
: Address
;
237 Dest_Offset
: Bit_Offset
;
240 Src
: constant Val_2
:= Get_Val_2
(Src_Address
, Src_Offset
, Size
);
241 V
: constant Val
:= Get_Bitfield
(Src
, Src_Offset
, Size
);
243 Set_Bitfield
(V
, Dest_Address
, Dest_Offset
, Size
);
244 end Copy_Small_Bitfield
;
246 -- Copy_Large_Bitfield does the main work. Copying aligned Vals is more
247 -- efficient than fiddling with shifting and whatnot. But we can't align
248 -- both source and destination. We choose to align the destination,
249 -- because that's more efficient -- Set_Bitfield needs to read, then
250 -- modify, then write, whereas Get_Bitfield does not.
255 -- If the destination is not already aligned, copy Initial_Size
256 -- bits, and increment the bit addresses. Initial_Size is chosen to
257 -- be the smallest size that will cause the destination bit address
258 -- to be aligned (i.e. have zero bit offset from the already-aligned
259 -- Address). Get_Bitfield and Set_Bitfield are used here.
262 -- Loop, copying Vals. Get_Bitfield is used to fetch a Val-sized
263 -- bit field, but Set_Bitfield is not needed -- we can set the
264 -- aligned Val with an array indexing.
267 -- Copy remaining smaller-than-Val bits, if any
269 procedure Copy_Large_Bitfield
270 (Src_Address
: Address
;
271 Src_Offset
: Bit_Offset
;
272 Dest_Address
: Address
;
273 Dest_Offset
: Bit_Offset
;
276 Sz
: Bit_Size
:= Size
;
277 S_Addr
: Address
:= Src_Address
;
278 S_Off
: Bit_Offset
:= Src_Offset
;
279 D_Addr
: Address
:= Dest_Address
;
280 D_Off
: Bit_Offset
:= Dest_Offset
;
282 if S_Addr
< D_Addr
or else (S_Addr
= D_Addr
and then S_Off
< D_Off
)
284 -- Here, the source bit address is less than the destination bit
285 -- address. Assert that there is no overlap.
288 Temp_Off
: constant Bit_Offset
'Base := S_Off
+ Size
;
289 After_S_Addr
: constant Address
:=
290 S_Addr
+ Address
(Temp_Off
/ Storage_Unit
);
291 After_S_Off
: constant Bit_Offset_In_Byte
:=
292 Temp_Off
mod Storage_Unit
;
293 -- (After_S_Addr, After_S_Off) is the bit address of the bit
294 -- just after the source bit field. Assert that it's less than
295 -- or equal to the destination bit address.
296 Overlap_OK
: constant Boolean :=
297 After_S_Addr
< D_Addr
299 (After_S_Addr
= D_Addr
and then After_S_Off
<= D_Off
);
301 pragma Assert
(Overlap_OK
);
309 Initial_Size
: constant Small_Size
:= Val
'Size - D_Off
;
310 Initial_Val_2
: constant Val_2
:=
311 Get_Val_2
(S_Addr
, S_Off
, Initial_Size
);
312 Initial_Val
: constant Val
:=
313 Get_Bitfield
(Initial_Val_2
, S_Off
, Initial_Size
);
317 (Initial_Val
, D_Addr
, D_Off
, Initial_Size
);
319 Sz
:= Sz
- Initial_Size
;
321 New_S_Off
: constant Bit_Offset
'Base := S_Off
+ Initial_Size
;
323 if New_S_Off
> Bit_Offset
'Last then
324 S_Addr
:= S_Addr
+ Val_Bytes
;
325 S_Off
:= New_S_Off
- Small_Size
'Last;
330 D_Addr
:= D_Addr
+ Val_Bytes
;
331 pragma Assert
(D_Off
+ Initial_Size
= Val
'Size);
339 Dest_Arr
: Val_Array
(1 .. Sz
/ Val
'Size) with Import
,
342 for Dest_Comp
of Dest_Arr
loop
344 pragma Warnings
(Off
);
345 pragma Assert
(Dest_Comp
in Val
);
346 pragma Warnings
(On
);
347 pragma Assert
(Dest_Comp
'Valid);
348 Src_V_2
: constant Val_2
:=
349 Get_Val_2
(S_Addr
, S_Off
, Val
'Size);
350 Full_V
: constant Val
:=
351 Get_Bitfield
(Src_V_2
, S_Off
, Val
'Size);
354 S_Addr
:= S_Addr
+ Val_Bytes
;
355 -- S_Off remains the same
359 Sz
:= Sz
mod Val
'Size;
364 Final_Val_2
: constant Val_2
:=
365 Get_Val_2
(S_Addr
, S_Off
, Sz
);
366 Final_Val
: constant Val
:=
367 Get_Bitfield
(Final_Val_2
, S_Off
, Sz
);
370 (Final_Val
, D_Addr
+ Dest_Arr
'Length * Val_Bytes
, 0, Sz
);
374 end Copy_Large_Bitfield
;
376 procedure Copy_Bitfield
377 (Src_Address
: Address
;
378 Src_Offset
: Bit_Offset_In_Byte
;
379 Dest_Address
: Address
;
380 Dest_Offset
: Bit_Offset_In_Byte
;
383 -- Align the Address values as for Val and Val_2, and adjust the
384 -- Bit_Offsets accordingly.
386 Src_Adjust
: constant Storage_Offset
:= Src_Address
mod Val_Bytes
;
387 Al_Src_Address
: constant Address
:= Src_Address
- Src_Adjust
;
388 Al_Src_Offset
: constant Bit_Offset
:=
389 Src_Offset
+ Bit_Offset
(Src_Adjust
* Storage_Unit
);
391 Dest_Adjust
: constant Storage_Offset
:=
392 Dest_Address
mod Val_Bytes
;
393 Al_Dest_Address
: constant Address
:= Dest_Address
- Dest_Adjust
;
394 Al_Dest_Offset
: constant Bit_Offset
:=
395 Dest_Offset
+ Bit_Offset
(Dest_Adjust
* Storage_Unit
);
397 pragma Assert
(Al_Src_Address
mod Storage_Count
'(Val'Alignment) = 0);
398 pragma Assert (Al_Dest_Address mod Storage_Count'(Val
'Alignment) = 0);
400 -- Optimized small case
402 if Size
in Small_Size
then
404 (Al_Src_Address
, Al_Src_Offset
,
405 Al_Dest_Address
, Al_Dest_Offset
,
408 -- Do nothing for zero size. This is necessary to avoid doing invalid
409 -- reads, which are detected by valgrind.
418 (Al_Src_Address
, Al_Src_Offset
,
419 Al_Dest_Address
, Al_Dest_Offset
,
424 function Fast_Copy_Bitfield
426 Src_Offset
: Bit_Offset
;
428 Dest_Offset
: Bit_Offset
;
431 Result
: constant Val_2
:= Set_Bitfield
432 (Get_Bitfield
(Src
, Src_Offset
, Size
), Dest
, Dest_Offset
, Size
);
434 -- No need to explicitly do nothing for zero size case, because Size
438 end Fast_Copy_Bitfield
;
442 end System
.Bitfield_Utils
;