From 814f5f0e301c6e6a555de8954e05f7e38b61903a Mon Sep 17 00:00:00 2001 From: pmderodat Date: Wed, 21 Aug 2019 08:30:53 +0000 Subject: [PATCH] [Ada] Add the System.Bitfield_Utils runtime unit 2019-08-21 Bob Duff gcc/ada/ * 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. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@274785 138bc75d-0d04-0410-961f-82ee72b054a4 --- gcc/ada/ChangeLog | 14 ++ gcc/ada/Makefile.rtl | 2 + gcc/ada/exp_ch5.adb | 160 +++++++++++++++++- gcc/ada/libgnat/s-bitfie.ads | 56 ++++++ gcc/ada/libgnat/s-bituti.adb | 320 +++++++++++++++++++++++++++++++++++ gcc/ada/libgnat/s-bituti.ads | 132 +++++++++++++++ gcc/ada/rtsfind.ads | 5 + 7 files changed, 686 insertions(+), 3 deletions(-) create mode 100644 gcc/ada/libgnat/s-bitfie.ads create mode 100644 gcc/ada/libgnat/s-bituti.adb create mode 100644 gcc/ada/libgnat/s-bituti.ads diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 2aceec161b66..62a06d6ce8a1 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,17 @@ +2019-08-21 Bob Duff + + * 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 * bindo-graphs.ads (Iterate_Edges_To_Successors): Fix typo in diff --git a/gcc/ada/Makefile.rtl b/gcc/ada/Makefile.rtl index c1a422fae1ea..e5aa6b8eeacc 100644 --- a/gcc/ada/Makefile.rtl +++ b/gcc/ada/Makefile.rtl @@ -502,7 +502,9 @@ GNATRTL_NONTASKING_OBJS= \ 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) \ diff --git a/gcc/ada/exp_ch5.adb b/gcc/ada/exp_ch5.adb index 682c855d39b1..ba0b793132f9 100644 --- a/gcc/ada/exp_ch5.adb +++ b/gcc/ada/exp_ch5.adb @@ -114,6 +114,28 @@ package body Exp_Ch5 is -- 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, @@ -314,6 +336,10 @@ package body Exp_Ch5 is 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; @@ -939,7 +965,7 @@ package body Exp_Ch5 is 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; @@ -1092,12 +1118,12 @@ package body Exp_Ch5 is 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; @@ -1320,6 +1346,134 @@ package body Exp_Ch5 is 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 -- -------------------------- diff --git a/gcc/ada/libgnat/s-bitfie.ads b/gcc/ada/libgnat/s-bitfie.ads new file mode 100644 index 000000000000..1b62b9d10775 --- /dev/null +++ b/gcc/ada/libgnat/s-bitfie.ads @@ -0,0 +1,56 @@ +------------------------------------------------------------------------------ +-- -- +-- 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 -- +-- . -- +-- -- +-- 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; diff --git a/gcc/ada/libgnat/s-bituti.adb b/gcc/ada/libgnat/s-bituti.adb new file mode 100644 index 000000000000..78e391b9626a --- /dev/null +++ b/gcc/ada/libgnat/s-bituti.adb @@ -0,0 +1,320 @@ +------------------------------------------------------------------------------ +-- -- +-- 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; diff --git a/gcc/ada/libgnat/s-bituti.ads b/gcc/ada/libgnat/s-bituti.ads new file mode 100644 index 000000000000..1e446c142b25 --- /dev/null +++ b/gcc/ada/libgnat/s-bituti.ads @@ -0,0 +1,132 @@ +------------------------------------------------------------------------------ +-- -- +-- 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 -- +-- . -- +-- -- +-- 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; diff --git a/gcc/ada/rtsfind.ads b/gcc/ada/rtsfind.ads index eab6f4fb2202..9d5a86cdb72b 100644 --- a/gcc/ada/rtsfind.ads +++ b/gcc/ada/rtsfind.ads @@ -220,6 +220,7 @@ package Rtsfind is System_Atomic_Primitives, System_Aux_DEC, System_Bignums, + System_Bitfields, System_Bit_Ops, System_Boolean_Array_Operations, System_Byte_Swapping, @@ -809,6 +810,8 @@ package Rtsfind is 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 @@ -2051,6 +2054,8 @@ package Rtsfind is 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, -- 2.39.2