From: Pierre-Marie de Rodat <derodat@adacore.com>
To: gcc-patches@gcc.gnu.org
Cc: Bob Duff <duff@adacore.com>
Subject: [Ada] Disable Vet calls when container checks are disabled
Date: Wed, 18 May 2022 08:43:25 +0000 [thread overview]
Message-ID: <20220518084325.GA3370909@adacore.com> (raw)
[-- Attachment #1: Type: text/plain, Size: 785 bytes --]
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.
[-- Attachment #2: patch.diff --]
[-- Type: text/x-diff, Size: 12263 bytes --]
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.
reply other threads:[~2022-05-18 8:43 UTC|newest]
Thread overview: [no followups] expand[flat|nested] mbox.gz Atom feed
Reply instructions:
You may reply publicly to this message via plain-text email
using any one of the following methods:
* Save the following mbox file, import it into your mail client,
and reply-to-all from there: mbox
Avoid top-posting and favor interleaved quoting:
https://en.wikipedia.org/wiki/Posting_style#Interleaved_style
* Reply using the --to, --cc, and --in-reply-to
switches of git-send-email(1):
git send-email \
--in-reply-to=20220518084325.GA3370909@adacore.com \
--to=derodat@adacore.com \
--cc=duff@adacore.com \
--cc=gcc-patches@gcc.gnu.org \
/path/to/YOUR_REPLY
https://kernel.org/pub/software/scm/git/docs/git-send-email.html
* If your mail client supports setting the In-Reply-To header
via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line
before the message body.
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).