[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.

3 files changed, 44 insertions, 15 deletions

diff --git a/gcc/ada/libgnat/s-bitfie.ads b/gcc/ada/libgnat/s-bitfie.ads
index b60a4fe..f081d55 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 3e584e7..d571f54 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 c9c4b91..8afee24 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;