From mboxrd@z Thu Jan 1 00:00:00 1970 Return-Path: Received: from mail-wr1-x432.google.com (mail-wr1-x432.google.com [IPv6:2a00:1450:4864:20::432]) by sourceware.org (Postfix) with ESMTPS id A6F7B3857419 for ; Wed, 18 May 2022 08:43:26 +0000 (GMT) DMARC-Filter: OpenDMARC Filter v1.4.1 sourceware.org A6F7B3857419 Received: by mail-wr1-x432.google.com with SMTP id k30so1641482wrd.5 for ; Wed, 18 May 2022 01:43:26 -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=dKAYnvHuWjvQO3g7fpoqUgEYETXADEEgpjCX0gltmTM=; b=JRlgBAwkOkR9ZmTbulxL3IDIGjIYofbJPI5/8TZYcpWQeQq0nWgkkQV/pUHoKvAqco HQ1Cot//NM+jSXsdoRBDjrvtT7c/pcEohMGkTxsKiGrVDkgi+1UE/XxkieYFYbI+07CO n2ytJ+9LDFStD8z29j/0rVO+A2AdBJjoYEKY110CVJD5jMCFTz5gun8ZC05+w6JB7Fiy d1hHoF5e2+1YXrRQ7v2P65SZNwGXCJ9xa9YWFIAscCb5Rds5AcZNzfWzfPH7jKca+RGa 1Rt1uacJKrX7NpFo6TLTbooifwGFbRCnwWSbwp2zTNSdoGR8jUWmBhJY8oKe0wMgCn69 kLHw== X-Gm-Message-State: AOAM533G6r026TWQSyMuTlAsnnLhcnfpPDRXts/q6SmYGZS9j/dFXBy4 uh5dF7NZxWxatlF0TgKLmjUdi8o/m6ZOaA== X-Google-Smtp-Source: ABdhPJz0ChJNNqpEx61ZZga8V8zEcmewqU0tcb+w6ZNRsEc7u+xMRQNVn/X5TWFWyGVcuNaMYj7cXg== X-Received: by 2002:a5d:4561:0:b0:20d:3a3:c111 with SMTP id a1-20020a5d4561000000b0020d03a3c111mr14577973wrc.609.1652863406257; Wed, 18 May 2022 01:43:26 -0700 (PDT) Received: from adacore.com ([45.147.211.82]) by smtp.gmail.com with ESMTPSA id p9-20020adf9d89000000b0020c5253d925sm1255417wre.113.2022.05.18.01.43.25 (version=TLS1_3 cipher=TLS_AES_256_GCM_SHA384 bits=256/256); Wed, 18 May 2022 01:43:25 -0700 (PDT) Date: Wed, 18 May 2022 08:43:25 +0000 From: Pierre-Marie de Rodat To: gcc-patches@gcc.gnu.org Cc: Bob Duff Subject: [Ada] Disable Vet calls when container checks are disabled Message-ID: <20220518084325.GA3370909@adacore.com> MIME-Version: 1.0 Content-Type: multipart/mixed; boundary="C7zPtVaVf+AK4Oqc" Content-Disposition: inline X-Spam-Status: No, score=-12.8 required=5.0 tests=BAYES_00, DKIM_SIGNED, DKIM_VALID, DKIM_VALID_AU, DKIM_VALID_EF, GIT_PATCH_0, KAM_ASCII_DIVIDERS, 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-List-Received-Date: Wed, 18 May 2022 08:43:36 -0000 --C7zPtVaVf+AK4Oqc Content-Type: text/plain; charset=us-ascii Content-Disposition: inline Calls to various Vet functions are used throughout the containers packages to check internal consistency. This patch improves efficiency by disabling these calls when Container_Checks are suppressed. Tested on x86_64-pc-linux-gnu, committed on trunk gcc/ada/ * libgnat/a-crbtgo.ads, libgnat/a-rbtgbo.ads, libgnat/a-cbdlli.adb, libgnat/a-cbhama.adb, libgnat/a-cbhase.adb, libgnat/a-cdlili.adb, libgnat/a-cfdlli.adb, libgnat/a-cfhama.adb, libgnat/a-cfhase.adb, libgnat/a-cidlli.adb, libgnat/a-cihama.adb, libgnat/a-cihase.adb, libgnat/a-cohama.adb, libgnat/a-cohase.adb, libgnat/a-crbtgo.adb, libgnat/a-crdlli.adb, libgnat/a-rbtgbo.adb (Vet): Make the Vet functions do nothing when Container_Checks'Enabled is False, and inline them, so the calls disappear when optimizing. --C7zPtVaVf+AK4Oqc Content-Type: text/x-diff; charset=us-ascii Content-Disposition: attachment; filename="patch.diff" diff --git a/gcc/ada/libgnat/a-cbdlli.adb b/gcc/ada/libgnat/a-cbdlli.adb --- a/gcc/ada/libgnat/a-cbdlli.adb +++ b/gcc/ada/libgnat/a-cbdlli.adb @@ -75,7 +75,7 @@ is Src_Pos : Count_Type; Tgt_Pos : out Count_Type); - function Vet (Position : Cursor) return Boolean; + function Vet (Position : Cursor) return Boolean with Inline; -- Checks invariants of the cursor and its designated container, as a -- simple way of detecting dangling references (see operation Free for a -- description of the detection mechanism), returning True if all checks @@ -2210,6 +2210,10 @@ is function Vet (Position : Cursor) return Boolean is begin + if not Container_Checks'Enabled then + return True; + end if; + if Position.Node = 0 then return Position.Container = null; end if; diff --git a/gcc/ada/libgnat/a-cbhama.adb b/gcc/ada/libgnat/a-cbhama.adb --- a/gcc/ada/libgnat/a-cbhama.adb +++ b/gcc/ada/libgnat/a-cbhama.adb @@ -66,7 +66,7 @@ is procedure Set_Next (Node : in out Node_Type; Next : Count_Type); pragma Inline (Set_Next); - function Vet (Position : Cursor) return Boolean; + function Vet (Position : Cursor) return Boolean with Inline; -------------------------- -- Local Instantiations -- @@ -1175,6 +1175,10 @@ is function Vet (Position : Cursor) return Boolean is begin + if not Container_Checks'Enabled then + return True; + end if; + if Position.Node = 0 then return Position.Container = null; end if; diff --git a/gcc/ada/libgnat/a-cbhase.adb b/gcc/ada/libgnat/a-cbhase.adb --- a/gcc/ada/libgnat/a-cbhase.adb +++ b/gcc/ada/libgnat/a-cbhase.adb @@ -79,7 +79,7 @@ is procedure Set_Next (Node : in out Node_Type; Next : Count_Type); pragma Inline (Set_Next); - function Vet (Position : Cursor) return Boolean; + function Vet (Position : Cursor) return Boolean with Inline; -------------------------- -- Local Instantiations -- @@ -1496,6 +1496,10 @@ is function Vet (Position : Cursor) return Boolean is begin + if not Container_Checks'Enabled then + return True; + end if; + if Position.Node = 0 then return Position.Container = null; end if; diff --git a/gcc/ada/libgnat/a-cdlili.adb b/gcc/ada/libgnat/a-cdlili.adb --- a/gcc/ada/libgnat/a-cdlili.adb +++ b/gcc/ada/libgnat/a-cdlili.adb @@ -64,7 +64,7 @@ is Source : in out List; Position : Node_Access); - function Vet (Position : Cursor) return Boolean; + function Vet (Position : Cursor) return Boolean with Inline; -- Checks invariants of the cursor and its designated container, as a -- simple way of detecting dangling references (see operation Free for a -- description of the detection mechanism), returning True if all checks @@ -1991,6 +1991,10 @@ is function Vet (Position : Cursor) return Boolean is begin + if not Container_Checks'Enabled then + return True; + end if; + if Position.Node = null then return Position.Container = null; end if; diff --git a/gcc/ada/libgnat/a-cfdlli.adb b/gcc/ada/libgnat/a-cfdlli.adb --- a/gcc/ada/libgnat/a-cfdlli.adb +++ b/gcc/ada/libgnat/a-cfdlli.adb @@ -48,7 +48,7 @@ is Before : Count_Type; New_Node : Count_Type); - function Vet (L : List; Position : Cursor) return Boolean; + function Vet (L : List; Position : Cursor) return Boolean with Inline; --------- -- "=" -- @@ -1766,8 +1766,11 @@ is function Vet (L : List; Position : Cursor) return Boolean is N : Node_Array renames L.Nodes; - begin + if not Container_Checks'Enabled then + return True; + end if; + if L.Length = 0 then return False; end if; diff --git a/gcc/ada/libgnat/a-cfhama.adb b/gcc/ada/libgnat/a-cfhama.adb --- a/gcc/ada/libgnat/a-cfhama.adb +++ b/gcc/ada/libgnat/a-cfhama.adb @@ -68,7 +68,8 @@ is procedure Set_Next (Node : in out Node_Type; Next : Count_Type); pragma Inline (Set_Next); - function Vet (Container : Map; Position : Cursor) return Boolean; + function Vet (Container : Map; Position : Cursor) return Boolean + with Inline; -------------------------- -- Local Instantiations -- @@ -901,6 +902,10 @@ is function Vet (Container : Map; Position : Cursor) return Boolean is begin + if not Container_Checks'Enabled then + return True; + end if; + if Position.Node = 0 then return True; end if; diff --git a/gcc/ada/libgnat/a-cfhase.adb b/gcc/ada/libgnat/a-cfhase.adb --- a/gcc/ada/libgnat/a-cfhase.adb +++ b/gcc/ada/libgnat/a-cfhase.adb @@ -89,7 +89,8 @@ is procedure Set_Next (Node : in out Node_Type; Next : Count_Type); pragma Inline (Set_Next); - function Vet (Container : Set; Position : Cursor) return Boolean; + function Vet (Container : Set; Position : Cursor) return Boolean + with Inline; -------------------------- -- Local Instantiations -- @@ -1506,6 +1507,10 @@ is function Vet (Container : Set; Position : Cursor) return Boolean is begin + if not Container_Checks'Enabled then + return True; + end if; + if Position.Node = 0 then return True; end if; diff --git a/gcc/ada/libgnat/a-cidlli.adb b/gcc/ada/libgnat/a-cidlli.adb --- a/gcc/ada/libgnat/a-cidlli.adb +++ b/gcc/ada/libgnat/a-cidlli.adb @@ -67,7 +67,7 @@ is Source : in out List; Position : Node_Access); - function Vet (Position : Cursor) return Boolean; + function Vet (Position : Cursor) return Boolean with Inline; -- Checks invariants of the cursor and its designated container, as a -- simple way of detecting dangling references (see operation Free for a -- description of the detection mechanism), returning True if all checks @@ -2103,6 +2103,10 @@ is function Vet (Position : Cursor) return Boolean is begin + if not Container_Checks'Enabled then + return True; + end if; + if Position.Node = null then return Position.Container = null; end if; diff --git a/gcc/ada/libgnat/a-cihama.adb b/gcc/ada/libgnat/a-cihama.adb --- a/gcc/ada/libgnat/a-cihama.adb +++ b/gcc/ada/libgnat/a-cihama.adb @@ -85,7 +85,7 @@ is procedure Set_Next (Node : Node_Access; Next : Node_Access); pragma Inline (Set_Next); - function Vet (Position : Cursor) return Boolean; + function Vet (Position : Cursor) return Boolean with Inline; procedure Write_Node (Stream : not null access Root_Stream_Type'Class; @@ -1299,6 +1299,10 @@ is function Vet (Position : Cursor) return Boolean is begin + if not Container_Checks'Enabled then + return True; + end if; + if Position.Node = null then return Position.Container = null; end if; diff --git a/gcc/ada/libgnat/a-cihase.adb b/gcc/ada/libgnat/a-cihase.adb --- a/gcc/ada/libgnat/a-cihase.adb +++ b/gcc/ada/libgnat/a-cihase.adb @@ -99,7 +99,7 @@ is procedure Set_Next (Node : Node_Access; Next : Node_Access); pragma Inline (Set_Next); - function Vet (Position : Cursor) return Boolean; + function Vet (Position : Cursor) return Boolean with Inline; procedure Write_Node (Stream : not null access Root_Stream_Type'Class; @@ -1932,6 +1932,10 @@ is function Vet (Position : Cursor) return Boolean is begin + if not Container_Checks'Enabled then + return True; + end if; + if Position.Node = null then return Position.Container = null; end if; diff --git a/gcc/ada/libgnat/a-cohama.adb b/gcc/ada/libgnat/a-cohama.adb --- a/gcc/ada/libgnat/a-cohama.adb +++ b/gcc/ada/libgnat/a-cohama.adb @@ -80,7 +80,7 @@ is procedure Set_Next (Node : Node_Access; Next : Node_Access); pragma Inline (Set_Next); - function Vet (Position : Cursor) return Boolean; + function Vet (Position : Cursor) return Boolean with Inline; procedure Write_Node (Stream : not null access Root_Stream_Type'Class; @@ -1156,6 +1156,10 @@ is function Vet (Position : Cursor) return Boolean is begin + if not Container_Checks'Enabled then + return True; + end if; + if Position.Node = null then return Position.Container = null; end if; diff --git a/gcc/ada/libgnat/a-cohase.adb b/gcc/ada/libgnat/a-cohase.adb --- a/gcc/ada/libgnat/a-cohase.adb +++ b/gcc/ada/libgnat/a-cohase.adb @@ -99,7 +99,7 @@ is procedure Set_Next (Node : Node_Access; Next : Node_Access); pragma Inline (Set_Next); - function Vet (Position : Cursor) return Boolean; + function Vet (Position : Cursor) return Boolean with Inline; procedure Write_Node (Stream : not null access Root_Stream_Type'Class; @@ -1749,6 +1749,10 @@ is function Vet (Position : Cursor) return Boolean is begin + if not Container_Checks'Enabled then + return True; + end if; + if Position.Node = null then return Position.Container = null; end if; diff --git a/gcc/ada/libgnat/a-crbtgo.adb b/gcc/ada/libgnat/a-crbtgo.adb --- a/gcc/ada/libgnat/a-crbtgo.adb +++ b/gcc/ada/libgnat/a-crbtgo.adb @@ -1060,6 +1060,10 @@ package body Ada.Containers.Red_Black_Trees.Generic_Operations is function Vet (Tree : Tree_Type; Node : Node_Access) return Boolean is begin + if not Container_Checks'Enabled then + return True; + end if; + if Node = null then return True; end if; diff --git a/gcc/ada/libgnat/a-crbtgo.ads b/gcc/ada/libgnat/a-crbtgo.ads --- a/gcc/ada/libgnat/a-crbtgo.ads +++ b/gcc/ada/libgnat/a-crbtgo.ads @@ -61,7 +61,8 @@ package Ada.Containers.Red_Black_Trees.Generic_Operations is -- procedure Check_Invariant (Tree : Tree_Type); - function Vet (Tree : Tree_Type; Node : Node_Access) return Boolean; + function Vet (Tree : Tree_Type; Node : Node_Access) return Boolean + with Inline; -- Inspects Node to determine (to the extent possible) whether -- the node is valid; used to detect if the node is dangling. diff --git a/gcc/ada/libgnat/a-crdlli.adb b/gcc/ada/libgnat/a-crdlli.adb --- a/gcc/ada/libgnat/a-crdlli.adb +++ b/gcc/ada/libgnat/a-crdlli.adb @@ -51,7 +51,7 @@ package body Ada.Containers.Restricted_Doubly_Linked_Lists is Before : Count_Type; New_Node : Count_Type); - function Vet (Position : Cursor) return Boolean; + function Vet (Position : Cursor) return Boolean with Inline; --------- -- "=" -- @@ -1330,6 +1330,10 @@ package body Ada.Containers.Restricted_Doubly_Linked_Lists is function Vet (Position : Cursor) return Boolean is begin + if not Container_Checks'Enabled then + return True; + end if; + if Position.Node = 0 then return Position.Container = null; end if; diff --git a/gcc/ada/libgnat/a-rbtgbo.adb b/gcc/ada/libgnat/a-rbtgbo.adb --- a/gcc/ada/libgnat/a-rbtgbo.adb +++ b/gcc/ada/libgnat/a-rbtgbo.adb @@ -1038,8 +1038,11 @@ package body Ada.Containers.Red_Black_Trees.Generic_Bounded_Operations is function Vet (Tree : Tree_Type'Class; Index : Count_Type) return Boolean is Nodes : Nodes_Type renames Tree.Nodes; Node : Node_Type renames Nodes (Index); - begin + if not Container_Checks'Enabled then + return True; + end if; + if Parent (Node) = Index or else Left (Node) = Index or else Right (Node) = Index diff --git a/gcc/ada/libgnat/a-rbtgbo.ads b/gcc/ada/libgnat/a-rbtgbo.ads --- a/gcc/ada/libgnat/a-rbtgbo.ads +++ b/gcc/ada/libgnat/a-rbtgbo.ads @@ -70,7 +70,8 @@ package Ada.Containers.Red_Black_Trees.Generic_Bounded_Operations is function Max (Tree : Tree_Type'Class; Node : Count_Type) return Count_Type; -- Returns the largest-valued node of the subtree rooted at Node - function Vet (Tree : Tree_Type'Class; Index : Count_Type) return Boolean; + function Vet (Tree : Tree_Type'Class; Index : Count_Type) return Boolean + with Inline; -- Inspects Node to determine (to the extent possible) whether -- the node is valid; used to detect if the node is dangling. --C7zPtVaVf+AK4Oqc--