From: Bob Duff Date: Tue, 30 Mar 2021 11:15:39 +0000 (-0400) Subject: [Ada] Improve efficiency of small slice assignments of packed arrays X-Git-Tag: basepoints/gcc-13~6624 X-Git-Url: http://git.ipfire.org/?a=commitdiff_plain;h=9418d3d41f581edd9acfdc4f359d37f948c1671e;p=thirdparty%2Fgcc.git [Ada] Improve efficiency of small slice assignments of packed arrays gcc/ada/ * rtsfind.ads, libgnat/s-bitfie.ads, libgnat/s-bituti.adb, libgnat/s-bituti.ads (Fast_Copy_Bitfield): New run-time library function to copy bit fields faster than Copy_Bitfield. Cannot be called with zero-size bit fields. Remove obsolete ??? comments from s-bituti.adb; we already do "avoid calling this if Forwards_OK is False". * exp_ch5.adb (Expand_Assign_Array_Loop_Or_Bitfield, Expand_Assign_Array_Bitfield_Fast): Generate calls to Fast_Copy_Bitfield when appropriate. * sem_util.adb, sem_util.ads (Get_Index_Bounds): Two new functions for getting the index bounds. These are more convenient than the procedure of the same name, because they can be used to initialize constants. --- diff --git a/gcc/ada/exp_ch5.adb b/gcc/ada/exp_ch5.adb index cd9ab2903664..39e2e0cb71c3 100644 --- a/gcc/ada/exp_ch5.adb +++ b/gcc/ada/exp_ch5.adb @@ -64,6 +64,7 @@ with Snames; use Snames; with Stand; use Stand; with Stringt; use Stringt; with Tbuild; use Tbuild; +with Ttypes; use Ttypes; with Uintp; use Uintp; with Validsw; use Validsw; @@ -127,8 +128,16 @@ package body Exp_Ch5 is 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. + -- a call to System.Bitfields.Copy_Bitfield, which is more efficient than + -- copying component-by-component. + + function Expand_Assign_Array_Bitfield_Fast + (N : Node_Id; + Larray : Entity_Id; + Rarray : Entity_Id) return Node_Id; + -- Alternative to Expand_Assign_Array_Bitfield. Generates a call to + -- System.Bitfields.Fast_Copy_Bitfield, which is more efficient than + -- Copy_Bitfield, but only works in restricted situations. function Expand_Assign_Array_Loop_Or_Bitfield (N : Node_Id; @@ -138,8 +147,8 @@ package body Exp_Ch5 is R_Type : Entity_Id; Ndim : Pos; Rev : Boolean) return Node_Id; - -- Calls either Expand_Assign_Array_Loop or Expand_Assign_Array_Bitfield as - -- appropriate. + -- Calls either Expand_Assign_Array_Loop, Expand_Assign_Array_Bitfield, or + -- Expand_Assign_Array_Bitfield_Fast as appropriate. procedure Expand_Assign_Record (N : Node_Id); -- N is an assignment of an untagged record value. This routine handles @@ -1440,6 +1449,84 @@ package body Exp_Ch5 is R_Addr, R_Bit, L_Addr, L_Bit, Size)); end Expand_Assign_Array_Bitfield; + --------------------------------------- + -- Expand_Assign_Array_Bitfield_Fast -- + --------------------------------------- + + function Expand_Assign_Array_Bitfield_Fast + (N : Node_Id; + Larray : Entity_Id; + Rarray : Entity_Id) return Node_Id + is + pragma Assert (not Change_Of_Representation (N)); + -- This won't work, for example, to copy a packed array to an unpacked + -- array. + + -- For L (A .. B) := R (C .. D), we generate: + -- + -- L := Fast_Copy_Bitfield (R, , L, , + -- L (A .. B)'Length * L'Component_Size); + -- + -- with L and R suitably uncheckedly converted to/from Val_2. + -- The offsets are from the start of L and R. + + Loc : constant Source_Ptr := Sloc (N); + + L_Val : constant Node_Id := + Unchecked_Convert_To (RTE (RE_Val_2), Larray); + R_Val : constant Node_Id := + Unchecked_Convert_To (RTE (RE_Val_2), Rarray); + -- Converted values of left- and right-hand sides + + C_Size : constant Uint := Component_Size (Etype (Larray)); + pragma Assert (C_Size >= 1); + pragma Assert (C_Size = Component_Size (Etype (Rarray))); + + Larray_Bounds : constant Range_Values := + Get_Index_Bounds (First_Index (Etype (Larray))); + L_Bounds : constant Range_Values := + (if Nkind (Name (N)) = N_Slice + then Get_Index_Bounds (Discrete_Range (Name (N))) + else Larray_Bounds); + -- If the left-hand side is A (L..H), Larray_Bounds is A'Range, and + -- L_Bounds is L..H. If it's not a slice, we treat it like a slice + -- starting at A'First. + + L_Bit : constant Node_Id := + Make_Integer_Literal (Loc, (L_Bounds.L - Larray_Bounds.L) * C_Size); + + Rarray_Bounds : constant Range_Values := + Get_Index_Bounds (First_Index (Etype (Rarray))); + R_Bounds : constant Range_Values := + (if Nkind (Expression (N)) = N_Slice + then Get_Index_Bounds (Discrete_Range (Expression (N))) + else Rarray_Bounds); + + R_Bit : constant Node_Id := + Make_Integer_Literal (Loc, (R_Bounds.L - Rarray_Bounds.L) * C_Size); + + 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 (Larray, True), + Attribute_Name => Name_Component_Size)); + + Call : constant Node_Id := Make_Function_Call (Loc, + Name => New_Occurrence_Of (RTE (RE_Fast_Copy_Bitfield), Loc), + Parameter_Associations => New_List ( + R_Val, R_Bit, L_Val, L_Bit, Size)); + + begin + return Make_Assignment_Statement (Loc, + Name => Duplicate_Subexpr (Larray, True), + Expression => Unchecked_Convert_To (Etype (Larray), Call)); + end Expand_Assign_Array_Bitfield_Fast; + ------------------------------------------ -- Expand_Assign_Array_Loop_Or_Bitfield -- ------------------------------------------ @@ -1453,6 +1540,7 @@ package body Exp_Ch5 is Ndim : Pos; Rev : Boolean) return Node_Id is + Slices : constant Boolean := Nkind (Name (N)) = N_Slice or else Nkind (Expression (N)) = N_Slice; L_Prefix_Comp : constant Boolean := @@ -1467,23 +1555,23 @@ package body Exp_Ch5 is N_Selected_Component | N_Indexed_Component | 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 for slices - -- of bit-packed arrays. Copy_Bitfield can read and write bits that are - -- not part of the objects being copied, so we don't want to use it if - -- there are volatile or independent components. If the Prefix of the - -- slice is a component or slice, then it might be a part of an object - -- with some other volatile or independent components, so we disable the - -- optimization in that case as well. We could complicate this code by - -- actually looking for such volatile and independent components. + -- Determine whether Copy_Bitfield or Fast_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 for slices of bit-packed arrays. Copy_Bitfield can read and + -- write bits that are not part of the objects being copied, so we don't + -- want to use it if there are volatile or independent components. If + -- the Prefix of the slice is a component or slice, then it might be a + -- part of an object with some other volatile or independent components, + -- so we disable the optimization in that case as well. We could + -- complicate this code by actually looking for such volatile and + -- independent components. if Is_Bit_Packed_Array (L_Type) and then Is_Bit_Packed_Array (R_Type) 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 and then not Has_Volatile_Component (L_Type) and then not Has_Volatile_Component (R_Type) @@ -1491,14 +1579,87 @@ package body Exp_Ch5 is and then not Has_Independent_Components (R_Type) and then not L_Prefix_Comp and then not R_Prefix_Comp - and then RTE_Available (RE_Copy_Bitfield) 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); + -- Here if Copy_Bitfield can work (except for the Rev test below). + -- Determine whether to call Fast_Copy_Bitfield instead. If we + -- are assigning slices, and all the relevant bounds are known at + -- compile time, and the maximum object size is no greater than + -- System.Bitfields.Val_Bits (i.e. Long_Long_Integer'Size / 2), and + -- we don't have enumeration representation clauses, we can use + -- Fast_Copy_Bitfield. The max size test is to ensure that the slices + -- cannot overlap boundaries not supported by Fast_Copy_Bitfield. + + pragma Assert (Known_Component_Size (Base_Type (L_Type))); + pragma Assert (Known_Component_Size (Base_Type (R_Type))); + + -- Note that L_Type and R_Type do not necessarily have the same base + -- type, because of array type conversions. Hence the need to check + -- various properties of both. + + if Compile_Time_Known_Bounds (Base_Type (L_Type)) + and then Compile_Time_Known_Bounds (Base_Type (R_Type)) + then + declare + Left_Base_Index : constant Entity_Id := + First_Index (Base_Type (L_Type)); + Left_Base_Range : constant Range_Values := + Get_Index_Bounds (Left_Base_Index); + + Right_Base_Index : constant Entity_Id := + First_Index (Base_Type (R_Type)); + Right_Base_Range : constant Range_Values := + Get_Index_Bounds (Right_Base_Index); + + Known_Left_Slice_Low : constant Boolean := + (if Nkind (Name (N)) = N_Slice + then Compile_Time_Known_Value + (Get_Index_Bounds (Discrete_Range (Name (N))).L)); + Known_Right_Slice_Low : constant Boolean := + (if Nkind (Expression (N)) = N_Slice + then Compile_Time_Known_Value + (Get_Index_Bounds (Discrete_Range (Expression (N))).H)); + + Val_Bits : constant Pos := Standard_Long_Long_Integer_Size / 2; + + begin + if Left_Base_Range.H - Left_Base_Range.L < Val_Bits + and then Right_Base_Range.H - Right_Base_Range.L < Val_Bits + and then Known_Esize (L_Type) + and then Known_Esize (R_Type) + and then Known_Left_Slice_Low + and then Known_Right_Slice_Low + and then Compile_Time_Known_Value + (Get_Index_Bounds (First_Index (Etype (Larray))).L) + and then Compile_Time_Known_Value + (Get_Index_Bounds (First_Index (Etype (Rarray))).L) + and then + not (Is_Enumeration_Type (Etype (Left_Base_Index)) + and then Has_Enumeration_Rep_Clause + (Etype (Left_Base_Index))) + and then RTE_Available (RE_Fast_Copy_Bitfield) + then + pragma Assert (Esize (L_Type) /= 0); + pragma Assert (Esize (R_Type) /= 0); + + return Expand_Assign_Array_Bitfield_Fast (N, Larray, Rarray); + end if; + end; + end if; + + -- Fast_Copy_Bitfield can work if Rev is True, because the data is + -- passed and returned by copy. Copy_Bitfield cannot. + + if not Rev and then RTE_Available (RE_Copy_Bitfield) then + return Expand_Assign_Array_Bitfield + (N, Larray, Rarray, L_Type, R_Type, Rev); + end if; end if; + + -- Here if we did not return above, with Fast_Copy_Bitfield or + -- Copy_Bitfield. + + return Expand_Assign_Array_Loop + (N, Larray, Rarray, L_Type, R_Type, Ndim, Rev); end Expand_Assign_Array_Loop_Or_Bitfield; -------------------------- diff --git a/gcc/ada/libgnat/s-bitfie.ads b/gcc/ada/libgnat/s-bitfie.ads index b60a4feefede..f081d55fe5fc 100644 --- a/gcc/ada/libgnat/s-bitfie.ads +++ b/gcc/ada/libgnat/s-bitfie.ads @@ -47,10 +47,9 @@ package System.Bitfields is pragma Provide_Shift_Operators (Val_2); type Val is mod 2**Val_Bits with Alignment => Val_Bytes; - -- ??? It turns out that enabling checks on the instantiation of - -- System.Bitfield_Utils.G makes a latent visibility bug appear on strict - -- alignment platforms related to alignment checks. Work around it by - -- suppressing these checks explicitly. + -- Enabling checks on the instantiation of System.Bitfield_Utils.G makes a + -- latent visibility bug appear on strict alignment platforms related to + -- alignment checks. Work around it by suppressing these checks explicitly. pragma Suppress (Alignment_Check); package Utils is new System.Bitfield_Utils.G (Val, Val_2); @@ -63,4 +62,12 @@ package System.Bitfields is Size : Utils.Bit_Size) renames Utils.Copy_Bitfield; + function Fast_Copy_Bitfield + (Src : Val_2; + Src_Offset : Utils.Bit_Offset; + Dest : Val_2; + Dest_Offset : Utils.Bit_Offset; + Size : Utils.Small_Size) + return Val_2 renames Utils.Fast_Copy_Bitfield; + end System.Bitfields; diff --git a/gcc/ada/libgnat/s-bituti.adb b/gcc/ada/libgnat/s-bituti.adb index 3e584e72bfe2..d571f544bb69 100644 --- a/gcc/ada/libgnat/s-bituti.adb +++ b/gcc/ada/libgnat/s-bituti.adb @@ -31,14 +31,6 @@ 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); @@ -77,7 +69,7 @@ package body System.Bitfield_Utils is function Get_Bitfield (Src : Val_2; Src_Offset : Bit_Offset; Size : Small_Size) - return Val; + return Val with Inline; -- 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. @@ -86,7 +78,7 @@ package body System.Bitfield_Utils is Dest : Val_2; Dest_Offset : Bit_Offset; Size : Small_Size) - return Val_2; + return Val_2 with Inline; -- 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. @@ -426,6 +418,22 @@ package body System.Bitfield_Utils is end if; end Copy_Bitfield; + function Fast_Copy_Bitfield + (Src : Val_2; + Src_Offset : Bit_Offset; + Dest : Val_2; + Dest_Offset : Bit_Offset; + Size : Small_Size) + return Val_2 is + Result : constant Val_2 := Set_Bitfield + (Get_Bitfield (Src, Src_Offset, Size), Dest, Dest_Offset, Size); + begin + -- No need to explicitly do nothing for zero size case, because Size + -- cannot be zero. + + return Result; + end Fast_Copy_Bitfield; + end G; end System.Bitfield_Utils; diff --git a/gcc/ada/libgnat/s-bituti.ads b/gcc/ada/libgnat/s-bituti.ads index c9c4b9184b9d..8afee248d65b 100644 --- a/gcc/ada/libgnat/s-bituti.ads +++ b/gcc/ada/libgnat/s-bituti.ads @@ -54,7 +54,7 @@ package System.Bitfield_Utils is -- 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. + -- Endian indicates whether we're on a little- or big-endian machine. pragma Elaborate_Body; @@ -127,6 +127,20 @@ package System.Bitfield_Utils is -- D (D_First)'Address, D (D_First)'Bit, -- Size); + function Fast_Copy_Bitfield + (Src : Val_2; + Src_Offset : Bit_Offset; + Dest : Val_2; + Dest_Offset : Bit_Offset; + Size : Small_Size) + return Val_2 with Inline; + -- Faster version of Copy_Bitfield, with a different calling convention. + -- In particular, we pass by copy rather than passing Addresses. The bit + -- field must fit in Val_Bits. Src and Dest must be properly aligned. + -- The result is supposed to be assigned back into Dest, as in: + -- + -- Dest := Fast_Copy_Bitfield (Src, ..., Dest, ..., ...); + end G; end System.Bitfield_Utils; diff --git a/gcc/ada/rtsfind.ads b/gcc/ada/rtsfind.ads index 28d14bdbac22..36e0440c868f 100644 --- a/gcc/ada/rtsfind.ads +++ b/gcc/ada/rtsfind.ads @@ -838,7 +838,9 @@ package Rtsfind is RE_To_Bignum, -- System.Bignums RE_From_Bignum, -- System.Bignums + RE_Val_2, -- System.Bitfields RE_Copy_Bitfield, -- System.Bitfields + RE_Fast_Copy_Bitfield, -- System.Bitfields RE_Bit_And, -- System.Bit_Ops RE_Bit_Eq, -- System.Bit_Ops @@ -2518,7 +2520,9 @@ package Rtsfind is RE_To_Bignum => System_Bignums, RE_From_Bignum => System_Bignums, + RE_Val_2 => System_Bitfields, RE_Copy_Bitfield => System_Bitfields, + RE_Fast_Copy_Bitfield => System_Bitfields, RE_Bit_And => System_Bit_Ops, RE_Bit_Eq => System_Bit_Ops, diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb index 44a568404ad1..479bb146b61a 100644 --- a/gcc/ada/sem_util.adb +++ b/gcc/ada/sem_util.adb @@ -10943,6 +10943,23 @@ package body Sem_Util is end if; end Get_Index_Bounds; + function Get_Index_Bounds + (N : Node_Id; + Use_Full_View : Boolean := False) return Range_Nodes is + Result : Range_Nodes; + begin + Get_Index_Bounds (N, Result.L, Result.H, Use_Full_View); + return Result; + end Get_Index_Bounds; + + function Get_Index_Bounds + (N : Node_Id; + Use_Full_View : Boolean := False) return Range_Values is + Nodes : constant Range_Nodes := Get_Index_Bounds (N, Use_Full_View); + begin + return (Expr_Value (Nodes.L), Expr_Value (Nodes.H)); + end Get_Index_Bounds; + ----------------------------- -- Get_Interfacing_Aspects -- ----------------------------- @@ -26984,7 +27001,7 @@ package body Sem_Util is is begin -- The only entities for which we track constant values are variables - -- which are not renamings, constants and formal parameters, so check + -- that are not renamings, constants and formal parameters, so check -- if we have this case. -- Note: it may seem odd to track constant values for constants, but in diff --git a/gcc/ada/sem_util.ads b/gcc/ada/sem_util.ads index 0519b3c3fdd1..a1ed43cba43d 100644 --- a/gcc/ada/sem_util.ads +++ b/gcc/ada/sem_util.ads @@ -1167,6 +1167,26 @@ package Sem_Util is -- the index type turns out to be a partial view; this case should not -- arise during normal compilation of semantically correct programs. + type Range_Nodes is record + L, H : Node_Id; -- First and Last nodes of a discrete_range + end record; + + type Range_Values is record + L, H : Uint; -- First and Last values of a discrete_range + end record; + + function Get_Index_Bounds + (N : Node_Id; + Use_Full_View : Boolean := False) return Range_Nodes; + -- Same as the above procedure, but returns the result as a record. + -- ???This should probably replace the procedure. + + function Get_Index_Bounds + (N : Node_Id; + Use_Full_View : Boolean := False) return Range_Values; + -- Same as the above function, but returns the values, which must be known + -- at compile time. + procedure Get_Interfacing_Aspects (Iface_Asp : Node_Id; Conv_Asp : out Node_Id; @@ -2960,9 +2980,9 @@ package Sem_Util is -- the value is valid) for the given entity Ent. This value can only be -- captured if sequential execution semantics can be properly guaranteed so -- that a subsequent reference will indeed be sure that this current value - -- indication is correct. The node N is the construct which resulted in - -- the possible capture of the value (this is used to check if we are in - -- a conditional). + -- indication is correct. The node N is the construct that resulted in the + -- possible capture of the value (this is used to check if we are in a + -- conditional). -- -- Cond is used to skip the test for being inside a conditional. It is used -- in the case of capturing values from if/while tests, which already do a