* [Ada] Disable Vet calls when container checks are disabled
@ 2022-05-18 8:43 Pierre-Marie de Rodat
0 siblings, 0 replies; only message in thread
From: Pierre-Marie de Rodat @ 2022-05-18 8:43 UTC (permalink / raw)
To: gcc-patches; +Cc: Bob Duff
[-- 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.
^ permalink raw reply [flat|nested] only message in thread
only message in thread, other threads:[~2022-05-18 8:43 UTC | newest]
Thread overview: (only message) (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
2022-05-18 8:43 [Ada] Disable Vet calls when container checks are disabled Pierre-Marie de Rodat
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).