From 8502433d82079d2b01bbe0e324121dc1f658311b Mon Sep 17 00:00:00 2001 From: Bob Duff Date: Thu, 7 Apr 2022 12:58:56 -0400 Subject: [PATCH] [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. --- 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 540fc932e71e..d8cf6c3c7a44 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 59c4c7e2842e..f557ff9c4abb 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 3c1c7b4bf673..9076d8e81320 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 582860742c11..22cb14679d29 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 14f0304e2080..383d031d7154 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 c2a7c5958541..0b60a0105127 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 834f43a6c4e1..544ad2bfa797 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 9a11f4cc56ca..b34df0445ddc 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 4734e6406954..30a2f4daf925 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 cb55bbb9ed49..090d01cb4724 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 2fcf4c897b4f..013e2cd03d09 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 e9662cca13b5..986b354ad726 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 7757aadaf1c8..d689b1cb2ada 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 fde9c4572bca..609fe4b4814c 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 a5fe43124133..bdb6475d67f3 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 c077788c48dc..0c3f25f6d814 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 97c0ee021df1..b3e0106cb44b 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. -- 2.47.2