ada: Reduce footprint of C++ exception interoperation support

The initial C++ base-type exception interoperation support change
brought all of GNAT.CPP* along with raise-gcc, because of
[__gnat_]Convert_Caught_Object.  Move that private but pragma-exported
function to GNAT.CPP.Std.Type_Info, so that it can rely on the C++
virtual/dispatch calls that justified the introduction of the Ada
wrapper type, to avoid emulating virtual calls in C or bringing in a
dependency on the C++ compiler and runtime.

Drop the CharPtr package instantiation, that brought a huge amount of
unnecessary code, and use string and storage primitives instead, using
the strcmp builtin directly for the C string compares.

Move the conversion to Ada String in Name to the wrapper interface in
GNAT.CPP.Std, adjusting the private internal type to shave off a few
more bytes from the only unit that raise-gcc will still need.

Finally, disable heap finalization for Type_Info_Ptr, to avoid
dragging in all of the finalization code.  Thank to Eric Botcazou for
the suggestion.

gcc/ada/ChangeLog:

	* libgnat/g-cppexc.adb (Convert_Caught_Object): Move...
	* libgnat/g-cstyin.adb (Convert_Caught_Object):  ... here.
	Use object call notation.
	(strcmp): New.
	(Char_Arr, CharPtr, Char_Pointer, To_chars_ptr): Drop.  Do not
	import Interfaces.C.Pointers.
	(To_Pointer): Convert from System.Address.
	(Name_Starts_With_Asterisk): Rename local variable.
	(Name_Past_Asterisk): Rewrite with System.Address and strcmp.
	Import System.Storage_Elements.
	(Equals): Use strcmp.
	(Before): Fix logic error.  Use strcmp.
	(Name): Move conversion to String...
	* libgnat/g-cppstd.adb (Name): ... here.  Import
	Interfaces.C.Strings.
	* libgnat/g-cppstd.ads (Type_Info_Ptr): Disable heap
	finalization.
	* libgnat/g-cstyin.ads (Name): Change return type.

diff --git a/gcc/ada/libgnat/g-cppexc.adb b/gcc/ada/libgnat/g-cppexc.adb
index 11022880670b281458e199822c7f1bc76e182ade..bad748fdfe35cc19073399139e72620d7baf8d00 100644 (file)
--- a/gcc/ada/libgnat/g-cppexc.adb
+++ b/gcc/ada/libgnat/g-cppexc.adb
@@ -267,44 +267,4 @@ package body GNAT.CPP_Exceptions is
 
    end Get_Type_Info;
 
-   function Convert_Caught_Object (Choice, Except : Type_Info_Ptr;
-                                   Thrown         : in out Address;
-                                   Lang           : Character)
-                                   return           Interfaces.C.C_bool;
-   pragma Export (Cpp, Convert_Caught_Object, "__gnat_convert_caught_object");
-   --  Convert the exception object at Thrown, under Lang convention,
-   --  from type Except to type Choice, adjusting Thrown as needed and
-   --  returning True, or returning False in case the conversion fails.
-
-   ---------------------------
-   -- Convert_Caught_Object --
-   ---------------------------
-
-   function Convert_Caught_Object (Choice, Except : Type_Info_Ptr;
-                                   Thrown         : in out Address;
-                                   Lang           : Character)
-                                   return           Interfaces.C.C_bool is
-   begin
-      if Equals (Choice, Except) then
-         return C_bool'(True);
-      end if;
-
-      if Lang = 'B' then
-         if Is_Pointer_P (Except) then
-            declare
-               Thrown_Indirect : Address;
-               for Thrown_Indirect'Address use Thrown;
-            begin
-               Thrown := Thrown_Indirect;
-            end;
-         end if;
-
-         if Do_Catch (Choice, Except, Thrown, 1) then
-            return C_bool'(True);
-         end if;
-      end if;
-
-      return C_bool'(False);
-   end Convert_Caught_Object;
-
 end GNAT.CPP_Exceptions;

diff --git a/gcc/ada/libgnat/g-cppstd.adb b/gcc/ada/libgnat/g-cppstd.adb
index 000dd474c5cd5fe742a35bbe9fec192593c571ca..8cb64edaffe98856bd24c2167b7fd622ed8e6194 100644 (file)
--- a/gcc/ada/libgnat/g-cppstd.adb
+++ b/gcc/ada/libgnat/g-cppstd.adb
@@ -34,6 +34,7 @@
 
 with GNAT.CPP.Std.Type_Info;
 with Ada.Unchecked_Conversion;
+with Interfaces.C.Strings; use Interfaces.C.Strings;
 
 package body GNAT.CPP.Std is
    ----------------------
@@ -53,7 +54,7 @@ package body GNAT.CPP.Std is
 
    function Name (this : Type_Info_Ptr)
                   return String
-   is (this.all.Name);
+   is (Value (this.all.Name));
 
    ---------------
    --  Before  ---

diff --git a/gcc/ada/libgnat/g-cppstd.ads b/gcc/ada/libgnat/g-cppstd.ads
index 63ef03e43ddc05d44e45cb5d1b6ced74cf1f7340..be8907c4f77d6eadad68c5c5e899dc9f68017e3f 100644 (file)
--- a/gcc/ada/libgnat/g-cppstd.ads
+++ b/gcc/ada/libgnat/g-cppstd.ads
@@ -50,7 +50,8 @@ package GNAT.CPP.Std is
    function Name (this : Type_Info_Ptr)
                   --  return Interfaces.C.Strings.chars_ptr;
                   return String;
-   --  Exposed std::type_info member function.
+   --  Exposed std::type_info member function.  ??? Would it ever be
+   --  desirable to get direct access to the internal chars_ptr?
 
    function Before (this, that : Type_Info_Ptr)
                     --  return Interfaces.C.Extensions.bool;
@@ -89,6 +90,7 @@ private
 
    type Type_Info_Ptr is access constant Type_Info.type_info'Class;
    pragma No_Strict_Aliasing (Type_Info_Ptr);
+   pragma No_Heap_Finalization (Type_Info_Ptr);
 
    No_Type_Info : constant Type_Info_Ptr := null;
 

diff --git a/gcc/ada/libgnat/g-cstyin.adb b/gcc/ada/libgnat/g-cstyin.adb
index 8036ed52762eaf59da02cd0625e1fc6c5ca2f6bb..b194f7f62b7ddd0d48b0afba423dc285b226be40 100644 (file)
--- a/gcc/ada/libgnat/g-cstyin.adb
+++ b/gcc/ada/libgnat/g-cstyin.adb
@@ -30,14 +30,17 @@
 ------------------------------------------------------------------------------
 
 with System; use System;
+with System.Storage_Elements; use System.Storage_Elements;
 with Interfaces.C; use Interfaces.C;
-with Interfaces.C.Pointers;
 with Interfaces.C.Extensions; use Interfaces.C.Extensions;
 with Interfaces.C.Strings; use Interfaces.C.Strings;
 with Ada.Unchecked_Conversion;
 
 package body GNAT.CPP.Std.Type_Info is
 
+   function strcmp (L, R : chars_ptr) return Interfaces.C.int;
+   pragma Import (Intrinsic, strcmp, "__builtin_strcmp");
+
    function Name_Starts_With_Asterisk (this : access constant type_info'Class)
                                        return Boolean;
 
@@ -46,35 +49,27 @@ package body GNAT.CPP.Std.Type_Info is
 
    function To_Address is
       new Ada.Unchecked_Conversion (chars_ptr, System.Address);
-
-   type Char_Arr is array (Natural range <>) of aliased char;
-   package CharPtr is
-      new Interfaces.C.Pointers (Natural, char, Char_Arr, nul);
-   type Char_Pointer is new CharPtr.Pointer;
-
    function To_Pointer is
-      new Ada.Unchecked_Conversion (chars_ptr, Char_Pointer);
-   function To_chars_ptr is
-      new Ada.Unchecked_Conversion (Char_Pointer, chars_ptr);
+      new Ada.Unchecked_Conversion (System.Address, chars_ptr);
 
    function Name_Starts_With_Asterisk (this : access constant type_info'Class)
                                        return Boolean is
-      A : constant Address := To_Address (this.Raw_Name);
+      Addr : constant System.Address := To_Address (this.Raw_Name);
       C : aliased char;
-      for C'Address use A;
+      for C'Address use Addr;
    begin
       return C = '*';
    end Name_Starts_With_Asterisk;
 
    function Name_Past_Asterisk (this : access constant type_info'Class)
                                 return chars_ptr is
-      Addr : Char_Pointer := To_Pointer (this.Raw_Name);
+      Addr : System.Address := To_Address (this.Raw_Name);
    begin
       if this.Name_Starts_With_Asterisk then
-         Increment (Addr);
+         Addr := Addr + Storage_Offset (1);
       end if;
 
-      return To_chars_ptr (Addr);
+      return To_Pointer (Addr);
    end Name_Past_Asterisk;
 
    ------------
@@ -82,8 +77,8 @@ package body GNAT.CPP.Std.Type_Info is
    ------------
 
    function Name (this : access constant type_info'Class)
-                  return String
-   is (Value (this.Name_Past_Asterisk));
+                  return chars_ptr
+   is (this.Name_Past_Asterisk);
 
    --------------
    --  Before  --
@@ -92,10 +87,10 @@ package body GNAT.CPP.Std.Type_Info is
    function Before (this, that : access constant type_info'Class)
                     return       Boolean is
    begin
-      if this.Name_Starts_With_Asterisk
-        or else that.Name_Starts_With_Asterisk
+      if not this.Name_Starts_With_Asterisk
+        or else not that.Name_Starts_With_Asterisk
       then
-         return this.Name < that.Name;
+         return strcmp (this.Raw_Name, that.Raw_Name) < 0;
       end if;
 
       return To_Address (this.Raw_Name) < To_Address (that.Raw_Name);
@@ -116,7 +111,50 @@ package body GNAT.CPP.Std.Type_Info is
          return False;
       end if;
 
-      return this.Name = that.Name;
+      return strcmp (this.Raw_Name, that.Raw_Name) = 0;
    end Equals;
 
+   function Convert_Caught_Object (Choice, Except : access type_info'Class;
+                                   Thrown         : in out Address;
+                                   Lang           : Character)
+                                   return           Interfaces.C.C_bool;
+   pragma Export (Cpp, Convert_Caught_Object, "__gnat_convert_caught_object");
+   --  Convert the exception object at Thrown, under Lang convention,
+   --  from type Except to type Choice, adjusting Thrown as needed and
+   --  returning True, or returning False in case the conversion
+   --  fails.  This is called from raise-gcc, and it is placed here
+   --  rather than in GNAT.CPP_Exceptions to avoid dragging all that
+   --  in when the program doesn't use C++ exceptions.
+
+   ---------------------------
+   -- Convert_Caught_Object --
+   ---------------------------
+
+   function Convert_Caught_Object (Choice, Except : access type_info'Class;
+                                   Thrown         : in out Address;
+                                   Lang           : Character)
+                                   return           Interfaces.C.C_bool is
+   begin
+      if Choice.Equals (Except) then
+         return C_bool'(True);
+      end if;
+
+      if Lang = 'B' then
+         if Except.Is_Pointer_P then
+            declare
+               Thrown_Indirect : Address;
+               for Thrown_Indirect'Address use Thrown;
+            begin
+               Thrown := Thrown_Indirect;
+            end;
+         end if;
+
+         if Choice.Do_Catch (Except, Thrown, 1) then
+            return C_bool'(True);
+         end if;
+      end if;
+
+      return C_bool'(False);
+   end Convert_Caught_Object;
+
 end GNAT.CPP.Std.Type_Info;

diff --git a/gcc/ada/libgnat/g-cstyin.ads b/gcc/ada/libgnat/g-cstyin.ads
index 06ed9588d536b15be75b8e5c04832fadca39bf3e..37dad4544f4c2ca349e5230a76c7edadf160a0aa 100644 (file)
--- a/gcc/ada/libgnat/g-cstyin.ads
+++ b/gcc/ada/libgnat/g-cstyin.ads
@@ -71,7 +71,7 @@ private package GNAT.CPP.Std.Type_Info is
    --  Reimplemented in Ada, using Ada types.
    function Name (this : access constant type_info'Class)
                   --  return Interfaces.C.Strings.chars_ptr;
-                  return String;
+                  return Interfaces.C.Strings.chars_ptr;
    --  pragma Import (CPP, Name, "_ZNKSt9type_info4nameEv");
    pragma Machine_Attribute (Name, "nothrow");