+2019-08-21 Bob Duff <duff@adacore.com>
+
+ * Makefile.rtl (GNATRTL_NONTASKING_OBJS): Add s-bitutil.o and
+ s-biutin.o.
+ * exp_ch5.adb (Expand_Assign_Array_Bitfield): New function to
+ generate a call to Copy_Bitfield. This is disabled for now.
+ (Expand_Assign_Array_Loop_Or_Bitfield): New function to decide
+ whether to call Expand_Assign_Array_Bitfield.
+ (Expand_Assign_Array): Call Expand_Assign_Array_Loop_Or_Bitfield
+ instead of Expand_Assign_Array_Loop.
+ * libgnat/s-bitfie.ads, libgnat/s-bituti.adb,
+ libgnat/s-bituti.ads: New units.
+ * rtsfind.ads: Add enum literals for accessing Copy_Bitfield.
+
2019-08-21 Piotr Trojanek <trojanek@adacore.com>
* bindo-graphs.ads (Iterate_Edges_To_Successors): Fix typo in
s-atopri$(objext) \
s-auxdec$(objext) \
s-bignum$(objext) \
+ s-bitfie$(objext) \
s-bitops$(objext) \
+ s-bituti$(objext) \
s-boarop$(objext) \
s-boustr$(objext) \
s-bytswa$(objext) \
-- Auxiliary declarations are inserted before node N using the standard
-- Insert_Actions mechanism.
+ function Expand_Assign_Array_Bitfield
+ (N : Node_Id;
+ Larray : Entity_Id;
+ Rarray : Entity_Id;
+ L_Type : Entity_Id;
+ R_Type : Entity_Id;
+ Rev : Boolean) return Node_Id;
+ -- Alternative to Expand_Assign_Array_Loop for packed bitfields. Generates
+ -- a call to the System.Bitfields.Copy_Bitfield, which is more efficient
+ -- than copying component-by-component.
+
+ function Expand_Assign_Array_Loop_Or_Bitfield
+ (N : Node_Id;
+ Larray : Entity_Id;
+ Rarray : Entity_Id;
+ L_Type : Entity_Id;
+ R_Type : Entity_Id;
+ Ndim : Pos;
+ Rev : Boolean) return Node_Id;
+ -- Calls either Expand_Assign_Array_Loop or Expand_Assign_Array_Bitfield as
+ -- appropriate.
+
procedure Expand_Assign_Record (N : Node_Id);
-- N is an assignment of an untagged record value. This routine handles
-- the case where the assignment must be made component by component,
Crep : constant Boolean := Change_Of_Representation (N);
+ pragma Assert
+ (Crep
+ or else Is_Bit_Packed_Array (L_Type) = Is_Bit_Packed_Array (R_Type));
+
Larray : Node_Id;
Rarray : Node_Id;
else
Rewrite (N,
- Expand_Assign_Array_Loop
+ Expand_Assign_Array_Loop_Or_Bitfield
(N, Larray, Rarray, L_Type, R_Type, Ndim,
Rev => not Forwards_OK (N)));
end if;
Condition => Condition,
Then_Statements => New_List (
- Expand_Assign_Array_Loop
+ Expand_Assign_Array_Loop_Or_Bitfield
(N, Larray, Rarray, L_Type, R_Type, Ndim,
Rev => False)),
Else_Statements => New_List (
- Expand_Assign_Array_Loop
+ Expand_Assign_Array_Loop_Or_Bitfield
(N, Larray, Rarray, L_Type, R_Type, Ndim,
Rev => True))));
end if;
return Assign;
end Expand_Assign_Array_Loop;
+ ----------------------------------
+ -- Expand_Assign_Array_Bitfield --
+ ----------------------------------
+
+ function Expand_Assign_Array_Bitfield
+ (N : Node_Id;
+ Larray : Entity_Id;
+ Rarray : Entity_Id;
+ L_Type : Entity_Id;
+ R_Type : Entity_Id;
+ Rev : Boolean) return Node_Id
+ is
+ pragma Assert (not Rev);
+ -- Reverse copying is not yet supported by Copy_Bitfield.
+
+ pragma Assert (not Change_Of_Representation (N));
+ -- This won't work, for example, to copy a packed array to an unpacked
+ -- array.
+
+ Loc : constant Source_Ptr := Sloc (N);
+
+ L_Index_Typ : constant Node_Id := Etype (First_Index (L_Type));
+ R_Index_Typ : constant Node_Id := Etype (First_Index (R_Type));
+ Left_Lo : constant Node_Id := Type_Low_Bound (L_Index_Typ);
+ Right_Lo : constant Node_Id := Type_Low_Bound (R_Index_Typ);
+
+ L_Addr : constant Node_Id :=
+ Make_Attribute_Reference (Loc,
+ Prefix =>
+ Make_Indexed_Component (Loc,
+ Prefix =>
+ Duplicate_Subexpr (Larray, True),
+ Expressions => New_List (New_Copy_Tree (Left_Lo))),
+ Attribute_Name => Name_Address);
+
+ L_Bit : constant Node_Id :=
+ Make_Attribute_Reference (Loc,
+ Prefix =>
+ Make_Indexed_Component (Loc,
+ Prefix =>
+ Duplicate_Subexpr (Larray, True),
+ Expressions => New_List (New_Copy_Tree (Left_Lo))),
+ Attribute_Name => Name_Bit);
+
+ R_Addr : constant Node_Id :=
+ Make_Attribute_Reference (Loc,
+ Prefix =>
+ Make_Indexed_Component (Loc,
+ Prefix =>
+ Duplicate_Subexpr (Rarray, True),
+ Expressions => New_List (New_Copy_Tree (Right_Lo))),
+ Attribute_Name => Name_Address);
+
+ R_Bit : constant Node_Id :=
+ Make_Attribute_Reference (Loc,
+ Prefix =>
+ Make_Indexed_Component (Loc,
+ Prefix =>
+ Duplicate_Subexpr (Rarray, True),
+ Expressions => New_List (New_Copy_Tree (Right_Lo))),
+ Attribute_Name => Name_Bit);
+
+ -- Compute the Size of the bitfield. ???We can't use Size here, because
+ -- it doesn't work properly for slices of packed arrays, so we compute
+ -- the L'Size as L'Length*L'Component_Size.
+ --
+ -- Note that the length check has already been done, so we can use the
+ -- size of either L or R.
+
+ Size : constant Node_Id :=
+ Make_Op_Multiply (Loc,
+ Make_Attribute_Reference (Loc,
+ Prefix =>
+ Duplicate_Subexpr (Name (N), True),
+ Attribute_Name => Name_Length),
+ Make_Attribute_Reference (Loc,
+ Prefix =>
+ Duplicate_Subexpr (Name (N), True),
+ Attribute_Name => Name_Component_Size));
+
+ begin
+ return Make_Procedure_Call_Statement (Loc,
+ Name => New_Occurrence_Of (RTE (RE_Copy_Bitfield), Loc),
+ Parameter_Associations => New_List (
+ R_Addr, R_Bit, L_Addr, L_Bit, Size));
+ end Expand_Assign_Array_Bitfield;
+
+ ------------------------------------------
+ -- Expand_Assign_Array_Loop_Or_Bitfield --
+ ------------------------------------------
+
+ function Expand_Assign_Array_Loop_Or_Bitfield
+ (N : Node_Id;
+ Larray : Entity_Id;
+ Rarray : Entity_Id;
+ L_Type : Entity_Id;
+ R_Type : Entity_Id;
+ Ndim : Pos;
+ Rev : Boolean) return Node_Id
+ is
+ Slices : constant Boolean :=
+ Nkind (Name (N)) = N_Slice or else Nkind (Expression (N)) = N_Slice;
+ begin
+ -- Determine whether Copy_Bitfield is appropriate (will work, and will
+ -- be more efficient than component-by-component copy). Copy_Bitfield
+ -- doesn't work for reversed storage orders. It is efficient only for
+ -- slices of bit-packed arrays.
+
+ -- Note that Expand_Assign_Array_Bitfield is disabled for now
+
+ if False -- ???
+ and then Is_Bit_Packed_Array (L_Type)
+ and then Is_Bit_Packed_Array (R_Type)
+ and then RTE_Available (RE_Copy_Bitfield)
+ and then not Reverse_Storage_Order (L_Type)
+ and then not Reverse_Storage_Order (R_Type)
+ and then Ndim = 1
+ and then not Rev
+ and then Slices
+ then
+ return Expand_Assign_Array_Bitfield
+ (N, Larray, Rarray, L_Type, R_Type, Rev);
+ else
+ return Expand_Assign_Array_Loop
+ (N, Larray, Rarray, L_Type, R_Type, Ndim, Rev);
+ end if;
+ end Expand_Assign_Array_Loop_Or_Bitfield;
+
--------------------------
-- Expand_Assign_Record --
--------------------------
--- /dev/null
+------------------------------------------------------------------------------
+-- --
+-- GNAT RUN-TIME COMPONENTS --
+-- --
+-- S Y S T E M . B I T F I E L D _ U T I L S --
+-- --
+-- S p e c --
+-- --
+-- 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 --
+-- <http://www.gnu.org/licenses/>. --
+-- --
+-- GNAT was originally developed by the GNAT team at New York University. --
+-- Extensive contributions were provided by Ada Core Technologies Inc. --
+-- --
+------------------------------------------------------------------------------
+
+with System.Bitfield_Utils;
+
+package System.Bitfields is
+
+ -- Instances of the generic package in System.Bitfield_Utils. So far
+ -- we have just one, which defaults to the natural endianness of the
+ -- machine. We might someday want to support Scalar_Storage_Order.
+
+ Val_Bytes : constant := 4;
+ Val_Bits : constant := Val_Bytes * System.Storage_Unit;
+ type Val_2 is mod 2**(Val_Bits * 2) with Alignment => Val_Bytes;
+ pragma Provide_Shift_Operators (Val_2);
+ type Val is mod 2**Val_Bits with Alignment => Val_Bytes;
+
+ package Utils is new System.Bitfield_Utils.G (Val, Val_2);
+
+ procedure Copy_Bitfield
+ (Src_Address : Address;
+ Src_Offset : Utils.Bit_Offset_In_Byte;
+ Dest_Address : Address;
+ Dest_Offset : Utils.Bit_Offset_In_Byte;
+ Size : Utils.Bit_Size)
+ renames Utils.Copy_Bitfield;
+
+end System.Bitfields;
--- /dev/null
+------------------------------------------------------------------------------
+-- --
+-- 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 --
+-- <http://www.gnu.org/licenses/>. --
+-- --
+-- 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;
--- /dev/null
+------------------------------------------------------------------------------
+-- --
+-- GNAT RUN-TIME COMPONENTS --
+-- --
+-- S Y S T E M . B I T F I E L D _ U T I L S --
+-- --
+-- S p e c --
+-- --
+-- 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 --
+-- <http://www.gnu.org/licenses/>. --
+-- --
+-- GNAT was originally developed by the GNAT team at New York University. --
+-- Extensive contributions were provided by Ada Core Technologies Inc. --
+-- --
+------------------------------------------------------------------------------
+
+package System.Bitfield_Utils is
+
+ -- This package provides a procedure for copying arbitrarily large and
+ -- arbitrarily bit-aligned bit fields.
+
+ -- Type Val is used to represent small bit fields. Val_2 represents a
+ -- contiguous pair of Vals. Val_2'Alignment is half of its size in bytes,
+ -- which is likely not the natural alignment. This is done to ensure that
+ -- any bit field that fits in a Val can fit in an aligned Val_2, starting
+ -- somewhere in the first half, and possibly crossing over into the second
+ -- half. This allows us to isolate a Val value by shifting and masking the
+ -- Val_2.
+ --
+ -- Val can be 8, 16, or 32 bits; larger values are more efficient. It can't
+ -- be 64 bits, because we need Val_2 to be a double-wide shiftable type,
+ -- and 128 bits is not supported. Instantiating with an 8-bit Val is useful
+ -- for testing and debugging; 32 bits should be used for production.
+ --
+ -- We use modular types here, not because we want modular arithmetic, but
+ -- so we can do shifting and masking. The actual for Val_2 should have
+ -- pragma Provide_Shift_Operators, so that the Shift_Left and Shift_Right
+ -- intrinsics can be passed in. It is impossible to put that pragma on a
+ -- generic formal, or on a type derived from a generic formal, so they have
+ -- to be passed in.
+ --
+ -- Endian indicates whether we're on little-endian or big-endian machine.
+
+ pragma Elaborate_Body;
+
+ Little : constant Bit_Order := Low_Order_First;
+ Big : constant Bit_Order := High_Order_First;
+
+ generic
+ type Val is mod <>;
+ type Val_2 is mod <>;
+
+ with function Shift_Left
+ (Value : Val_2;
+ Amount : Natural) return Val_2 is <>;
+
+ with function Shift_Right
+ (Value : Val_2;
+ Amount : Natural) return Val_2 is <>;
+
+ Endian : Bit_Order := Default_Bit_Order;
+
+ package G is
+ -- Assert that Val has one of the allowed sizes, and that Val_2 is twice
+ -- that.
+
+ pragma Assert (Val'Size in 8 | 16 | 32);
+ pragma Assert (Val_2'Size = Val'Size * 2);
+
+ -- Assert that both are aligned the same, to the size in bytes of Val
+ -- (not Val_2).
+
+ pragma Assert (Val'Alignment = Val'Size / Storage_Unit);
+ pragma Assert (Val_2'Alignment = Val'Alignment);
+
+ type Val_Array is array (Positive range <>) of Val;
+
+ -- It might make more sense to have:
+ -- subtype Val is Val_2 range 0 .. 2**Val'Size - 1;
+ -- But then GNAT gets the component size of Val_Array wrong.
+
+ pragma Assert (Val_Array'Alignment = Val'Alignment);
+ pragma Assert (Val_Array'Component_Size = Val'Size);
+
+ subtype Bit_Size is Natural; -- Size in bits of a bit field
+ subtype Small_Size is Bit_Size range 0 .. Val'Size;
+ -- Size of a small one
+ subtype Bit_Offset is Small_Size range 0 .. Val'Size - 1;
+ -- Starting offset
+ subtype Bit_Offset_In_Byte is Bit_Offset range 0 .. Storage_Unit - 1;
+
+ procedure Copy_Bitfield
+ (Src_Address : Address;
+ Src_Offset : Bit_Offset_In_Byte;
+ Dest_Address : Address;
+ Dest_Offset : Bit_Offset_In_Byte;
+ Size : Bit_Size);
+ -- An Address and a Bit_Offset together form a "bit address". This
+ -- copies the source bit field to the destination. Size is the size in
+ -- bits of the bit field. The bit fields can be arbitrarily large, but
+ -- the starting offsets must be within the first byte that the Addresses
+ -- point to. The Address values need not be aligned.
+ --
+ -- For example, a slice assignment of a packed bit field:
+ --
+ -- D (D_First .. D_Last) := S (S_First .. S_Last);
+ --
+ -- can be implemented using:
+ --
+ -- Copy_Bitfield
+ -- (S (S_First)'Address, S (S_First)'Bit,
+ -- D (D_First)'Address, D (D_First)'Bit,
+ -- Size);
+
+ end G;
+
+end System.Bitfield_Utils;
System_Atomic_Primitives,
System_Aux_DEC,
System_Bignums,
+ System_Bitfields,
System_Bit_Ops,
System_Boolean_Array_Operations,
System_Byte_Swapping,
RE_To_Bignum, -- System.Bignums
RE_From_Bignum, -- System.Bignums
+ RE_Copy_Bitfield, -- System.Bitfields
+
RE_Bit_And, -- System.Bit_Ops
RE_Bit_Eq, -- System.Bit_Ops
RE_Bit_Not, -- System.Bit_Ops
RE_To_Bignum => System_Bignums,
RE_From_Bignum => System_Bignums,
+ RE_Copy_Bitfield => System_Bitfields,
+
RE_Bit_And => System_Bit_Ops,
RE_Bit_Eq => System_Bit_Ops,
RE_Bit_Not => System_Bit_Ops,
projects / gcc.git / commitdiff