From 2d319f3acef1e80d7bb288a6b5d1ae76f2968b45 Mon Sep 17 00:00:00 2001 From: Bob Duff Date: Tue, 17 Sep 2019 07:59:29 +0000 Subject: [PATCH] [Ada] Avoid touching potentially nonexistent memory ...in cases where the Val_2 might cross a page boundary, and the second page is now known to exist. Copy_Bitfield is still disabled in the compiler: no test possible. 2019-09-17 Bob Duff gcc/ada/ * libgnat/s-bituti.adb (Get_Val_2, Set_Val_2): Use new routines for getting and setting a Val_2, avoiding touching the second half when that half might not exist. * exp_ch5.adb (Expand_Assign_Array_Loop_Or_Bitfield): Correct tests for potential volatile or independent components. In particular, do not call Prefix unless we know it's a slice. From-SVN: r275771 --- gcc/ada/ChangeLog | 9 ++ gcc/ada/exp_ch5.adb | 29 +++++-- gcc/ada/libgnat/s-bituti.adb | 159 ++++++++++++++++++++++++++++------- 3 files changed, 158 insertions(+), 39 deletions(-) diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index f5b72a08561..7220566d3c1 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,12 @@ +2019-09-17 Bob Duff + + * libgnat/s-bituti.adb (Get_Val_2, Set_Val_2): Use new routines + for getting and setting a Val_2, avoiding touching the second + half when that half might not exist. + * exp_ch5.adb (Expand_Assign_Array_Loop_Or_Bitfield): Correct + tests for potential volatile or independent components. In + particular, do not call Prefix unless we know it's a slice. + 2019-09-17 Dmitriy Anisimkov * gsocket.h: Include sys/un.h. diff --git a/gcc/ada/exp_ch5.adb b/gcc/ada/exp_ch5.adb index 7c2d6328e70..76e97fc9e18 100644 --- a/gcc/ada/exp_ch5.adb +++ b/gcc/ada/exp_ch5.adb @@ -1440,6 +1440,20 @@ package body Exp_Ch5 is is Slices : constant Boolean := Nkind (Name (N)) = N_Slice or else Nkind (Expression (N)) = N_Slice; + L_Prefix_Comp : constant Boolean := + -- True if the left-hand side is a slice of a component or slice + Nkind (Name (N)) = N_Slice + and then Nkind_In (Prefix (Name (N)), + N_Selected_Component, + N_Indexed_Component, + N_Slice); + R_Prefix_Comp : constant Boolean := + -- Likewise for the right-hand side + Nkind (Expression (N)) = N_Slice + and then Nkind_In (Prefix (Expression (N)), + 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 @@ -1447,11 +1461,10 @@ package body Exp_Ch5 is -- 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 selected component (etc, see below), then it might be a - -- component 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. + -- 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. -- Note that Expand_Assign_Array_Bitfield is disabled for now. @@ -1468,10 +1481,8 @@ package body Exp_Ch5 is and then not Has_Volatile_Component (R_Type) and then not Has_Independent_Components (L_Type) and then not Has_Independent_Components (R_Type) - and then not Nkind_In (Prefix (Name (N)), - N_Selected_Component, - N_Indexed_Component, - N_Slice) + and then not L_Prefix_Comp + and then not R_Prefix_Comp then return Expand_Assign_Array_Bitfield (N, Larray, Rarray, L_Type, R_Type, Rev); diff --git a/gcc/ada/libgnat/s-bituti.adb b/gcc/ada/libgnat/s-bituti.adb index 511dc571487..b425e9fb98b 100644 --- a/gcc/ada/libgnat/s-bituti.adb +++ b/gcc/ada/libgnat/s-bituti.adb @@ -43,6 +43,31 @@ package body System.Bitfield_Utils is Val_Bytes : constant Address := Address (Val'Size / Storage_Unit); + -- A Val_2 can cross a memory page boundary (e.g. an 8-byte Val_2 that + -- starts 4 bytes before the end of a page). If the bit field also + -- crosses that boundary, then the second page is known to exist, and we + -- can safely load or store the Val_2. On the other hand, if the bit + -- field is entirely within the first half of the Val_2, then it is + -- possible (albeit highly unlikely) that the second page does not + -- exist, so we must load or store only the first half of the Val_2. + -- Get_Val_2 and Set_Val_2 take care of all this. + + function Get_Val_2 + (Src_Address : Address; + Src_Offset : Bit_Offset; + Size : Small_Size) + return Val_2; + -- Get the Val_2, taking care to only load the first half when + -- necessary. + + procedure Set_Val_2 + (Dest_Address : Address; + Dest_Offset : Bit_Offset; + V : Val_2; + Size : Small_Size); + -- Set the Val_2, taking care to only store the first half when + -- necessary. + -- 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. @@ -56,11 +81,6 @@ package body System.Bitfield_Utils is -- 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; @@ -71,6 +91,13 @@ package body System.Bitfield_Utils is -- set to Src_Value. Src_Value must have high order bits (Size and -- above) zero. The result is returned as the function result. + procedure Set_Bitfield + (Src_Value : Val; + Dest_Address : Address; + Dest_Offset : Bit_Offset; + Size : Small_Size); + -- This version takes the bit address and size of the destination. + procedure Copy_Small_Bitfield (Src_Address : Address; Src_Offset : Bit_Offset; @@ -94,6 +121,69 @@ package body System.Bitfield_Utils is -- bit address, because it copies forward (from lower to higher -- bit addresses). + function Get_Val_2 + (Src_Address : Address; + Src_Offset : Bit_Offset; + Size : Small_Size) + return Val_2 is + begin + pragma Assert (Src_Address mod Val'Alignment = 0); + + -- Bit field fits in first half; fetch just one Val. On little + -- endian, we want that in the low half, but on big endian, we + -- want it in the high half. + + if Src_Offset + Size <= Val'Size then + declare + Result : aliased constant Val with + Import, Address => Src_Address; + begin + return (case Endian is + when Little => Val_2 (Result), + when Big => Shift_Left (Val_2 (Result), Val'Size)); + end; + + -- Bit field crosses into the second half, so it's safe to fetch the + -- whole Val_2. + + else + declare + Result : aliased constant Val_2 with + Import, Address => Src_Address; + begin + return Result; + end; + end if; + end Get_Val_2; + + procedure Set_Val_2 + (Dest_Address : Address; + Dest_Offset : Bit_Offset; + V : Val_2; + Size : Small_Size) is + begin + pragma Assert (Dest_Address mod Val'Alignment = 0); + + -- Comments in Get_Val_2 apply, except we're storing instead of + -- fetching. + + if Dest_Offset + Size <= Val'Size then + declare + Dest : aliased Val with Import, Address => Dest_Address; + begin + Dest := (case Endian is + when Little => Val'Mod (V), + when Big => Val (Shift_Right (V, Val'Size))); + end; + else + declare + Dest : aliased Val_2 with Import, Address => Dest_Address; + begin + Dest := V; + end; + end if; + end Set_Val_2; + function Get_Bitfield (Src : Val_2; Src_Offset : Bit_Offset; Size : Small_Size) return Val @@ -110,12 +200,6 @@ package body System.Bitfield_Utils is 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; @@ -138,6 +222,20 @@ package body System.Bitfield_Utils is return Result; end Set_Bitfield; + procedure Set_Bitfield + (Src_Value : Val; + Dest_Address : Address; + Dest_Offset : Bit_Offset; + Size : Small_Size) + is + Old_Dest : constant Val_2 := + Get_Val_2 (Dest_Address, Dest_Offset, Size); + New_Dest : constant Val_2 := + Set_Bitfield (Src_Value, Old_Dest, Dest_Offset, Size); + begin + Set_Val_2 (Dest_Address, Dest_Offset, New_Dest, Size); + end Set_Bitfield; + procedure Copy_Small_Bitfield (Src_Address : Address; Src_Offset : Bit_Offset; @@ -145,11 +243,10 @@ package body System.Bitfield_Utils is Dest_Offset : Bit_Offset; Size : Small_Size) is - Src : constant Val_2 with Import, Address => Src_Address; + Src : constant Val_2 := Get_Val_2 (Src_Address, Src_Offset, Size); 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); + Set_Bitfield (V, Dest_Address, Dest_Offset, Size); end Copy_Small_Bitfield; -- Copy_Large_Bitfield does the main work. Copying aligned Vals is more @@ -168,9 +265,9 @@ package body System.Bitfield_Utils is -- 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. + -- Loop, copying Vals. Get_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 @@ -216,13 +313,13 @@ package body System.Bitfield_Utils is declare Initial_Size : constant Small_Size := Val'Size - D_Off; - Initial_Val_2 : constant Val_2 with Import, Address => S_Addr; + Initial_Val_2 : constant Val_2 := + Get_Val_2 (S_Addr, S_Off, Initial_Size); 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); + Set_Bitfield + (Initial_Val, D_Addr, D_Off, Initial_Size); Sz := Sz - Initial_Size; declare @@ -253,8 +350,10 @@ package body System.Bitfield_Utils is 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); + Src_V_2 : constant Val_2 := + Get_Val_2 (S_Addr, S_Off, Val'Size); + Full_V : constant Val := + Get_Bitfield (Src_V_2, S_Off, Val'Size); begin Dest_Comp := Full_V; S_Addr := S_Addr + Val_Bytes; @@ -262,18 +361,18 @@ package body System.Bitfield_Utils is end; end loop; - if Sz mod Val'Size /= 0 then + Sz := Sz mod Val'Size; + if Sz /= 0 then -- Step 3: declare - Final_Val_2 : constant Val_2 with Import, Address => S_Addr; + Final_Val_2 : constant Val_2 := + Get_Val_2 (S_Addr, S_Off, Sz); 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; + Get_Bitfield (Final_Val_2, S_Off, Sz); begin - Final_Dest := Set_Bitfield - (Final_Val, Final_Dest, 0, Sz mod Val'Size); + Set_Bitfield + (Final_Val, D_Addr + Dest_Arr'Length * Val_Bytes, 0, Sz); end; end if; end; -- 2.30.2