[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  <duff@adacore.com>

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

+2019-09-17  Bob Duff  <duff@adacore.com>
+
+	* 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  <anisimko@adacore.com>
 
 	* gsocket.h: Include sys/un.h.

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);

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;