From: Joffrey Huguet Date: Wed, 14 Aug 2019 09:52:58 +0000 (+0000) Subject: [Ada] Improve performance of Containers.Functional_Base X-Git-Url: https://git.libre-soc.org/?a=commitdiff_plain;h=4b0f6ee8b58dedc18192933e35f81b2b71d44fe7;p=gcc.git [Ada] Improve performance of Containers.Functional_Base This patch modifies the implementation of Functional_Base to damp the cost of its subprograms at runtime in specific cases. Instead of copying the entire underlying array to create a new container, containers can share the same Array_Base attribute. Performance on common use cases of formal and functional containers is improved with this patch. 2019-08-14 Joffrey Huguet gcc/ada/ * libgnat/a-cofuba.ads: Add a Length attribute to type Container. Add a type Array_Base which replaces the previous Elements attribute of Container. (Content_Init): New subprogram. It is used to initialize the Base attribute of Container. * libgnat/a-cofuba.adb (Resize): New subprogram. It is used to resize the underlying array of a container if necessary. (=, <=, Find, Get, Intersection, Length, Num_Overlaps, Set, Union): Update to match changes in type declarations. (Add): Modify body to damp the time and space cost in a specific case. (Content_Init): New subprogram. It is used to initialize the Base attribute of Container. (Remove): Modify body to damp the time and space cost in a specific case. From-SVN: r274474 --- diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 18877056574..2c4e0269e83 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,21 @@ +2019-08-14 Joffrey Huguet + + * libgnat/a-cofuba.ads: Add a Length attribute to type + Container. Add a type Array_Base which replaces the previous + Elements attribute of Container. + (Content_Init): New subprogram. It is used to initialize the + Base attribute of Container. + * libgnat/a-cofuba.adb (Resize): New subprogram. It is used to + resize the underlying array of a container if necessary. + (=, <=, Find, Get, Intersection, Length, Num_Overlaps, Set, + Union): Update to match changes in type declarations. + (Add): Modify body to damp the time and space cost in a specific + case. + (Content_Init): New subprogram. It is used to initialize the + Base attribute of Container. + (Remove): Modify body to damp the time and space cost in a + specific case. + 2019-08-14 Bob Duff * sem_ch13.adb (Get_Alignment_Value): Return 1 for Alignment 0, diff --git a/gcc/ada/libgnat/a-cofuba.adb b/gcc/ada/libgnat/a-cofuba.adb index bfd2a9e2901..5c5f48813a9 100644 --- a/gcc/ada/libgnat/a-cofuba.adb +++ b/gcc/ada/libgnat/a-cofuba.adb @@ -30,6 +30,7 @@ ------------------------------------------------------------------------------ pragma Ada_2012; +with Ada.Unchecked_Deallocation; package body Ada.Containers.Functional_Base with SPARK_Mode => Off is @@ -47,18 +48,22 @@ package body Ada.Containers.Functional_Base with SPARK_Mode => Off is -- Search a container C for an element equal to E.all, returning the -- position in the underlying array. + procedure Resize (Base : Array_Base_Access); + -- Resize the underlying array if needed so that it can contain one more + -- element. + --------- -- "=" -- --------- function "=" (C1 : Container; C2 : Container) return Boolean is begin - if C1.Elements'Length /= C2.Elements'Length then + if C1.Length /= C2.Length then return False; end if; - for I in C1.Elements'Range loop - if C1.Elements (I).all /= C2.Elements (I).all then + for I in 1 .. C1.Length loop + if C1.Base.Elements (I).all /= C2.Base.Elements (I).all then return False; end if; end loop; @@ -72,8 +77,8 @@ package body Ada.Containers.Functional_Base with SPARK_Mode => Off is function "<=" (C1 : Container; C2 : Container) return Boolean is begin - for I in C1.Elements'Range loop - if Find (C2, C1.Elements (I)) = 0 then + for I in 1 .. C1.Length loop + if Find (C2, C1.Base.Elements (I)) = 0 then return False; end if; end loop; @@ -90,31 +95,58 @@ package body Ada.Containers.Functional_Base with SPARK_Mode => Off is I : Index_Type; E : Element_Type) return Container is - A : constant Element_Array_Access := - new Element_Array'(1 .. C.Elements'Last + 1 => <>); - P : Count_Type := 0; - begin - for J in 1 .. C.Elements'Last + 1 loop - if J /= To_Count (I) then - P := P + 1; - A (J) := C.Elements (P); - else - A (J) := new Element_Type'(E); - end if; - end loop; - - return Container'(Elements => A); + if To_Count (I) = C.Length + 1 and then C.Length = C.Base.Max_Length then + Resize (C.Base); + C.Base.Max_Length := C.Base.Max_Length + 1; + C.Base.Elements (C.Base.Max_Length) := new Element_Type'(E); + + return Container'(Length => C.Base.Max_Length, Base => C.Base); + else + declare + A : constant Array_Base_Access := Content_Init (C.Length); + P : Count_Type := 0; + begin + A.Max_Length := C.Length + 1; + for J in 1 .. C.Length + 1 loop + if J /= To_Count (I) then + P := P + 1; + A.Elements (J) := C.Base.Elements (P); + else + A.Elements (J) := new Element_Type'(E); + end if; + end loop; + + return Container'(Length => A.Max_Length, + Base => A); + end; + end if; end Add; + ------------------ + -- Content_Init -- + ------------------ + + function Content_Init (L : Count_Type := 0) return Array_Base_Access + is + Max_Init : constant Count_Type := 100; + Size : constant Count_Type := + (if L < Count_Type'Last - Max_Init then L + Max_Init + else Count_Type'Last); + Elements : constant Element_Array_Access := + new Element_Array'(1 .. Size => <>); + begin + return new Array_Base'(Max_Length => 0, Elements => Elements); + end Content_Init; + ---------- -- Find -- ---------- function Find (C : Container; E : access Element_Type) return Count_Type is begin - for I in C.Elements'Range loop - if C.Elements (I).all = E.all then + for I in 1 .. C.Length loop + if C.Base.Elements (I).all = E.all then return I; end if; end loop; @@ -130,34 +162,34 @@ package body Ada.Containers.Functional_Base with SPARK_Mode => Off is --------- function Get (C : Container; I : Index_Type) return Element_Type is - (C.Elements (To_Count (I)).all); + (C.Base.Elements (To_Count (I)).all); ------------------ -- Intersection -- ------------------ function Intersection (C1 : Container; C2 : Container) return Container is - A : constant Element_Array_Access := - new Element_Array'(1 .. Num_Overlaps (C1, C2) => <>); + L : constant Count_Type := Num_Overlaps (C1, C2); + A : constant Array_Base_Access := Content_Init (L); P : Count_Type := 0; begin - for I in C1.Elements'Range loop - if Find (C2, C1.Elements (I)) > 0 then + A.Max_Length := L; + for I in 1 .. C1.Length loop + if Find (C2, C1.Base.Elements (I)) > 0 then P := P + 1; - A (P) := C1.Elements (I); + A.Elements (P) := C1.Base.Elements (I); end if; end loop; - return Container'(Elements => A); + return Container'(Length => P, Base => A); end Intersection; ------------ -- Length -- ------------ - function Length (C : Container) return Count_Type is (C.Elements'Length); - + function Length (C : Container) return Count_Type is (C.Length); --------------------- -- Num_Overlaps -- --------------------- @@ -166,8 +198,8 @@ package body Ada.Containers.Functional_Base with SPARK_Mode => Off is P : Count_Type := 0; begin - for I in C1.Elements'Range loop - if Find (C2, C1.Elements (I)) > 0 then + for I in 1 .. C1.Length loop + if Find (C2, C1.Base.Elements (I)) > 0 then P := P + 1; end if; end loop; @@ -180,20 +212,60 @@ package body Ada.Containers.Functional_Base with SPARK_Mode => Off is ------------ function Remove (C : Container; I : Index_Type) return Container is - A : constant Element_Array_Access := - new Element_Array'(1 .. C.Elements'Last - 1 => <>); - P : Count_Type := 0; + begin + if To_Count (I) = C.Length then + return Container'(Length => C.Length - 1, Base => C.Base); + else + declare + A : constant Array_Base_Access := Content_Init (C.Length - 1); + P : Count_Type := 0; + begin + A.Max_Length := C.Length - 1; + for J in 1 .. C.Length loop + if J /= To_Count (I) then + P := P + 1; + A.Elements (P) := C.Base.Elements (J); + end if; + end loop; + + return Container'(Length => C.Length - 1, Base => A); + end; + end if; + end Remove; + + ------------ + -- Resize -- + ------------ + procedure Resize (Base : Array_Base_Access) is begin - for J in C.Elements'Range loop - if J /= To_Count (I) then - P := P + 1; - A (P) := C.Elements (J); - end if; - end loop; + if Base.Max_Length < Base.Elements'Length then + return; + end if; - return Container'(Elements => A); - end Remove; + pragma Assert (Base.Max_Length = Base.Elements'Length); + + if Base.Max_Length = Count_Type'Last then + raise Constraint_Error; + end if; + + declare + procedure Finalize is new Ada.Unchecked_Deallocation + (Object => Element_Array, + Name => Element_Array_Access_Base); + + New_Length : constant Positive_Count_Type := + (if Base.Max_Length > Count_Type'Last / 2 then Count_Type'Last + else 2 * Base.Max_Length); + Elements : constant Element_Array_Access := + new Element_Array (1 .. New_Length); + Old_Elmts : Element_Array_Access_Base := Base.Elements; + begin + Elements (1 .. Base.Max_Length) := Base.Elements.all; + Base.Elements := Elements; + Finalize (Old_Elmts); + end; + end Resize; --------- -- Set -- @@ -205,10 +277,13 @@ package body Ada.Containers.Functional_Base with SPARK_Mode => Off is E : Element_Type) return Container is Result : constant Container := - Container'(Elements => new Element_Array'(C.Elements.all)); + Container'(Length => C.Length, + Base => Content_Init (C.Length)); begin - Result.Elements (To_Count (I)) := new Element_Type'(E); + Result.Base.Max_Length := C.Length; + Result.Base.Elements (1 .. C.Length) := C.Base.Elements (1 .. C.Length); + Result.Base.Elements (To_Count (I)) := new Element_Type'(E); return Result; end Set; @@ -230,20 +305,20 @@ package body Ada.Containers.Functional_Base with SPARK_Mode => Off is declare L : constant Count_Type := Length (C1) - N + Length (C2); - A : constant Element_Array_Access := - new Element_Array' - (C1.Elements.all & (Length (C1) + 1 .. L => <>)); + A : constant Array_Base_Access := Content_Init (L); P : Count_Type := Length (C1); begin - for I in C2.Elements'Range loop - if Find (C1, C2.Elements (I)) = 0 then + A.Max_Length := L; + A.Elements (1 .. C1.Length) := C1.Base.Elements (1 .. C1.Length); + for I in 1 .. C2.Length loop + if Find (C1, C2.Base.Elements (I)) = 0 then P := P + 1; - A (P) := C2.Elements (I); + A.Elements (P) := C2.Base.Elements (I); end if; end loop; - return Container'(Elements => A); + return Container'(Length => L, Base => A); end; end Union; diff --git a/gcc/ada/libgnat/a-cofuba.ads b/gcc/ada/libgnat/a-cofuba.ads index 301078225cc..b693baaf52f 100644 --- a/gcc/ada/libgnat/a-cofuba.ads +++ b/gcc/ada/libgnat/a-cofuba.ads @@ -105,13 +105,26 @@ private type Element_Array is array (Positive_Count_Type range <>) of Element_Access; - type Element_Array_Access is not null access Element_Array; + type Element_Array_Access_Base is access Element_Array; + + subtype Element_Array_Access is not null Element_Array_Access_Base; Empty_Element_Array_Access : constant Element_Array_Access := new Element_Array'(1 .. 0 => null); + type Array_Base is record + Max_Length : Count_Type; + Elements : Element_Array_Access; + end record; + + type Array_Base_Access is not null access Array_Base; + + function Content_Init (L : Count_Type := 0) return Array_Base_Access; + -- Used to initialize the content of an array base with length L + type Container is record - Elements : Element_Array_Access := Empty_Element_Array_Access; + Length : Count_Type := 0; + Base : Array_Base_Access := Content_Init; end record; end Ada.Containers.Functional_Base;