------------------------------------------------------------------------------ -- -- -- GNAT RUN-TIME COMPONENTS -- -- -- -- S Y S T E M . B I T F I E L D _ U T I L S -- -- -- -- B o d y -- -- -- -- Copyright (C) 2019, Free Software Foundation, Inc. -- -- -- -- GNAT is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free Soft- -- -- ware Foundation; either version 3, or (at your option) any later ver- -- -- sion. GNAT is distributed in the hope that it will be useful, but WITH- -- -- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY -- -- or FITNESS FOR A PARTICULAR PURPOSE. -- -- -- -- As a special exception under Section 7 of GPL version 3, you are granted -- -- additional permissions described in the GCC Runtime Library Exception, -- -- version 3.1, as published by the Free Software Foundation. -- -- -- -- You should have received a copy of the GNU General Public License and -- -- a copy of the GCC Runtime Library Exception along with this program; -- -- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see -- -- . -- -- -- -- GNAT was originally developed by the GNAT team at New York University. -- -- Extensive contributions were provided by Ada Core Technologies Inc. -- -- -- ------------------------------------------------------------------------------ package body System.Bitfield_Utils is -- ??? -- -- This code does not yet work for overlapping bit fields. We need to copy -- backwards in some cases (i.e. from higher to lower bit addresses). -- Alternatively, we could avoid calling this if Forwards_OK is False. -- -- ??? package body G is Val_Bytes : constant Address := Address (Val'Size / Storage_Unit); -- Get_Bitfield and Set_Bitfield are helper functions that get/set small -- bit fields -- the value fits in Val, and the bit field is placed -- starting at some offset within the first half of a Val_2. -- Copy_Bitfield, on the other hand, supports arbitrarily large bit -- fields. All operations require bit offsets to point within the first -- Val pointed to by the address. function Get_Bitfield (Src : Val_2; Src_Offset : Bit_Offset; Size : Small_Size) return Val; -- Returns the bit field in Src starting at Src_Offset, of the given -- Size. If Size < Small_Size'Last, then high order bits are zero. function Get_Full_Bitfield (Src : Val_2; Src_Offset : Bit_Offset) return Val; -- Same as Get_Bitfield, except the Size is hardwired to the maximum -- allowed. function Set_Bitfield (Src_Value : Val; Dest : Val_2; Dest_Offset : Bit_Offset; Size : Small_Size) return Val_2; -- The bit field in Dest starting at Dest_Offset, of the given Size, is -- set to Src_Value. Src_Value must have high order bits (Size and -- above) zero. The result is returned as the function result. function Get_Bitfield (Src : Val_2; Src_Offset : Bit_Offset; Size : Small_Size) return Val is L_Shift_Amount : constant Natural := (case Endian is when Little => Val_2'Size - (Src_Offset + Size), when Big => Src_Offset); Temp1 : constant Val_2 := Shift_Left (Src, L_Shift_Amount); Temp2 : constant Val_2 := Shift_Right (Temp1, Val_2'Size - Size); begin return Val (Temp2); end Get_Bitfield; function Get_Full_Bitfield (Src : Val_2; Src_Offset : Bit_Offset) return Val is begin return Get_Bitfield (Src, Src_Offset, Size => Val'Size); end Get_Full_Bitfield; function Set_Bitfield (Src_Value : Val; Dest : Val_2; Dest_Offset : Bit_Offset; Size : Small_Size) return Val_2 is pragma Assert (Size = Val'Size or else Src_Value < 2**Size); L_Shift_Amount : constant Natural := (case Endian is when Little => Dest_Offset, when Big => Val_2'Size - (Dest_Offset + Size)); Mask : constant Val_2 := Shift_Left (Shift_Left (1, Size) - 1, L_Shift_Amount); Temp1 : constant Val_2 := Dest and not Mask; Temp2 : constant Val_2 := Shift_Left (Val_2 (Src_Value), L_Shift_Amount); Result : constant Val_2 := Temp1 or Temp2; begin return Result; end Set_Bitfield; procedure Copy_Small_Bitfield (Src_Address : Address; Src_Offset : Bit_Offset; Dest_Address : Address; Dest_Offset : Bit_Offset; Size : Small_Size); -- Copy_Bitfield in the case where Size <= Val'Size. -- The Address values must be aligned as for Val and Val_2. -- This works for overlapping bit fields. procedure Copy_Large_Bitfield (Src_Address : Address; Src_Offset : Bit_Offset; Dest_Address : Address; Dest_Offset : Bit_Offset; Size : Bit_Size); -- Copy_Bitfield in the case where Size > Val'Size. -- The Address values must be aligned as for Val and Val_2. -- This works for overlapping bit fields only if the source -- bit address is greater than or equal to the destination -- bit address, because it copies forward (from lower to higher -- bit addresses). procedure Copy_Small_Bitfield (Src_Address : Address; Src_Offset : Bit_Offset; Dest_Address : Address; Dest_Offset : Bit_Offset; Size : Small_Size) is Src : constant Val_2 with Import, Address => Src_Address; V : constant Val := Get_Bitfield (Src, Src_Offset, Size); Dest : Val_2 with Import, Address => Dest_Address; begin Dest := Set_Bitfield (V, Dest, Dest_Offset, Size); end Copy_Small_Bitfield; -- Copy_Large_Bitfield does the main work. Copying aligned Vals is more -- efficient than fiddling with shifting and whatnot. But we can't align -- both source and destination. We choose to align the destination, -- because that's more efficient -- Set_Bitfield needs to read, then -- modify, then write, whereas Get_Bitfield does not. -- -- So the method is: -- -- Step 1: -- If the destination is not already aligned, copy Initial_Size -- bits, and increment the bit addresses. Initial_Size is chosen to -- be the smallest size that will cause the destination bit address -- to be aligned (i.e. have zero bit offset from the already-aligned -- Address). Get_Bitfield and Set_Bitfield are used here. -- -- Step 2: -- Loop, copying Vals. Get_Full_Bitfield is used to fetch a -- Val-sized bit field, but Set_Bitfield is not needed -- we can set -- the aligned Val with an array indexing. -- -- Step 3: -- Copy remaining smaller-than-Val bits, if any procedure Copy_Large_Bitfield (Src_Address : Address; Src_Offset : Bit_Offset; Dest_Address : Address; Dest_Offset : Bit_Offset; Size : Bit_Size) is Sz : Bit_Size := Size; S_Addr : Address := Src_Address; S_Off : Bit_Offset := Src_Offset; D_Addr : Address := Dest_Address; D_Off : Bit_Offset := Dest_Offset; begin if S_Addr < D_Addr or else (S_Addr = D_Addr and then S_Off < D_Off) then -- Here, the source bit address is less than the destination bit -- address. Assert that there is no overlap. declare Temp_Off : constant Bit_Offset'Base := S_Off + Size; After_S_Addr : constant Address := S_Addr + Address (Temp_Off / Storage_Unit); After_S_Off : constant Bit_Offset_In_Byte := Temp_Off mod Storage_Unit; -- (After_S_Addr, After_S_Off) is the bit address of the bit -- just after the source bit field. Assert that it's less than -- or equal to the destination bit address. Overlap_OK : constant Boolean := After_S_Addr < D_Addr or else (After_S_Addr = D_Addr and then After_S_Off <= D_Off); begin pragma Assert (Overlap_OK); end; end if; if D_Off /= 0 then -- Step 1: declare Initial_Size : constant Small_Size := Val'Size - D_Off; Initial_Val_2 : constant Val_2 with Import, Address => S_Addr; Initial_Val : constant Val := Get_Bitfield (Initial_Val_2, S_Off, Initial_Size); Initial_Dest : Val_2 with Import, Address => D_Addr; begin Initial_Dest := Set_Bitfield (Initial_Val, Initial_Dest, D_Off, Initial_Size); Sz := Sz - Initial_Size; declare New_S_Off : constant Bit_Offset'Base := S_Off + Initial_Size; begin if New_S_Off > Bit_Offset'Last then S_Addr := S_Addr + Val_Bytes; S_Off := New_S_Off - Small_Size'Last; else S_Off := New_S_Off; end if; end; D_Addr := D_Addr + Val_Bytes; pragma Assert (D_Off + Initial_Size = Val'Size); D_Off := 0; end; end if; -- Step 2: declare Dest_Arr : Val_Array (1 .. Sz / Val'Size) with Import, Address => D_Addr; begin for Dest_Comp of Dest_Arr loop declare pragma Warnings (Off); pragma Assert (Dest_Comp in Val); pragma Warnings (On); pragma Assert (Dest_Comp'Valid); Src_V_2 : constant Val_2 with Import, Address => S_Addr; Full_V : constant Val := Get_Full_Bitfield (Src_V_2, S_Off); begin Dest_Comp := Full_V; S_Addr := S_Addr + Val_Bytes; -- S_Off remains the same end; end loop; if Sz mod Val'Size /= 0 then -- Step 3: declare Final_Val_2 : constant Val_2 with Import, Address => S_Addr; Final_Val : constant Val := Get_Bitfield (Final_Val_2, S_Off, Sz mod Val'Size); Final_Dest : Val_2 with Import, Address => D_Addr + Dest_Arr'Length * Val_Bytes; begin Final_Dest := Set_Bitfield (Final_Val, Final_Dest, 0, Sz mod Val'Size); end; end if; end; end Copy_Large_Bitfield; procedure Copy_Bitfield (Src_Address : Address; Src_Offset : Bit_Offset_In_Byte; Dest_Address : Address; Dest_Offset : Bit_Offset_In_Byte; Size : Bit_Size) is -- Align the Address values as for Val and Val_2, and adjust the -- Bit_Offsets accordingly. Src_Adjust : constant Address := Src_Address mod Val_Bytes; Al_Src_Address : constant Address := Src_Address - Src_Adjust; Al_Src_Offset : constant Bit_Offset := Src_Offset + Bit_Offset (Src_Adjust * Storage_Unit); Dest_Adjust : constant Address := Dest_Address mod Val_Bytes; Al_Dest_Address : constant Address := Dest_Address - Dest_Adjust; Al_Dest_Offset : constant Bit_Offset := Dest_Offset + Bit_Offset (Dest_Adjust * Storage_Unit); pragma Assert (Al_Src_Address mod Val'Alignment = 0); pragma Assert (Al_Dest_Address mod Val'Alignment = 0); begin if Size in Small_Size then Copy_Small_Bitfield (Al_Src_Address, Al_Src_Offset, Al_Dest_Address, Al_Dest_Offset, Size); else Copy_Large_Bitfield (Al_Src_Address, Al_Src_Offset, Al_Dest_Address, Al_Dest_Offset, Size); end if; end Copy_Bitfield; end G; end System.Bitfield_Utils;