public inbox for gcc-cvs@sourceware.org
help / color / mirror / Atom feed
* [gcc r11-6221] [Ada] Performance of CW_Membership
@ 2020-12-17 10:52 Pierre-Marie de Rodat
0 siblings, 0 replies; only message in thread
From: Pierre-Marie de Rodat @ 2020-12-17 10:52 UTC (permalink / raw)
To: gcc-cvs
https://gcc.gnu.org/g:6a6926635c36e0ef2598b5399afdbfc2dbd4bf1f
commit r11-6221-g6a6926635c36e0ef2598b5399afdbfc2dbd4bf1f
Author: Arnaud Charlet <charlet@adacore.com>
Date: Thu Nov 19 05:42:03 2020 -0500
[Ada] Performance of CW_Membership
gcc/ada/
* libgnat/a-tags.ads, libgnat/a-tags.adb (CW_Membership): Move
to spec to allow inlining.
gcc/testsuite/
* gnat.dg/debug15.adb: Remove fragile testcase.
Diff:
---
gcc/ada/libgnat/a-tags.adb | 44 ----------------------------------
gcc/ada/libgnat/a-tags.ads | 50 +++++++++++++++++++++++++++++++++++----
gcc/testsuite/gnat.dg/debug15.adb | 23 ------------------
3 files changed, 46 insertions(+), 71 deletions(-)
diff --git a/gcc/ada/libgnat/a-tags.adb b/gcc/ada/libgnat/a-tags.adb
index 798780a4c1a..7138f762239 100644
--- a/gcc/ada/libgnat/a-tags.adb
+++ b/gcc/ada/libgnat/a-tags.adb
@@ -30,7 +30,6 @@
------------------------------------------------------------------------------
with Ada.Exceptions;
-with Ada.Unchecked_Conversion;
with System.HTable;
with System.Storage_Elements; use System.Storage_Elements;
@@ -96,12 +95,6 @@ package body Ada.Tags is
function To_Tag is
new Unchecked_Conversion (Integer_Address, Tag);
- function To_Addr_Ptr is
- new Ada.Unchecked_Conversion (System.Address, Addr_Ptr);
-
- function To_Address is
- new Ada.Unchecked_Conversion (Tag, System.Address);
-
function To_Dispatch_Table_Ptr is
new Ada.Unchecked_Conversion (Tag, Dispatch_Table_Ptr);
@@ -114,9 +107,6 @@ package body Ada.Tags is
function To_Tag_Ptr is
new Ada.Unchecked_Conversion (System.Address, Tag_Ptr);
- function To_Type_Specific_Data_Ptr is
- new Ada.Unchecked_Conversion (System.Address, Type_Specific_Data_Ptr);
-
-------------------------------
-- Inline_Always Subprograms --
-------------------------------
@@ -125,40 +115,6 @@ package body Ada.Tags is
-- avoid defeating the frontend inlining mechanism and thus ensure the
-- generation of their correct debug info.
- -------------------
- -- CW_Membership --
- -------------------
-
- -- Canonical implementation of Classwide Membership corresponding to:
-
- -- Obj in Typ'Class
-
- -- Each dispatch table contains a reference to a table of ancestors (stored
- -- in the first part of the Tags_Table) and a count of the level of
- -- inheritance "Idepth".
-
- -- Obj is in Typ'Class if Typ'Tag is in the table of ancestors that are
- -- contained in the dispatch table referenced by Obj'Tag . Knowing the
- -- level of inheritance of both types, this can be computed in constant
- -- time by the formula:
-
- -- TSD (Obj'tag).Tags_Table (TSD (Obj'tag).Idepth - TSD (Typ'tag).Idepth)
- -- = Typ'tag
-
- function CW_Membership (Obj_Tag : Tag; Typ_Tag : Tag) return Boolean is
- Obj_TSD_Ptr : constant Addr_Ptr :=
- To_Addr_Ptr (To_Address (Obj_Tag) - DT_Typeinfo_Ptr_Size);
- Typ_TSD_Ptr : constant Addr_Ptr :=
- To_Addr_Ptr (To_Address (Typ_Tag) - DT_Typeinfo_Ptr_Size);
- Obj_TSD : constant Type_Specific_Data_Ptr :=
- To_Type_Specific_Data_Ptr (Obj_TSD_Ptr.all);
- Typ_TSD : constant Type_Specific_Data_Ptr :=
- To_Type_Specific_Data_Ptr (Typ_TSD_Ptr.all);
- Pos : constant Integer := Obj_TSD.Idepth - Typ_TSD.Idepth;
- begin
- return Pos >= 0 and then Obj_TSD.Tags_Table (Pos) = Typ_Tag;
- end CW_Membership;
-
----------------------
-- Get_External_Tag --
----------------------
diff --git a/gcc/ada/libgnat/a-tags.ads b/gcc/ada/libgnat/a-tags.ads
index fb386c373f0..203f7ca95d4 100644
--- a/gcc/ada/libgnat/a-tags.ads
+++ b/gcc/ada/libgnat/a-tags.ads
@@ -65,6 +65,7 @@
-- length depends on the number of interfaces covered by a tagged type.
with System.Storage_Elements;
+with Ada.Unchecked_Conversion;
package Ada.Tags is
pragma Preelaborate;
@@ -501,10 +502,6 @@ private
-- dispatch table, return the tagged kind of a type in the context of
-- concurrency and limitedness.
- function CW_Membership (Obj_Tag : Tag; Typ_Tag : Tag) return Boolean;
- -- Given the tag of an object and the tag associated to a type, return
- -- true if Obj is in Typ'Class.
-
function IW_Membership (This : System.Address; T : Tag) return Boolean;
-- Ada 2005 (AI-251): General routine that checks if a given object
-- implements a tagged type. Its common usage is to check if Obj is in
@@ -623,4 +620,49 @@ private
-- This type is used by the frontend to generate the code that handles
-- dispatch table slots of types declared at the local level.
+ -------------------
+ -- CW_Membership --
+ -------------------
+
+ function To_Address is
+ new Ada.Unchecked_Conversion (Tag, System.Address);
+
+ function To_Addr_Ptr is
+ new Ada.Unchecked_Conversion (System.Address, Addr_Ptr);
+
+ function To_Type_Specific_Data_Ptr is
+ new Ada.Unchecked_Conversion (System.Address, Type_Specific_Data_Ptr);
+
+ -- Canonical implementation of Classwide Membership corresponding to:
+
+ -- Obj in Typ'Class
+
+ -- Each dispatch table contains a reference to a table of ancestors (stored
+ -- in the first part of the Tags_Table) and a count of the level of
+ -- inheritance "Idepth".
+
+ -- Obj is in Typ'Class if Typ'Tag is in the table of ancestors that are
+ -- contained in the dispatch table referenced by Obj'Tag . Knowing the
+ -- level of inheritance of both types, this can be computed in constant
+ -- time by the formula:
+
+ -- TSD (Obj'tag).Tags_Table (TSD (Obj'tag).Idepth - TSD (Typ'tag).Idepth)
+ -- = Typ'tag
+
+ function CW_Membership (Obj_Tag : Tag; Typ_Tag : Tag) return Boolean is
+ (declare
+ Obj_TSD_Ptr : constant Addr_Ptr :=
+ To_Addr_Ptr (To_Address (Obj_Tag) - DT_Typeinfo_Ptr_Size);
+ Typ_TSD_Ptr : constant Addr_Ptr :=
+ To_Addr_Ptr (To_Address (Typ_Tag) - DT_Typeinfo_Ptr_Size);
+ Obj_TSD : constant Type_Specific_Data_Ptr :=
+ To_Type_Specific_Data_Ptr (Obj_TSD_Ptr.all);
+ Typ_TSD : constant Type_Specific_Data_Ptr :=
+ To_Type_Specific_Data_Ptr (Typ_TSD_Ptr.all);
+ Pos : constant Integer := Obj_TSD.Idepth - Typ_TSD.Idepth;
+ begin
+ Pos >= 0 and then Obj_TSD.Tags_Table (Pos) = Typ_Tag);
+ -- Given the tag of an object and the tag associated to a type, return
+ -- true if Obj is in Typ'Class.
+
end Ada.Tags;
diff --git a/gcc/testsuite/gnat.dg/debug15.adb b/gcc/testsuite/gnat.dg/debug15.adb
deleted file mode 100644
index 75470e3c319..00000000000
--- a/gcc/testsuite/gnat.dg/debug15.adb
+++ /dev/null
@@ -1,23 +0,0 @@
--- { dg-do compile }
--- { dg-options "-g1" }
-
-procedure Debug15 is
-
- type Shape is abstract tagged record
- S : Integer;
- end record;
-
- type Rectangle is new Shape with record
- R : Integer;
- end record;
-
- X : Integer;
-
- R: Rectangle := (1, 2);
- S: Shape'Class := R;
-
-begin
- X := 12;
-end;
-
--- { dg-final { scan-assembler-not "loc 2" } }
^ permalink raw reply [flat|nested] only message in thread
only message in thread, other threads:[~2020-12-17 10:52 UTC | newest]
Thread overview: (only message) (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
2020-12-17 10:52 [gcc r11-6221] [Ada] Performance of CW_Membership 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).