ada: Handle C++ exception hierarchies

This patch introduces support for defining exceptions in Ada with
C++'s notion of exception type compatibility, such as handling
occurrences of derived types, and obtaining class-wide access to the
thrown/raised objects.  As a bonus, it adds support for C++ dependent
(wrapped) exceptions, and introduces types and interfaces to match
C++'s std::type_info and std::exception.

Support for C++ exceptions with base-type matching, added to raise-gcc
by calling subprograms in Ada units, requires these units and their
dependencies to be linked into programs that link with raise-gcc.

gcc/ada/ChangeLog:

	* Makefile.rtl (GNATRTL_NONTASKING_OBJS): Add g-cpp, g-cppstd,
	and g-cstyin.
	* doc/gnat_rm/interfacing_to_other_languages.rst (Interfacing to C++):
	Document class-wide matching and new interfaces.
	* exp_prag.adb (Expand_Pragma_Import_Or_Interface): Add class-wide
	exception matching support with 'B' as language identifier.
	* libgnat/a-exexpr.adb (Setup_Current_Excep): Add Id formal.
	(Set_Foreign_Occurrence): Likewise.
	(Propagate_GCC_Exception): Adjust.
	(Set_Exception_Parameter): Likewise.
	(Unhandled_Except_Handler): Likewise.
	* libgnat/g-cpp.ads: New.
	* libgnat/g-cppexc.adb (Raise_Cpp_Exception): Match 'B' lang id.
	(Get_Object_Address): New.
	(Get_Object): Rewrite.
	(Get_Access_To_Object): New.
	(Get_Access_To_Tagged_Object): New.
	(Get_Type_Info): New.
	(Convert_Caught_Object): New.
	* libgnat/g-cppexc.ads (Get_Object_Address): New.
	(Get_Object): Note the Cpp Convention requirement.
	(Get_Access_To_Object): New.
	(Get_Access_To_Tagged_Object): New.
	(Get_Type_Info): New.
	* libgnat/g-cppstd.adb: New.
	* libgnat/g-cppstd.ads: New.
	* libgnat/g-csclex.ads: New, unused.
	* libgnat/g-cstyin.adb: New.
	* libgnat/g-cstyin.ads: New.
	* libgnat/g-excact.adb (Exception_Language): New.
	(Is_Foreign_Exception): Rewrite.
	* libgnat/g-excact.ads (Exception_Languages): New.
	(Exception_Language): New.
	* libgnat/s-stalib.ads (Lang): Document 'B'.
	* raise-gcc.c (__gnat_setup_current_excep): Add Exception_Id formal.
	(CXX_DEPENDENT_EXCEPTION_CLASS): New.
	(cxx_type_info): New.
	(__cxa_exception): Rename exceptionType to encompass PrimaryException.
	(_GNAT_Exception): Drop wrapper.
	(EID_For): Adjust.
	(exception_class_eq): Likewise.
	(__gnat_exception_language_is_cplusplus): New.
	(__gnat_exception_language_is_ada): New.
	(__gnat_convert_caught_object): Declare.
	(__gnat_get_cxx_dependent_exception): New.
	(__gnat_maybe_get_cxx_dependent_exception): New.
	(__gnat_get_cxx_exception_type_info): New.
	(__gnat_obtain_caught_object): New.
	(is_handled_by): Adjust.   [!CERT] Add eid formal, handle dependent
	exceptions and base-type matches.
	(get_action_description_for) [!CERT]: Add eid formal.  Adjust.
	(personality_body): Adjust.
	* gcc-interface/Make-lang.in (GNAT_ADA_OBJS, GNATBIND_OBJS) [!STAGE1]:
	Add new g-cpp, g-cppstd, g-cstyin + preexisting g-cppexc
	and i-cstrin.
	* gnat-style.texi: Regenerate.
	* gnat_rm.texi: Regenerate.

1 files changed, 115 insertions, 0 deletions

diff --git a/gcc/ada/libgnat/g-cppstd.adb b/gcc/ada/libgnat/g-cppstd.adb
new file mode 100644
index 0000000..000dd47
--- /dev/null
+++ b/gcc/ada/libgnat/g-cppstd.adb
@@ -0,0 +1,115 @@
+------------------------------------------------------------------------------
+--                                                                          --
+--                         GNAT RUN-TIME COMPONENTS                         --
+--                                                                          --
+--                         G N A T . C P P . S T D                          --
+--                                                                          --
+--                                 B o d y                                  --
+--                                                                          --
+--                     Copyright (C) 2022-2024, AdaCore                     --
+--                                                                          --
+-- GNAT is free software;  you can  redistribute it  and/or modify it under --
+-- terms of the  GNU General Public License as published  by the Free Soft- --
+-- ware  Foundation;  either version 3,  or (at your option) any later ver- --
+-- sion.  GNAT is distributed in the hope that it will be useful, but WITH- --
+-- OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY --
+-- or FITNESS FOR A PARTICULAR PURPOSE.                                     --
+--                                                                          --
+-- As a special exception under Section 7 of GPL version 3, you are granted --
+-- additional permissions described in the GCC Runtime Library Exception,   --
+-- version 3.1, as published by the Free Software Foundation.               --
+--                                                                          --
+-- You should have received a copy of the GNU General Public License and    --
+-- a copy of the GCC Runtime Library Exception along with this program;     --
+-- see the files COPYING3 and COPYING.RUNTIME respectively.  If not, see    --
+-- <http://www.gnu.org/licenses/>.                                          --
+--                                                                          --
+-- GNAT was originally developed  by the GNAT team at  New York University. --
+-- Extensive contributions were provided by Ada Core Technologies Inc.      --
+--                                                                          --
+------------------------------------------------------------------------------
+
+--  This package may provide an Ada interface for some C++ standard
+--  entities in the std namespace.
+
+with GNAT.CPP.Std.Type_Info;
+with Ada.Unchecked_Conversion;
+
+package body GNAT.CPP.Std is
+   ----------------------
+   -- To_Type_Info_Ptr --
+   ----------------------
+
+   function To_Type_Info_Ptr (S : System.Address) return Type_Info_Ptr is
+      function Impl is
+         new Ada.Unchecked_Conversion (System.Address, Type_Info_Ptr);
+   begin
+      return Impl (S);
+   end To_Type_Info_Ptr;
+
+   ------------
+   --  Name  --
+   ------------
+
+   function Name (this : Type_Info_Ptr)
+                  return String
+   is (this.all.Name);
+
+   ---------------
+   --  Before  ---
+   ---------------
+
+   function Before (this, that : Type_Info_Ptr)
+                    --  return Interfaces.C.Extensions.bool;
+                    return       Boolean
+   is (this.all.Before (that));
+
+   ---------------
+   --  Equals  ---
+   ---------------
+
+   function Equals (this, that : Type_Info_Ptr)
+                    --  return Interfaces.C.Extensions.bool;
+                    return       Boolean
+   is (this.all.Equals (that));
+
+   --------------------
+   --  Is_Pointer_P  --
+   --------------------
+
+   function Is_Pointer_P (this : Type_Info_Ptr)
+                          return Interfaces.C.Extensions.bool
+   is (this.all.Is_Pointer_P);
+
+   ---------------------
+   --  Is_Function_P  --
+   ---------------------
+
+   function Is_Function_P (this : Type_Info_Ptr)
+                           return Interfaces.C.Extensions.bool
+   is (this.all.Is_Function_P);
+
+   ----------------
+   --  Do_Catch ---
+   ----------------
+
+   function Do_Catch
+     (this          : Type_Info_Ptr;
+      thrown_type   : Type_Info_Ptr;
+      thrown_object : in out System.Address;
+      outer_count   : Interfaces.C.unsigned)
+      return          Interfaces.C.Extensions.bool
+   is (this.all.Do_Catch (thrown_type, thrown_object, outer_count));
+
+   -----------------
+   --  Do_Upcast ---
+   -----------------
+
+   function Do_Upcast
+     (this    : Type_Info_Ptr;
+      target  : Type_Info_Ptr;
+      obj_ptr : in out System.Address)
+      return    Interfaces.C.Extensions.bool
+   is (this.all.Do_Upcast (target, obj_ptr));
+
+end GNAT.CPP.Std;