diff mbox series

[COMMITTED,34/38] ada: Improve Unbounded_Wide_String performance

Message ID 20241104161116.1431659-34-poulhies@adacore.com
State New
Headers show
Series [COMMITTED,01/38] ada: Fix asymmetry in resolution of unary intrinsic operators | expand

Commit Message

Marc Poulhiès Nov. 4, 2024, 4:11 p.m. UTC
From: Nicolas Roche <roche@adacore.com>

Improve performance of iteration using Element function.
Improve performance of Append.

gcc/ada/ChangeLog:

	* libgnat/a-stwiun__shared.adb: Restructure code to inline only
	the most common cases. Remove whenever possible runtime checks.
	* libgnat/a-stwiun__shared.ads: Add Inline => True to Append
	variants and Element.

Tested on x86_64-pc-linux-gnu, committed on master.

---
 gcc/ada/libgnat/a-stwiun__shared.adb | 164 ++++++++++++++++++++-------
 gcc/ada/libgnat/a-stwiun__shared.ads |   9 +-
 2 files changed, 127 insertions(+), 46 deletions(-)
diff mbox series

Patch

diff --git a/gcc/ada/libgnat/a-stwiun__shared.adb b/gcc/ada/libgnat/a-stwiun__shared.adb
index 26b4f8ec85f..d3f20f0af20 100644
--- a/gcc/ada/libgnat/a-stwiun__shared.adb
+++ b/gcc/ada/libgnat/a-stwiun__shared.adb
@@ -36,7 +36,24 @@  package body Ada.Strings.Wide_Unbounded is
 
    use Ada.Strings.Wide_Maps;
 
-   Growth_Factor : constant := 32;
+   procedure Non_Inlined_Append
+     (Source   : in out Unbounded_Wide_String;
+      New_Item : Unbounded_Wide_String);
+
+   procedure Non_Inlined_Append
+     (Source   : in out Unbounded_Wide_String;
+      New_Item : Wide_String);
+
+   procedure Non_Inlined_Append
+      (Source   : in out Unbounded_Wide_String;
+       New_Item : Wide_Character);
+   --  Non_Inlined_Append are part of the respective Append method that
+   --  should not be inlined. The idea is that the code of Append is inlined.
+   --  In order to make inlining efficient it is better to have the inlined
+   --  code as small as possible. Thus most common cases are inlined and less
+   --  common cases are deferred in these functions.
+
+   Growth_Factor : constant := 2;
    --  The growth factor controls how much extra space is allocated when
    --  we have to increase the size of an allocated unbounded string. By
    --  allocating extra space, we avoid the need to reallocate on every
@@ -525,10 +542,12 @@  package body Ada.Strings.Wide_Unbounded is
      (Source   : in out Unbounded_Wide_String;
       New_Item : Unbounded_Wide_String)
    is
+      pragma Suppress (All_Checks);
+      --  Suppress checks as they are redundant with the checks done in that
+      --  function.
+
       SR  : constant Shared_Wide_String_Access := Source.Reference;
       NR  : constant Shared_Wide_String_Access := New_Item.Reference;
-      DL  : constant Natural                   := SR.Last + NR.Last;
-      DR  : Shared_Wide_String_Access;
 
    begin
       --  Source is an empty string, reuse New_Item data
@@ -545,19 +564,17 @@  package body Ada.Strings.Wide_Unbounded is
 
       --  Try to reuse existent shared string
 
-      elsif Can_Be_Reused (SR, DL) then
-         SR.Data (SR.Last + 1 .. DL) := NR.Data (1 .. NR.Last);
-         SR.Last := DL;
+      elsif System.Atomic_Counters.Is_One (SR.Counter)
+         and then NR.Last <= SR.Max_Length
+         and then SR.Max_Length - NR.Last >= SR.Last
+      then
+         SR.Data (SR.Last + 1 .. SR.Last + NR.Last) := NR.Data (1 .. NR.Last);
+         SR.Last := SR.Last + NR.Last;
 
       --  Otherwise, allocate new one and fill it
 
       else
-         DR := Allocate (DL + DL / Growth_Factor);
-         DR.Data (1 .. SR.Last) := SR.Data (1 .. SR.Last);
-         DR.Data (SR.Last + 1 .. DL) := NR.Data (1 .. NR.Last);
-         DR.Last := DL;
-         Source.Reference := DR;
-         Unreference (SR);
+         Non_Inlined_Append (Source, New_Item);
       end if;
    end Append;
 
@@ -565,31 +582,34 @@  package body Ada.Strings.Wide_Unbounded is
      (Source   : in out Unbounded_Wide_String;
       New_Item : Wide_String)
    is
-      SR : constant Shared_Wide_String_Access := Source.Reference;
-      DL : constant Natural                   := SR.Last + New_Item'Length;
-      DR : Shared_Wide_String_Access;
+      pragma Suppress (All_Checks);
+      --  Suppress checks as they are redundant with the checks done in that
+      --  function.
 
+      New_Item_Length : constant Natural := New_Item'Length;
+      SR : constant Shared_Wide_String_Access := Source.Reference;
    begin
-      --  New_Item is an empty string, nothing to do
 
       if New_Item'Length = 0 then
+         --  New_Item is an empty string, nothing to do
          null;
 
-      --  Try to reuse existing shared string
-
-      elsif Can_Be_Reused (SR, DL) then
-         SR.Data (SR.Last + 1 .. DL) := New_Item;
-         SR.Last := DL;
-
-      --  Otherwise, allocate new one and fill it
+      elsif System.Atomic_Counters.Is_One (SR.Counter)
+         --  The following test checks in fact that
+         --  SR.Max_Length >= SR.Last + New_Item_Length without causing
+         --  overflow.
+         and then New_Item_Length <= SR.Max_Length
+         and then SR.Max_Length - New_Item_Length >= SR.Last
+      then
+         --  Try to reuse existing shared string
+         SR.Data (SR.Last + 1 .. SR.Last + New_Item_Length) := New_Item;
+         SR.Last := SR.Last + New_Item_Length;
 
       else
-         DR := Allocate (DL + DL / Growth_Factor);
-         DR.Data (1 .. SR.Last) := SR.Data (1 .. SR.Last);
-         DR.Data (SR.Last + 1 .. DL) := New_Item;
-         DR.Last := DL;
-         Source.Reference := DR;
-         Unreference (SR);
+         --  Otherwise, allocate new one and fill it. Deferring the worst case
+         --  into a separate non-inlined function ensure that inlined Append
+         --  code size remains short and thus efficient.
+         Non_Inlined_Append (Source, New_Item);
       end if;
    end Append;
 
@@ -597,26 +617,24 @@  package body Ada.Strings.Wide_Unbounded is
      (Source   : in out Unbounded_Wide_String;
       New_Item : Wide_Character)
    is
-      SR : constant Shared_Wide_String_Access := Source.Reference;
-      DL : constant Natural := SR.Last + 1;
-      DR : Shared_Wide_String_Access;
+      pragma Suppress (All_Checks);
+      --  Suppress checks as they are redundant with the checks done in that
+      --  function.
 
+      SR : constant Shared_Wide_String_Access := Source.Reference;
    begin
-      --  Try to reuse existing shared string
-
-      if Can_Be_Reused (SR, SR.Last + 1) then
+      if System.Atomic_Counters.Is_One (SR.Counter)
+         and then SR.Max_Length > SR.Last
+      then
+         --  Try to reuse existing shared string
          SR.Data (SR.Last + 1) := New_Item;
          SR.Last := SR.Last + 1;
 
-      --  Otherwise, allocate new one and fill it
-
       else
-         DR := Allocate (DL + DL / Growth_Factor);
-         DR.Data (1 .. SR.Last) := SR.Data (1 .. SR.Last);
-         DR.Data (DL) := New_Item;
-         DR.Last := DL;
-         Source.Reference := DR;
-         Unreference (SR);
+         --  Otherwise, allocate new one and fill it. Deferring the worst case
+         --  into a separate non-inlined function ensure that inlined Append
+         --  code size remains short and thus efficient.
+         Non_Inlined_Append (Source, New_Item);
       end if;
    end Append;
 
@@ -1178,6 +1196,66 @@  package body Ada.Strings.Wide_Unbounded is
       return Source.Reference.Last;
    end Length;
 
+   ------------------------
+   -- Non_Inlined_Append --
+   ------------------------
+
+   procedure Non_Inlined_Append
+       (Source   : in out Unbounded_Wide_String;
+        New_Item : Unbounded_Wide_String)
+   is
+      SR : constant Shared_Wide_String_Access := Source.Reference;
+      NR  : constant Shared_Wide_String_Access := New_Item.Reference;
+      DL : constant Natural := SR.Last + NR.Last;
+      DR : Shared_Wide_String_Access;
+   begin
+      DR := Allocate (DL + DL / Growth_Factor);
+      DR.Data (1 .. SR.Last) := SR.Data (1 .. SR.Last);
+      DR.Data (SR.Last + 1 .. DL) := NR.Data (1 .. NR.Last);
+      DR.Last := DL;
+      Source.Reference := DR;
+      Unreference (SR);
+   end Non_Inlined_Append;
+
+   procedure Non_Inlined_Append
+     (Source   : in out Unbounded_Wide_String;
+      New_Item : Wide_String)
+   is
+      SR : constant Shared_Wide_String_Access := Source.Reference;
+      DL : constant Natural := SR.Last + New_Item'Length;
+      DR : Shared_Wide_String_Access;
+   begin
+      DR := Allocate (DL + DL / Growth_Factor);
+      DR.Data (1 .. SR.Last) := SR.Data (1 .. SR.Last);
+      DR.Data (SR.Last + 1 .. DL) := New_Item;
+      DR.Last := DL;
+      Source.Reference := DR;
+      Unreference (SR);
+   end Non_Inlined_Append;
+
+   procedure Non_Inlined_Append
+      (Source   : in out Unbounded_Wide_String;
+       New_Item : Wide_Character)
+   is
+      SR : constant Shared_Wide_String_Access := Source.Reference;
+   begin
+      if SR.Last = Natural'Last then
+         raise Constraint_Error;
+      else
+         declare
+            DL : constant Natural := SR.Last + 1;
+            DR : Shared_Wide_String_Access;
+         begin
+            DR := Allocate (DL + DL / Growth_Factor);
+            DR.Data (1 .. SR.Last) := SR.Data (1 .. SR.Last);
+            DR.Data (DL) := New_Item;
+            DR.Last := DL;
+            Source.Reference := DR;
+            Unreference (SR);
+         end;
+      end if;
+   end Non_Inlined_Append;
+
    ---------------
    -- Overwrite --
    ---------------
diff --git a/gcc/ada/libgnat/a-stwiun__shared.ads b/gcc/ada/libgnat/a-stwiun__shared.ads
index 865970f052c..19ccebf7186 100644
--- a/gcc/ada/libgnat/a-stwiun__shared.ads
+++ b/gcc/ada/libgnat/a-stwiun__shared.ads
@@ -79,15 +79,18 @@  package Ada.Strings.Wide_Unbounded is
 
    procedure Append
      (Source   : in out Unbounded_Wide_String;
-      New_Item : Unbounded_Wide_String);
+      New_Item : Unbounded_Wide_String)
+   with Inline => True;
 
    procedure Append
      (Source   : in out Unbounded_Wide_String;
-      New_Item : Wide_String);
+      New_Item : Wide_String)
+   with Inline => True;
 
    procedure Append
      (Source   : in out Unbounded_Wide_String;
-      New_Item : Wide_Character);
+      New_Item : Wide_Character)
+   with Inline => True;
 
    function "&"
      (Left  : Unbounded_Wide_String;