From patchwork Wed Jun 1 08:44:51 2022 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Pierre-Marie de Rodat X-Patchwork-Id: 54649 Return-Path: X-Original-To: patchwork@sourceware.org Delivered-To: patchwork@sourceware.org Received: from server2.sourceware.org (localhost [IPv6:::1]) by sourceware.org (Postfix) with ESMTP id 3544538356A1 for ; Wed, 1 Jun 2022 08:52:15 +0000 (GMT) DKIM-Filter: OpenDKIM Filter v2.11.0 sourceware.org 3544538356A1 DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=gcc.gnu.org; s=default; t=1654073535; bh=EwVhOj55okdH30UgoykMuQ/5sQv02mQtLeEa25BG70c=; h=Date:To:Subject:List-Id:List-Unsubscribe:List-Archive:List-Post: List-Help:List-Subscribe:From:Reply-To:Cc:From; b=U96sCIuH5DWpCCuu538bKz9UvGj3cmceotrszQ2xw0b17FjLzNpktZHINconAKtk6 X9ZjLxF5yB7cJTjjGfwa0uSe0yV97CYdYUZp0vBNAHz091Fa3sHwLJdVm2DWib+Rhv wvR0AUE4y0ahc06HTZU/NPfdRa02ZU4PbF0l+3no= X-Original-To: gcc-patches@gcc.gnu.org Delivered-To: gcc-patches@gcc.gnu.org Received: from mail-ed1-x52f.google.com (mail-ed1-x52f.google.com [IPv6:2a00:1450:4864:20::52f]) by sourceware.org (Postfix) with ESMTPS id 0C1DC3834E52 for ; Wed, 1 Jun 2022 08:44:54 +0000 (GMT) DMARC-Filter: OpenDMARC Filter v1.4.1 sourceware.org 0C1DC3834E52 Received: by mail-ed1-x52f.google.com with SMTP id b8so1173153edf.11 for ; Wed, 01 Jun 2022 01:44:53 -0700 (PDT) X-Google-DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=1e100.net; s=20210112; h=x-gm-message-state:date:from:to:cc:subject:message-id:mime-version :content-disposition; bh=EwVhOj55okdH30UgoykMuQ/5sQv02mQtLeEa25BG70c=; b=OPauVBr7l28uZdq4Fz9ct01t0agcP1vu5qDJ6ZG2d0MF1R85r9W0OxfASprU/85wS9 fc0HSEJyGyBy4Ow9EY9lOgMWG9tBsBjGN8uoWqaAebvFbK2PxL0asR62YY2O3hE66P3t BFVUzcfQyZkCBdy3BMbTV+Fjs/2BgsScAwOb+FDnq8C/M3Yn4Ox2Nq5XB3pKtOEM0y9I PIBaR/PbLr8X2vcxFJGnuvHX4UDBG8Eez1kbI0xAtIMpYVnzFTo5r3wprfFPEo0PDNQn i9xw6wqGI2ebW5tQRDIFjF9NW/8qXeAZ8el9BbM4vf5iTarvCOciEEifFE3NtwDXGWCt g0XA== X-Gm-Message-State: AOAM53232Lc/k0z4/FKnN0EZnJ/Am7OIaV43hfUH3fu7sAT4yTbMz6fh O+I++BnvQRda9SMqs2dorOxF0ER26t8/mg== X-Google-Smtp-Source: ABdhPJxTc33xznd2YIBDtoGxj+TcIyLXKElq0kkMZmbm+5wxpFFwEFOj6vMXioXAthcBSGHJTAUFPw== X-Received: by 2002:a05:6402:2211:b0:42d:cb9e:cbf with SMTP id cq17-20020a056402221100b0042dcb9e0cbfmr18615037edb.76.1654073092899; Wed, 01 Jun 2022 01:44:52 -0700 (PDT) Received: from adacore.com ([45.147.211.82]) by smtp.gmail.com with ESMTPSA id t10-20020a1709060c4a00b006fe9a2874cdsm443116ejf.103.2022.06.01.01.44.51 (version=TLS1_3 cipher=TLS_AES_256_GCM_SHA384 bits=256/256); Wed, 01 Jun 2022 01:44:52 -0700 (PDT) Date: Wed, 1 Jun 2022 08:44:51 +0000 To: gcc-patches@gcc.gnu.org Subject: [Ada] Add reference counting in functional containers Message-ID: <20220601084451.GA1238892@adacore.com> MIME-Version: 1.0 Content-Disposition: inline X-Spam-Status: No, score=-13.2 required=5.0 tests=BAYES_00, DKIM_SIGNED, DKIM_VALID, DKIM_VALID_AU, DKIM_VALID_EF, GIT_PATCH_0, RCVD_IN_DNSWL_NONE, SPF_HELO_NONE, SPF_PASS, TXREP, T_SCC_BODY_TEXT_LINE autolearn=ham autolearn_force=no version=3.4.6 X-Spam-Checker-Version: SpamAssassin 3.4.6 (2021-04-09) on server2.sourceware.org X-BeenThere: gcc-patches@gcc.gnu.org X-Mailman-Version: 2.1.29 Precedence: list List-Id: Gcc-patches mailing list List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , X-Patchwork-Original-From: Pierre-Marie de Rodat via Gcc-patches From: Pierre-Marie de Rodat Reply-To: Pierre-Marie de Rodat Cc: Julien Bortolussi Errors-To: gcc-patches-bounces+patchwork=sourceware.org@gcc.gnu.org Sender: "Gcc-patches" This patch adds reference counting to dynamically allocated pointers on arrays and elements used by the functional container. This is done by making both the arrays and the elements controlled. Tested on x86_64-pc-linux-gnu, committed on trunk gcc/ada/ * libgnat/a-cofuba.ads, libgnat/a-cofuba.adb: Add reference counting. diff --git a/gcc/ada/libgnat/a-cofuba.adb b/gcc/ada/libgnat/a-cofuba.adb --- a/gcc/ada/libgnat/a-cofuba.adb +++ b/gcc/ada/libgnat/a-cofuba.adb @@ -52,6 +52,24 @@ package body Ada.Containers.Functional_Base with SPARK_Mode => Off is -- Resize the underlying array if needed so that it can contain one more -- element. + function Elements (C : Container) return Element_Array_Access is + (C.Controlled_Base.Base.Elements) + with + Global => null, + Pre => + C.Controlled_Base.Base /= null + and then C.Controlled_Base.Base.Elements /= null; + + function Get + (C_E : Element_Array_Access; + I : Count_Type) + return Element_Access + is + (C_E (I).Ref.E_Access) + with + Global => null, + Pre => C_E /= null and then C_E (I).Ref /= null; + --------- -- "=" -- --------- @@ -61,9 +79,8 @@ package body Ada.Containers.Functional_Base with SPARK_Mode => Off is if C1.Length /= C2.Length then return False; end if; - for I in 1 .. C1.Length loop - if C1.Base.Elements (I).all /= C2.Base.Elements (I).all then + if Get (Elements (C1), I).all /= Get (Elements (C2), I).all then return False; end if; end loop; @@ -78,7 +95,7 @@ package body Ada.Containers.Functional_Base with SPARK_Mode => Off is function "<=" (C1 : Container; C2 : Container) return Boolean is begin for I in 1 .. C1.Length loop - if Find (C2, C1.Base.Elements (I)) = 0 then + if Find (C2, Get (Elements (C1), I)) = 0 then return False; end if; end loop; @@ -95,50 +112,138 @@ package body Ada.Containers.Functional_Base with SPARK_Mode => Off is I : Index_Type; E : Element_Type) return Container is + C_B : Array_Base_Access renames C.Controlled_Base.Base; begin - 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); + if To_Count (I) = C.Length + 1 and then C.Length = C_B.Max_Length then + Resize (C_B); + C_B.Max_Length := C_B.Max_Length + 1; + C_B.Elements (C_B.Max_Length) := Element_Init (E); - return Container'(Length => C.Base.Max_Length, Base => C.Base); + return Container'(Length => C_B.Max_Length, + Controlled_Base => C.Controlled_Base); else declare - A : constant Array_Base_Access := Content_Init (C.Length); + A : constant Array_Base_Controlled_Access := + Content_Init (C.Length); P : Count_Type := 0; begin - A.Max_Length := C.Length + 1; + A.Base.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); + A.Base.Elements (J) := C_B.Elements (P); else - A.Elements (J) := new Element_Type'(E); + A.Base.Elements (J) := Element_Init (E); end if; end loop; - return Container'(Length => A.Max_Length, - Base => A); + return Container'(Length => A.Base.Max_Length, + Controlled_Base => A); end; end if; end Add; + ------------ + -- Adjust -- + ------------ + + procedure Adjust (Controlled_Base : in out Array_Base_Controlled_Access) is + C_B : Array_Base_Access renames Controlled_Base.Base; + begin + if C_B /= null then + C_B.Reference_Count := C_B.Reference_Count + 1; + end if; + end Adjust; + + procedure Adjust (Ctrl_E : in out Controlled_Element_Access) is + begin + if Ctrl_E.Ref /= null then + Ctrl_E.Ref.Reference_Count := Ctrl_E.Ref.Reference_Count + 1; + end if; + end Adjust; + ------------------ -- Content_Init -- ------------------ - function Content_Init (L : Count_Type := 0) return Array_Base_Access + function Content_Init + (L : Count_Type := 0) return Array_Base_Controlled_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); + + -- The Access in the array will be initialized to null + Elements : constant Element_Array_Access := new Element_Array'(1 .. Size => <>); + B : constant Array_Base_Access := + new Array_Base'(Reference_Count => 1, + Max_Length => 0, + Elements => Elements); begin - return new Array_Base'(Max_Length => 0, Elements => Elements); + return (Ada.Finalization.Controlled with Base => B); end Content_Init; + ------------------ + -- Element_Init -- + ------------------ + + function Element_Init (E : Element_Type) return Controlled_Element_Access + is + Refcounted_E : constant Refcounted_Element_Access := + new Refcounted_Element'(Reference_Count => 1, + E_Access => new Element_Type'(E)); + begin + return (Ada.Finalization.Controlled with Ref => Refcounted_E); + end Element_Init; + + -------------- + -- Finalize -- + -------------- + + procedure Finalize (Controlled_Base : in out Array_Base_Controlled_Access) + is + procedure Unchecked_Free_Base is new Ada.Unchecked_Deallocation + (Object => Array_Base, + Name => Array_Base_Access); + procedure Unchecked_Free_Array is new Ada.Unchecked_Deallocation + (Object => Element_Array, + Name => Element_Array_Access); + + C_B : Array_Base_Access renames Controlled_Base.Base; + begin + if C_B /= null then + C_B.Reference_Count := C_B.Reference_Count - 1; + if C_B.Reference_Count = 0 then + Unchecked_Free_Array (Controlled_Base.Base.Elements); + Unchecked_Free_Base (Controlled_Base.Base); + end if; + C_B := null; + end if; + end Finalize; + + procedure Finalize (Ctrl_E : in out Controlled_Element_Access) is + procedure Unchecked_Free_Ref is new Ada.Unchecked_Deallocation + (Object => Refcounted_Element, + Name => Refcounted_Element_Access); + + procedure Unchecked_Free_Element is new Ada.Unchecked_Deallocation + (Object => Element_Type, + Name => Element_Access); + + begin + if Ctrl_E.Ref /= null then + Ctrl_E.Ref.Reference_Count := Ctrl_E.Ref.Reference_Count - 1; + if Ctrl_E.Ref.Reference_Count = 0 then + Unchecked_Free_Element (Ctrl_E.Ref.E_Access); + Unchecked_Free_Ref (Ctrl_E.Ref); + end if; + Ctrl_E.Ref := null; + end if; + end Finalize; + ---------- -- Find -- ---------- @@ -146,7 +251,7 @@ package body Ada.Containers.Functional_Base with SPARK_Mode => Off is function Find (C : Container; E : access Element_Type) return Count_Type is begin for I in 1 .. C.Length loop - if C.Base.Elements (I).all = E.all then + if Get (Elements (C), I).all = E.all then return I; end if; end loop; @@ -162,7 +267,7 @@ package body Ada.Containers.Functional_Base with SPARK_Mode => Off is --------- function Get (C : Container; I : Index_Type) return Element_Type is - (C.Base.Elements (To_Count (I)).all); + (Get (Elements (C), To_Count (I)).all); ------------------ -- Intersection -- @@ -170,19 +275,19 @@ package body Ada.Containers.Functional_Base with SPARK_Mode => Off is function Intersection (C1 : Container; C2 : Container) return Container is L : constant Count_Type := Num_Overlaps (C1, C2); - A : constant Array_Base_Access := Content_Init (L); + A : constant Array_Base_Controlled_Access := Content_Init (L); P : Count_Type := 0; begin - A.Max_Length := L; + A.Base.Max_Length := L; for I in 1 .. C1.Length loop - if Find (C2, C1.Base.Elements (I)) > 0 then + if Find (C2, Get (Elements (C1), I)) > 0 then P := P + 1; - A.Elements (P) := C1.Base.Elements (I); + A.Base.Elements (P) := Elements (C1) (I); end if; end loop; - return Container'(Length => P, Base => A); + return Container'(Length => P, Controlled_Base => A); end Intersection; ------------ @@ -199,7 +304,7 @@ package body Ada.Containers.Functional_Base with SPARK_Mode => Off is begin for I in 1 .. C1.Length loop - if Find (C2, C1.Base.Elements (I)) > 0 then + if Find (C2, Get (Elements (C1), I)) > 0 then P := P + 1; end if; end loop; @@ -214,21 +319,23 @@ package body Ada.Containers.Functional_Base with SPARK_Mode => Off is function Remove (C : Container; I : Index_Type) return Container is begin if To_Count (I) = C.Length then - return Container'(Length => C.Length - 1, Base => C.Base); + return Container'(Length => C.Length - 1, + Controlled_Base => C.Controlled_Base); else declare - A : constant Array_Base_Access := Content_Init (C.Length - 1); + A : constant Array_Base_Controlled_Access + := Content_Init (C.Length - 1); P : Count_Type := 0; begin - A.Max_Length := C.Length - 1; + A.Base.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); + A.Base.Elements (P) := Elements (C) (J); end if; end loop; - return Container'(Length => C.Length - 1, Base => A); + return Container'(Length => C.Length - 1, Controlled_Base => A); end; end if; end Remove; @@ -277,13 +384,14 @@ package body Ada.Containers.Functional_Base with SPARK_Mode => Off is E : Element_Type) return Container is Result : constant Container := - Container'(Length => C.Length, - Base => Content_Init (C.Length)); + Container'(Length => C.Length, + Controlled_Base => Content_Init (C.Length)); + R_Base : Array_Base_Access renames Result.Controlled_Base.Base; begin - 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); + R_Base.Max_Length := C.Length; + R_Base.Elements (1 .. C.Length) := Elements (C) (1 .. C.Length); + R_Base.Elements (To_Count (I)) := Element_Init (E); return Result; end Set; @@ -305,20 +413,19 @@ package body Ada.Containers.Functional_Base with SPARK_Mode => Off is declare L : constant Count_Type := Length (C1) - N + Length (C2); - A : constant Array_Base_Access := Content_Init (L); + A : constant Array_Base_Controlled_Access := Content_Init (L); P : Count_Type := Length (C1); - begin - A.Max_Length := L; - A.Elements (1 .. C1.Length) := C1.Base.Elements (1 .. C1.Length); + A.Base.Max_Length := L; + A.Base.Elements (1 .. C1.Length) := Elements (C1) (1 .. C1.Length); for I in 1 .. C2.Length loop - if Find (C1, C2.Base.Elements (I)) = 0 then + if Find (C1, Get (Elements (C2), I)) = 0 then P := P + 1; - A.Elements (P) := C2.Base.Elements (I); + A.Base.Elements (P) := Elements (C2) (I); end if; end loop; - return Container'(Length => L, Base => A); + return Container'(Length => L, Controlled_Base => A); end; end Union; diff --git a/gcc/ada/libgnat/a-cofuba.ads b/gcc/ada/libgnat/a-cofuba.ads --- a/gcc/ada/libgnat/a-cofuba.ads +++ b/gcc/ada/libgnat/a-cofuba.ads @@ -34,6 +34,10 @@ pragma Ada_2012; +-- To allow reference counting on the base container + +private with Ada.Finalization; + private generic type Index_Type is (<>); -- To avoid Constraint_Error being raised at run time, Index_Type'Base @@ -98,33 +102,97 @@ package Ada.Containers.Functional_Base with SPARK_Mode => Off is private + -- Theoretically, each operation on a functional container implies the + -- creation of a new container i.e. the copy of the array itself and all + -- the elements in it. In the implementation, most of these copies are + -- avoided by sharing between the containers. + -- + -- A container stores its last used index. So, when adding an + -- element at the end of the container, the exact same array can be reused. + -- As a functionnal container cannot be modifed once created, there is no + -- risk of unwanted modifications. + -- + -- _1_2_3_ + -- S : end => [1, 2, 3] + -- | + -- |1|2|3|4|.|.| + -- | + -- Add (S, 4, 4) : end => [1, 2, 3, 4] + -- + -- The elements are also shared between containers as much as possible. For + -- example, when something is added in the middle, the array is changed but + -- the elementes are reused. + -- + -- _1_2_3_4_ + -- S : |1|2|3|4| => [1, 2, 3, 4] + -- | \ \ \ + -- Add (S, 2, 5) : |1|5|2|3|4| => [1, 5, 2, 3, 4] + -- + -- To make this sharing possible, both the elements and the arrays are + -- stored inside dynamically allocated access types which shall be + -- deallocated when they are no longer used. The memory is managed using + -- reference counting both at the array and at the element level. + subtype Positive_Count_Type is Count_Type range 1 .. Count_Type'Last; + type Reference_Count_Type is new Natural; + type Element_Access is access all Element_Type; + type Refcounted_Element is record + Reference_Count : Reference_Count_Type; + E_Access : Element_Access; + end record; + + type Refcounted_Element_Access is access Refcounted_Element; + + type Controlled_Element_Access is new Ada.Finalization.Controlled + with record + Ref : Refcounted_Element_Access := null; + end record; + + function Element_Init (E : Element_Type) return Controlled_Element_Access; + -- Use to initialize a refcounted element + type Element_Array is - array (Positive_Count_Type range <>) of Element_Access; + array (Positive_Count_Type range <>) of Controlled_Element_Access; 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); + subtype Element_Array_Access is Element_Array_Access_Base; type Array_Base is record - Max_Length : Count_Type; - Elements : Element_Array_Access; + Reference_Count : Reference_Count_Type; + Max_Length : Count_Type; + Elements : Element_Array_Access; + end record; + + type Array_Base_Access is access Array_Base; + + type Array_Base_Controlled_Access is new Ada.Finalization.Controlled + with record + Base : Array_Base_Access; end record; - type Array_Base_Access is not null access Array_Base; + overriding procedure Adjust + (Controlled_Base : in out Array_Base_Controlled_Access); + + overriding procedure Finalize + (Controlled_Base : in out Array_Base_Controlled_Access); + + overriding procedure Adjust + (Ctrl_E : in out Controlled_Element_Access); + + overriding procedure Finalize + (Ctrl_E : in out Controlled_Element_Access); - function Content_Init (L : Count_Type := 0) return Array_Base_Access; + function Content_Init (L : Count_Type := 0) + return Array_Base_Controlled_Access; -- Used to initialize the content of an array base with length L type Container is record - Length : Count_Type := 0; - Base : Array_Base_Access := Content_Init; + Length : Count_Type := 0; + Controlled_Base : Array_Base_Controlled_Access := Content_Init; end record; end Ada.Containers.Functional_Base;