From mboxrd@z Thu Jan 1 00:00:00 1970 Return-Path: Received: by sourceware.org (Postfix, from userid 1914) id 1DF65385780F; Wed, 18 May 2022 08:44:49 +0000 (GMT) DKIM-Filter: OpenDKIM Filter v2.11.0 sourceware.org 1DF65385780F MIME-Version: 1.0 Content-Transfer-Encoding: 7bit Content-Type: text/plain; charset="utf-8" From: Pierre-Marie de Rodat To: gcc-cvs@gcc.gnu.org Subject: [gcc r13-607] [Ada] Disable Vet calls when container checks are disabled X-Act-Checkin: gcc X-Git-Author: Bob Duff X-Git-Refname: refs/heads/master X-Git-Oldrev: db67182120993abaff6bbaa1a64f1ba931a8380b X-Git-Newrev: 8502433d82079d2b01bbe0e324121dc1f658311b Message-Id: <20220518084449.1DF65385780F@sourceware.org> Date: Wed, 18 May 2022 08:44:49 +0000 (GMT) X-BeenThere: gcc-cvs@gcc.gnu.org X-Mailman-Version: 2.1.29 Precedence: list List-Id: Gcc-cvs mailing list List-Unsubscribe: , List-Archive: List-Help: List-Subscribe: , X-List-Received-Date: Wed, 18 May 2022 08:44:49 -0000 https://gcc.gnu.org/g:8502433d82079d2b01bbe0e324121dc1f658311b commit r13-607-g8502433d82079d2b01bbe0e324121dc1f658311b Author: Bob Duff Date: Thu Apr 7 12:58:56 2022 -0400 [Ada] Disable Vet calls when container checks are disabled 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. 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. Diff: --- gcc/ada/libgnat/a-cbdlli.adb | 6 +++++- gcc/ada/libgnat/a-cbhama.adb | 6 +++++- gcc/ada/libgnat/a-cbhase.adb | 6 +++++- gcc/ada/libgnat/a-cdlili.adb | 6 +++++- gcc/ada/libgnat/a-cfdlli.adb | 7 +++++-- gcc/ada/libgnat/a-cfhama.adb | 7 ++++++- gcc/ada/libgnat/a-cfhase.adb | 7 ++++++- gcc/ada/libgnat/a-cidlli.adb | 6 +++++- gcc/ada/libgnat/a-cihama.adb | 6 +++++- gcc/ada/libgnat/a-cihase.adb | 6 +++++- gcc/ada/libgnat/a-cohama.adb | 6 +++++- gcc/ada/libgnat/a-cohase.adb | 6 +++++- gcc/ada/libgnat/a-crbtgo.adb | 4 ++++ gcc/ada/libgnat/a-crbtgo.ads | 3 ++- gcc/ada/libgnat/a-crdlli.adb | 6 +++++- gcc/ada/libgnat/a-rbtgbo.adb | 5 ++++- gcc/ada/libgnat/a-rbtgbo.ads | 3 ++- 17 files changed, 79 insertions(+), 17 deletions(-) diff --git a/gcc/ada/libgnat/a-cbdlli.adb b/gcc/ada/libgnat/a-cbdlli.adb index 540fc932e71..d8cf6c3c7a4 100644 --- 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 index 59c4c7e2842..f557ff9c4ab 100644 --- 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 index 3c1c7b4bf67..9076d8e8132 100644 --- 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 index 582860742c1..22cb14679d2 100644 --- 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 index 14f0304e208..383d031d715 100644 --- 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 index c2a7c595854..0b60a010512 100644 --- 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 index 834f43a6c4e..544ad2bfa79 100644 --- 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 index 9a11f4cc56c..b34df0445dd 100644 --- 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 index 4734e640695..30a2f4daf92 100644 --- 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 index cb55bbb9ed4..090d01cb472 100644 --- 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 index 2fcf4c897b4..013e2cd03d0 100644 --- 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 index e9662cca13b..986b354ad72 100644 --- 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 index 7757aadaf1c..d689b1cb2ad 100644 --- 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 index fde9c4572bc..609fe4b4814 100644 --- 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 index a5fe4312413..bdb6475d67f 100644 --- 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 index c077788c48d..0c3f25f6d81 100644 --- 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 index 97c0ee021df..b3e0106cb44 100644 --- 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.