From: Nicolas Roche <ro...@adacore.com>
Improve performance of iteration using Element function.
Improve performance of Append.
gcc/ada/ChangeLog:
* libgnat/a-strunb__shared.adb: Restructure code to inline only
the most common cases. Remove whenever possible runtime checks.
* libgnat/a-strunb__shared.ads: Add Inline => True to Append
variants and Element.
Tested on x86_64-pc-linux-gnu, committed on master.
---
gcc/ada/libgnat/a-strunb__shared.adb | 165 ++++++++++++++++++++-------
gcc/ada/libgnat/a-strunb__shared.ads | 18 ++-
2 files changed, 134 insertions(+), 49 deletions(-)
diff --git a/gcc/ada/libgnat/a-strunb__shared.adb
b/gcc/ada/libgnat/a-strunb__shared.adb
index ef4f8c93bdb..2f0ae3a1c92 100644
--- a/gcc/ada/libgnat/a-strunb__shared.adb
+++ b/gcc/ada/libgnat/a-strunb__shared.adb
@@ -35,6 +35,23 @@ package body Ada.Strings.Unbounded is
use Ada.Strings.Maps;
+ procedure Non_Inlined_Append
+ (Source : in out Unbounded_String;
+ New_Item : Unbounded_String);
+
+ procedure Non_Inlined_Append
+ (Source : in out Unbounded_String;
+ New_Item : String);
+
+ procedure Non_Inlined_Append
+ (Source : in out Unbounded_String;
+ New_Item : 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
@@ -542,10 +559,12 @@ package body Ada.Strings.Unbounded is
(Source : in out Unbounded_String;
New_Item : Unbounded_String)
is
+ pragma Suppress (All_Checks);
+ -- Suppress checks as they are redundant with the checks done in that
+ -- function.
+
SR : constant Shared_String_Access := Source.Reference;
NR : constant Shared_String_Access := New_Item.Reference;
- DL : constant Natural := Sum (SR.Last, NR.Last);
- DR : Shared_String_Access;
begin
-- Source is an empty string, reuse New_Item data
@@ -562,19 +581,17 @@ package body Ada.Strings.Unbounded is
-- Try to reuse existing 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;
@@ -582,31 +599,34 @@ package body Ada.Strings.Unbounded is
(Source : in out Unbounded_String;
New_Item : String)
is
- SR : constant Shared_String_Access := Source.Reference;
- DL : constant Natural := Sum (SR.Last, New_Item'Length);
- DR : Shared_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_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;
@@ -614,26 +634,24 @@ package body Ada.Strings.Unbounded is
(Source : in out Unbounded_String;
New_Item : Character)
is
- SR : constant Shared_String_Access := Source.Reference;
- DL : constant Natural := Sum (SR.Last, 1);
- DR : Shared_String_Access;
+ pragma Suppress (All_Checks);
+ -- Suppress checks as they are redundant with the checks done in that
+ -- function.
+ SR : constant Shared_String_Access := Source.Reference;
begin
- -- Try to reuse existing shared string
-
- if Can_Be_Reused (SR, DL) 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;
@@ -801,9 +819,10 @@ package body Ada.Strings.Unbounded is
(Source : Unbounded_String;
Index : Positive) return Character
is
+ pragma Suppress (All_Checks);
SR : constant Shared_String_Access := Source.Reference;
begin
- if Index <= SR.Last then
+ if Index <= SR.Last and then Index > 0 then
return SR.Data (Index);
else
raise Index_Error;
@@ -1215,6 +1234,66 @@ package body Ada.Strings.Unbounded is
return Left * Right;
end Mul;
+ ------------------------
+ -- Non_Inlined_Append --
+ ------------------------
+
+ procedure Non_Inlined_Append
+ (Source : in out Unbounded_String;
+ New_Item : Unbounded_String)
+ is
+ SR : constant Shared_String_Access := Source.Reference;
+ NR : constant Shared_String_Access := New_Item.Reference;
+ DL : constant Natural := Sum (SR.Last, NR.Last);
+ DR : Shared_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_String;
+ New_Item : String)
+ is
+ SR : constant Shared_String_Access := Source.Reference;
+ DL : constant Natural := Sum (SR.Last, New_Item'Length);
+ DR : Shared_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_String;
+ New_Item : Character)
+ is
+ SR : constant Shared_String_Access := Source.Reference;
+ begin
+ if SR.Last = Natural'Last then
+ raise Constraint_Error;
+ else
+ declare
+ DL : constant Natural := SR.Last + 1;
+ DR : Shared_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-strunb__shared.ads
b/gcc/ada/libgnat/a-strunb__shared.ads
index fa97680a7fa..d81c66b9f0a 100644
--- a/gcc/ada/libgnat/a-strunb__shared.ads
+++ b/gcc/ada/libgnat/a-strunb__shared.ads
@@ -153,7 +153,8 @@ is
Pre => Length (New_Item) <= Natural'Last - Length (Source),
Post =>
To_String (Source) = To_String (Source)'Old & To_String (New_Item),
- Global => null;
+ Global => null,
+ Inline => True;
procedure Append
(Source : in out Unbounded_String;
@@ -161,7 +162,8 @@ is
with
Pre => New_Item'Length <= Natural'Last - Length (Source),
Post => To_String (Source) = To_String (Source)'Old & New_Item,
- Global => null;
+ Global => null,
+ Inline => True;
procedure Append
(Source : in out Unbounded_String;
@@ -169,7 +171,8 @@ is
with
Pre => Length (Source) < Natural'Last,
Post => To_String (Source) = To_String (Source)'Old & New_Item,
- Global => null;
+ Global => null,
+ Inline => True;
function "&"
(Left : Unbounded_String;
@@ -217,7 +220,8 @@ is
with
Pre => Index <= Length (Source),
Post => Element'Result = To_String (Source) (Index),
- Global => null;
+ Global => null,
+ Inline => True;
procedure Replace_Element
(Source : in out Unbounded_String;
@@ -1578,11 +1582,13 @@ private
type Shared_String_Access is access all Shared_String;
- procedure Reference (Item : not null Shared_String_Access);
+ procedure Reference (Item : not null Shared_String_Access)
+ with Inline => True;
-- Increment reference counter.
-- Do nothing if Item points to Empty_Shared_String.
- procedure Unreference (Item : not null Shared_String_Access);
+ procedure Unreference (Item : not null Shared_String_Access)
+ with Inline => True;
-- Decrement reference counter, deallocate Item when counter goes to zero.
-- Do nothing if Item points to Empty_Shared_String.
--
2.43.0
