Index: a-exexpr.adb
===================================================================
--- a-exexpr.adb	(revision 247293)
+++ a-exexpr.adb	(working copy)
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 1992-2012, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2016, Free Software Foundation, Inc.         --
 --                                                                          --
 -- 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- --
@@ -29,71 +29,411 @@
 --                                                                          --
 ------------------------------------------------------------------------------
 
---  This is the default version, using the __builtin_setjmp/longjmp EH
---  mechanism.
+--  This is the version using the GCC EH mechanism
 
 with Ada.Unchecked_Conversion;
+with Ada.Unchecked_Deallocation;
 
+with System.Storage_Elements;   use System.Storage_Elements;
+with System.Exceptions.Machine; use System.Exceptions.Machine;
+
 separate (Ada.Exceptions)
 package body Exception_Propagation is
 
-   --  Common binding to __builtin_longjmp for sjlj variants.
+   use Exception_Traces;
 
-   procedure builtin_longjmp (buffer : System.Address; Flag : Integer);
-   pragma No_Return (builtin_longjmp);
-   pragma Import (Intrinsic, builtin_longjmp, "__builtin_longjmp");
+   Foreign_Exception : aliased System.Standard_Library.Exception_Data;
+   pragma Import (Ada, Foreign_Exception,
+                  "system__exceptions__foreign_exception");
+   --  Id for foreign exceptions
 
-   procedure Propagate_Continue (E : Exception_Id);
-   pragma No_Return (Propagate_Continue);
-   pragma Export (C, Propagate_Continue, "__gnat_raise_nodefer_with_msg");
-   --  A call to this procedure is inserted automatically by GIGI, in order
-   --  to continue the propagation when the exception was not handled.
-   --  The linkage name is historical.
+   --------------------------------------------------------------
+   -- GNAT Specific Entities To Deal With The GCC EH Circuitry --
+   --------------------------------------------------------------
 
+   procedure GNAT_GCC_Exception_Cleanup
+     (Reason : Unwind_Reason_Code;
+      Excep  : not null GNAT_GCC_Exception_Access);
+   pragma Convention (C, GNAT_GCC_Exception_Cleanup);
+   --  Procedure called when a GNAT GCC exception is free.
+
+   procedure Propagate_GCC_Exception
+     (GCC_Exception : not null GCC_Exception_Access);
+   pragma No_Return (Propagate_GCC_Exception);
+   --  Propagate a GCC exception
+
+   procedure Reraise_GCC_Exception
+     (GCC_Exception : not null GCC_Exception_Access);
+   pragma No_Return (Reraise_GCC_Exception);
+   pragma Export (C, Reraise_GCC_Exception, "__gnat_reraise_zcx");
+   --  Called to implement raise without exception, ie reraise. Called
+   --  directly from gigi.
+
+   function Setup_Current_Excep
+     (GCC_Exception : not null GCC_Exception_Access) return EOA;
+   pragma Export (C, Setup_Current_Excep, "__gnat_setup_current_excep");
+   --  Write Get_Current_Excep.all from GCC_Exception. Called by the
+   --  personality routine.
+
+   procedure Unhandled_Except_Handler
+     (GCC_Exception : not null GCC_Exception_Access);
+   pragma No_Return (Unhandled_Except_Handler);
+   pragma Export (C, Unhandled_Except_Handler,
+                  "__gnat_unhandled_except_handler");
+   --  Called for handle unhandled exceptions, ie the last chance handler
+   --  on platforms (such as SEH) that never returns after throwing an
+   --  exception. Called directly by gigi.
+
+   function CleanupUnwind_Handler
+     (UW_Version   : Integer;
+      UW_Phases    : Unwind_Action;
+      UW_Eclass    : Exception_Class;
+      UW_Exception : not null GCC_Exception_Access;
+      UW_Context   : System.Address;
+      UW_Argument  : System.Address) return Unwind_Reason_Code;
+   pragma Import (C, CleanupUnwind_Handler,
+                  "__gnat_cleanupunwind_handler");
+   --  Hook called at each step of the forced unwinding we perform to trigger
+   --  cleanups found during the propagation of an unhandled exception.
+
+   --  GCC runtime functions used. These are C non-void functions, actually,
+   --  but we ignore the return values. See raise.c as to why we are using
+   --  __gnat stubs for these.
+
+   procedure Unwind_RaiseException
+     (UW_Exception : not null GCC_Exception_Access);
+   pragma Import (C, Unwind_RaiseException, "__gnat_Unwind_RaiseException");
+
+   procedure Unwind_ForcedUnwind
+     (UW_Exception : not null GCC_Exception_Access;
+      UW_Handler   : System.Address;
+      UW_Argument  : System.Address);
+   pragma Import (C, Unwind_ForcedUnwind, "__gnat_Unwind_ForcedUnwind");
+
+   procedure Set_Exception_Parameter
+     (Excep         : EOA;
+      GCC_Exception : not null GCC_Exception_Access);
+   pragma Export
+     (C, Set_Exception_Parameter, "__gnat_set_exception_parameter");
+   --  Called inserted by gigi to set the exception choice parameter from the
+   --  gcc occurrence.
+
+   procedure Set_Foreign_Occurrence (Excep : EOA; Mo : System.Address);
+   --  Utility routine to initialize occurrence Excep from a foreign exception
+   --  whose machine occurrence is Mo. The message is empty, the backtrace
+   --  is empty too and the exception identity is Foreign_Exception.
+
+   --  Hooks called when entering/leaving an exception handler for a given
+   --  occurrence, aimed at handling the stack of active occurrences. The
+   --  calls are generated by gigi in tree_transform/N_Exception_Handler.
+
+   procedure Begin_Handler (GCC_Exception : not null GCC_Exception_Access);
+   pragma Export (C, Begin_Handler, "__gnat_begin_handler");
+
+   procedure End_Handler (GCC_Exception : GCC_Exception_Access);
+   pragma Export (C, End_Handler, "__gnat_end_handler");
+
+   --------------------------------------------------------------------
+   -- Accessors to Basic Components of a GNAT Exception Data Pointer --
+   --------------------------------------------------------------------
+
+   --  As of today, these are only used by the C implementation of the GCC
+   --  propagation personality routine to avoid having to rely on a C
+   --  counterpart of the whole exception_data structure, which is both
+   --  painful and error prone. These subprograms could be moved to a more
+   --  widely visible location if need be.
+
+   function Is_Handled_By_Others (E : Exception_Data_Ptr) return Boolean;
+   pragma Export (C, Is_Handled_By_Others, "__gnat_is_handled_by_others");
+   pragma Warnings (Off, Is_Handled_By_Others);
+
+   function Language_For (E : Exception_Data_Ptr) return Character;
+   pragma Export (C, Language_For, "__gnat_language_for");
+
+   function Foreign_Data_For (E : Exception_Data_Ptr) return Address;
+   pragma Export (C, Foreign_Data_For, "__gnat_foreign_data_for");
+
+   function EID_For (GNAT_Exception : not null GNAT_GCC_Exception_Access)
+     return Exception_Id;
+   pragma Export (C, EID_For, "__gnat_eid_for");
+
+   ---------------------------------------------------------------------------
+   -- Objects to materialize "others" and "all others" in the GCC EH tables --
+   ---------------------------------------------------------------------------
+
+   --  Currently, these only have their address taken and compared so there is
+   --  no real point having whole exception data blocks allocated. Note that
+   --  there are corresponding declarations in gigi (trans.c) which must be
+   --  kept properly synchronized.
+
+   Others_Value : constant Character := 'O';
+   pragma Export (C, Others_Value, "__gnat_others_value");
+
+   All_Others_Value : constant Character := 'A';
+   pragma Export (C, All_Others_Value, "__gnat_all_others_value");
+
+   Unhandled_Others_Value : constant Character := 'U';
+   pragma Export (C, Unhandled_Others_Value, "__gnat_unhandled_others_value");
+   --  Special choice (emitted by gigi) to catch and notify unhandled
+   --  exceptions on targets which always handle exceptions (such as SEH).
+   --  The handler will simply call Unhandled_Except_Handler.
+
    -------------------------
    -- Allocate_Occurrence --
    -------------------------
 
    function Allocate_Occurrence return EOA is
+      Res : GNAT_GCC_Exception_Access;
+
    begin
-      return Get_Current_Excep.all;
+      Res := New_Occurrence;
+      Res.Header.Cleanup := GNAT_GCC_Exception_Cleanup'Address;
+      Res.Occurrence.Machine_Occurrence := Res.all'Address;
+
+      return Res.Occurrence'Access;
    end Allocate_Occurrence;
 
+   --------------------------------
+   -- GNAT_GCC_Exception_Cleanup --
+   --------------------------------
+
+   procedure GNAT_GCC_Exception_Cleanup
+     (Reason : Unwind_Reason_Code;
+      Excep  : not null GNAT_GCC_Exception_Access)
+   is
+      pragma Unreferenced (Reason);
+
+      procedure Free is new Unchecked_Deallocation
+        (GNAT_GCC_Exception, GNAT_GCC_Exception_Access);
+
+      Copy : GNAT_GCC_Exception_Access := Excep;
+
+   begin
+      --  Simply free the memory
+
+      Free (Copy);
+   end GNAT_GCC_Exception_Cleanup;
+
+   ----------------------------
+   -- Set_Foreign_Occurrence --
+   ----------------------------
+
+   procedure Set_Foreign_Occurrence (Excep : EOA; Mo : System.Address) is
+   begin
+      Excep.all := (
+        Id                 => Foreign_Exception'Access,
+        Machine_Occurrence => Mo,
+        Msg                => <>,
+        Msg_Length         => 0,
+        Exception_Raised   => True,
+        Pid                => Local_Partition_ID,
+        Num_Tracebacks     => 0,
+        Tracebacks         => <>);
+   end Set_Foreign_Occurrence;
+
    -------------------------
+   -- Setup_Current_Excep --
+   -------------------------
+
+   function Setup_Current_Excep
+     (GCC_Exception : not null GCC_Exception_Access) return EOA
+   is
+      Excep : constant EOA := Get_Current_Excep.all;
+
+   begin
+      --  Setup the exception occurrence
+
+      if GCC_Exception.Class = GNAT_Exception_Class then
+
+         --  From the GCC exception
+
+         declare
+            GNAT_Occurrence : constant GNAT_GCC_Exception_Access :=
+                                To_GNAT_GCC_Exception (GCC_Exception);
+         begin
+            Excep.all := GNAT_Occurrence.Occurrence;
+            return GNAT_Occurrence.Occurrence'Access;
+         end;
+
+      else
+         --  A default one
+
+         Set_Foreign_Occurrence (Excep, GCC_Exception.all'Address);
+
+         return Excep;
+      end if;
+   end Setup_Current_Excep;
+
+   -------------------
+   -- Begin_Handler --
+   -------------------
+
+   procedure Begin_Handler (GCC_Exception : not null GCC_Exception_Access) is
+      pragma Unreferenced (GCC_Exception);
+   begin
+      null;
+   end Begin_Handler;
+
+   -----------------
+   -- End_Handler --
+   -----------------
+
+   procedure End_Handler (GCC_Exception : GCC_Exception_Access) is
+   begin
+      if GCC_Exception /= null then
+
+         --  The exception might have been reraised, in this case the cleanup
+         --  mustn't be called.
+
+         Unwind_DeleteException (GCC_Exception);
+      end if;
+   end End_Handler;
+
+   -----------------------------
+   -- Reraise_GCC_Exception --
+   -----------------------------
+
+   procedure Reraise_GCC_Exception
+     (GCC_Exception : not null GCC_Exception_Access)
+   is
+   begin
+      --  Simply propagate it
+
+      Propagate_GCC_Exception (GCC_Exception);
+   end Reraise_GCC_Exception;
+
+   -----------------------------
+   -- Propagate_GCC_Exception --
+   -----------------------------
+
+   --  Call Unwind_RaiseException to actually throw, taking care of handling
+   --  the two phase scheme it implements.
+
+   procedure Propagate_GCC_Exception
+     (GCC_Exception : not null GCC_Exception_Access)
+   is
+      Excep : EOA;
+
+   begin
+      --  Perform a standard raise first. If a regular handler is found, it
+      --  will be entered after all the intermediate cleanups have run. If
+      --  there is no regular handler, it will return.
+
+      Unwind_RaiseException (GCC_Exception);
+
+      --  If we get here we know the exception is not handled, as otherwise
+      --  Unwind_RaiseException arranges for the handler to be entered. Take
+      --  the necessary steps to enable the debugger to gain control while the
+      --  stack is still intact.
+
+      Excep := Setup_Current_Excep (GCC_Exception);
+      Notify_Unhandled_Exception (Excep);
+
+      --  Now, un a forced unwind to trigger cleanups. Control should not
+      --  resume there, if there are cleanups and in any cases as the
+      --  unwinding hook calls Unhandled_Exception_Terminate when end of
+      --  stack is reached.
+
+      Unwind_ForcedUnwind
+        (GCC_Exception,
+         CleanupUnwind_Handler'Address,
+         System.Null_Address);
+
+      --  We get here in case of error. The debugger has been notified before
+      --  the second step above.
+
+      Unhandled_Except_Handler (GCC_Exception);
+   end Propagate_GCC_Exception;
+
+   -------------------------
    -- Propagate_Exception --
    -------------------------
 
    procedure Propagate_Exception (Excep : EOA) is
-      Jumpbuf_Ptr : constant Address := Get_Jmpbuf_Address.all;
+   begin
+      Propagate_GCC_Exception (To_GCC_Exception (Excep.Machine_Occurrence));
+   end Propagate_Exception;
 
+   -----------------------------
+   -- Set_Exception_Parameter --
+   -----------------------------
+
+   procedure Set_Exception_Parameter
+     (Excep         : EOA;
+      GCC_Exception : not null GCC_Exception_Access)
+   is
    begin
-      --  If the jump buffer pointer is non-null, transfer control using
-      --  it. Otherwise announce an unhandled exception (note that this
-      --  means that we have no finalizations to do other than at the outer
-      --  level). Perform the necessary notification tasks in both cases.
+      --  Setup the exception occurrence
 
-      if Jumpbuf_Ptr /= Null_Address then
-         if not Excep.Exception_Raised then
-            Excep.Exception_Raised := True;
-            Exception_Traces.Notify_Handled_Exception (Excep);
-         end if;
+      if GCC_Exception.Class = GNAT_Exception_Class then
 
-         builtin_longjmp (Jumpbuf_Ptr, 1);
+         --  From the GCC exception
 
+         declare
+            GNAT_Occurrence : constant GNAT_GCC_Exception_Access :=
+                                To_GNAT_GCC_Exception (GCC_Exception);
+         begin
+            Save_Occurrence (Excep.all, GNAT_Occurrence.Occurrence);
+         end;
+
       else
-         Exception_Traces.Notify_Unhandled_Exception (Excep);
-         Exception_Traces.Unhandled_Exception_Terminate (Excep);
+         --  A default one
+
+         Set_Foreign_Occurrence (Excep, GCC_Exception.all'Address);
       end if;
-   end Propagate_Exception;
+   end Set_Exception_Parameter;
 
-   ------------------------
-   -- Propagate_Continue --
-   ------------------------
+   ------------------------------
+   -- Unhandled_Except_Handler --
+   ------------------------------
 
-   procedure Propagate_Continue (E : Exception_Id) is
-      pragma Unreferenced (E);
+   procedure Unhandled_Except_Handler
+     (GCC_Exception : not null GCC_Exception_Access)
+   is
+      Excep : EOA;
    begin
-      Propagate_Exception (Get_Current_Excep.all);
-   end Propagate_Continue;
+      Excep := Setup_Current_Excep (GCC_Exception);
+      Unhandled_Exception_Terminate (Excep);
+   end Unhandled_Except_Handler;
 
+   -------------
+   -- EID_For --
+   -------------
+
+   function EID_For
+     (GNAT_Exception : not null GNAT_GCC_Exception_Access) return Exception_Id
+   is
+   begin
+      return GNAT_Exception.Occurrence.Id;
+   end EID_For;
+
+   ----------------------
+   -- Foreign_Data_For --
+   ----------------------
+
+   function Foreign_Data_For
+     (E : SSL.Exception_Data_Ptr) return Address
+   is
+   begin
+      return E.Foreign_Data;
+   end Foreign_Data_For;
+
+   --------------------------
+   -- Is_Handled_By_Others --
+   --------------------------
+
+   function Is_Handled_By_Others (E : SSL.Exception_Data_Ptr) return Boolean is
+   begin
+      return not E.all.Not_Handled_By_Others;
+   end Is_Handled_By_Others;
+
+   ------------------
+   -- Language_For --
+   ------------------
+
+   function Language_For (E : SSL.Exception_Data_Ptr) return Character is
+   begin
+      return E.all.Lang;
+   end Language_For;
+
 end Exception_Propagation;
Index: a-exexpr-gcc.adb
===================================================================
--- a-exexpr-gcc.adb	(revision 247293)
+++ a-exexpr-gcc.adb	(working copy)
@@ -1,439 +0,0 @@
-------------------------------------------------------------------------------
---                                                                          --
---                         GNAT COMPILER COMPONENTS                         --
---                                                                          --
---  A D A . E X C E P T I O N S . E X C E P T I O N _ P R O P A G A T I O N --
---                                                                          --
---                                 B o d y                                  --
---                                                                          --
---          Copyright (C) 1992-2016, Free Software Foundation, Inc.         --
---                                                                          --
--- 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 is the version using the GCC EH mechanism
-
-with Ada.Unchecked_Conversion;
-with Ada.Unchecked_Deallocation;
-
-with System.Storage_Elements;   use System.Storage_Elements;
-with System.Exceptions.Machine; use System.Exceptions.Machine;
-
-separate (Ada.Exceptions)
-package body Exception_Propagation is
-
-   use Exception_Traces;
-
-   Foreign_Exception : aliased System.Standard_Library.Exception_Data;
-   pragma Import (Ada, Foreign_Exception,
-                  "system__exceptions__foreign_exception");
-   --  Id for foreign exceptions
-
-   --------------------------------------------------------------
-   -- GNAT Specific Entities To Deal With The GCC EH Circuitry --
-   --------------------------------------------------------------
-
-   procedure GNAT_GCC_Exception_Cleanup
-     (Reason : Unwind_Reason_Code;
-      Excep  : not null GNAT_GCC_Exception_Access);
-   pragma Convention (C, GNAT_GCC_Exception_Cleanup);
-   --  Procedure called when a GNAT GCC exception is free.
-
-   procedure Propagate_GCC_Exception
-     (GCC_Exception : not null GCC_Exception_Access);
-   pragma No_Return (Propagate_GCC_Exception);
-   --  Propagate a GCC exception
-
-   procedure Reraise_GCC_Exception
-     (GCC_Exception : not null GCC_Exception_Access);
-   pragma No_Return (Reraise_GCC_Exception);
-   pragma Export (C, Reraise_GCC_Exception, "__gnat_reraise_zcx");
-   --  Called to implement raise without exception, ie reraise. Called
-   --  directly from gigi.
-
-   function Setup_Current_Excep
-     (GCC_Exception : not null GCC_Exception_Access) return EOA;
-   pragma Export (C, Setup_Current_Excep, "__gnat_setup_current_excep");
-   --  Write Get_Current_Excep.all from GCC_Exception. Called by the
-   --  personality routine.
-
-   procedure Unhandled_Except_Handler
-     (GCC_Exception : not null GCC_Exception_Access);
-   pragma No_Return (Unhandled_Except_Handler);
-   pragma Export (C, Unhandled_Except_Handler,
-                  "__gnat_unhandled_except_handler");
-   --  Called for handle unhandled exceptions, ie the last chance handler
-   --  on platforms (such as SEH) that never returns after throwing an
-   --  exception. Called directly by gigi.
-
-   function CleanupUnwind_Handler
-     (UW_Version   : Integer;
-      UW_Phases    : Unwind_Action;
-      UW_Eclass    : Exception_Class;
-      UW_Exception : not null GCC_Exception_Access;
-      UW_Context   : System.Address;
-      UW_Argument  : System.Address) return Unwind_Reason_Code;
-   pragma Import (C, CleanupUnwind_Handler,
-                  "__gnat_cleanupunwind_handler");
-   --  Hook called at each step of the forced unwinding we perform to trigger
-   --  cleanups found during the propagation of an unhandled exception.
-
-   --  GCC runtime functions used. These are C non-void functions, actually,
-   --  but we ignore the return values. See raise.c as to why we are using
-   --  __gnat stubs for these.
-
-   procedure Unwind_RaiseException
-     (UW_Exception : not null GCC_Exception_Access);
-   pragma Import (C, Unwind_RaiseException, "__gnat_Unwind_RaiseException");
-
-   procedure Unwind_ForcedUnwind
-     (UW_Exception : not null GCC_Exception_Access;
-      UW_Handler   : System.Address;
-      UW_Argument  : System.Address);
-   pragma Import (C, Unwind_ForcedUnwind, "__gnat_Unwind_ForcedUnwind");
-
-   procedure Set_Exception_Parameter
-     (Excep         : EOA;
-      GCC_Exception : not null GCC_Exception_Access);
-   pragma Export
-     (C, Set_Exception_Parameter, "__gnat_set_exception_parameter");
-   --  Called inserted by gigi to set the exception choice parameter from the
-   --  gcc occurrence.
-
-   procedure Set_Foreign_Occurrence (Excep : EOA; Mo : System.Address);
-   --  Utility routine to initialize occurrence Excep from a foreign exception
-   --  whose machine occurrence is Mo. The message is empty, the backtrace
-   --  is empty too and the exception identity is Foreign_Exception.
-
-   --  Hooks called when entering/leaving an exception handler for a given
-   --  occurrence, aimed at handling the stack of active occurrences. The
-   --  calls are generated by gigi in tree_transform/N_Exception_Handler.
-
-   procedure Begin_Handler (GCC_Exception : not null GCC_Exception_Access);
-   pragma Export (C, Begin_Handler, "__gnat_begin_handler");
-
-   procedure End_Handler (GCC_Exception : GCC_Exception_Access);
-   pragma Export (C, End_Handler, "__gnat_end_handler");
-
-   --------------------------------------------------------------------
-   -- Accessors to Basic Components of a GNAT Exception Data Pointer --
-   --------------------------------------------------------------------
-
-   --  As of today, these are only used by the C implementation of the GCC
-   --  propagation personality routine to avoid having to rely on a C
-   --  counterpart of the whole exception_data structure, which is both
-   --  painful and error prone. These subprograms could be moved to a more
-   --  widely visible location if need be.
-
-   function Is_Handled_By_Others (E : Exception_Data_Ptr) return Boolean;
-   pragma Export (C, Is_Handled_By_Others, "__gnat_is_handled_by_others");
-   pragma Warnings (Off, Is_Handled_By_Others);
-
-   function Language_For (E : Exception_Data_Ptr) return Character;
-   pragma Export (C, Language_For, "__gnat_language_for");
-
-   function Foreign_Data_For (E : Exception_Data_Ptr) return Address;
-   pragma Export (C, Foreign_Data_For, "__gnat_foreign_data_for");
-
-   function EID_For (GNAT_Exception : not null GNAT_GCC_Exception_Access)
-     return Exception_Id;
-   pragma Export (C, EID_For, "__gnat_eid_for");
-
-   ---------------------------------------------------------------------------
-   -- Objects to materialize "others" and "all others" in the GCC EH tables --
-   ---------------------------------------------------------------------------
-
-   --  Currently, these only have their address taken and compared so there is
-   --  no real point having whole exception data blocks allocated. Note that
-   --  there are corresponding declarations in gigi (trans.c) which must be
-   --  kept properly synchronized.
-
-   Others_Value : constant Character := 'O';
-   pragma Export (C, Others_Value, "__gnat_others_value");
-
-   All_Others_Value : constant Character := 'A';
-   pragma Export (C, All_Others_Value, "__gnat_all_others_value");
-
-   Unhandled_Others_Value : constant Character := 'U';
-   pragma Export (C, Unhandled_Others_Value, "__gnat_unhandled_others_value");
-   --  Special choice (emitted by gigi) to catch and notify unhandled
-   --  exceptions on targets which always handle exceptions (such as SEH).
-   --  The handler will simply call Unhandled_Except_Handler.
-
-   -------------------------
-   -- Allocate_Occurrence --
-   -------------------------
-
-   function Allocate_Occurrence return EOA is
-      Res : GNAT_GCC_Exception_Access;
-
-   begin
-      Res := New_Occurrence;
-      Res.Header.Cleanup := GNAT_GCC_Exception_Cleanup'Address;
-      Res.Occurrence.Machine_Occurrence := Res.all'Address;
-
-      return Res.Occurrence'Access;
-   end Allocate_Occurrence;
-
-   --------------------------------
-   -- GNAT_GCC_Exception_Cleanup --
-   --------------------------------
-
-   procedure GNAT_GCC_Exception_Cleanup
-     (Reason : Unwind_Reason_Code;
-      Excep  : not null GNAT_GCC_Exception_Access)
-   is
-      pragma Unreferenced (Reason);
-
-      procedure Free is new Unchecked_Deallocation
-        (GNAT_GCC_Exception, GNAT_GCC_Exception_Access);
-
-      Copy : GNAT_GCC_Exception_Access := Excep;
-
-   begin
-      --  Simply free the memory
-
-      Free (Copy);
-   end GNAT_GCC_Exception_Cleanup;
-
-   ----------------------------
-   -- Set_Foreign_Occurrence --
-   ----------------------------
-
-   procedure Set_Foreign_Occurrence (Excep : EOA; Mo : System.Address) is
-   begin
-      Excep.all := (
-        Id                 => Foreign_Exception'Access,
-        Machine_Occurrence => Mo,
-        Msg                => <>,
-        Msg_Length         => 0,
-        Exception_Raised   => True,
-        Pid                => Local_Partition_ID,
-        Num_Tracebacks     => 0,
-        Tracebacks         => <>);
-   end Set_Foreign_Occurrence;
-
-   -------------------------
-   -- Setup_Current_Excep --
-   -------------------------
-
-   function Setup_Current_Excep
-     (GCC_Exception : not null GCC_Exception_Access) return EOA
-   is
-      Excep : constant EOA := Get_Current_Excep.all;
-
-   begin
-      --  Setup the exception occurrence
-
-      if GCC_Exception.Class = GNAT_Exception_Class then
-
-         --  From the GCC exception
-
-         declare
-            GNAT_Occurrence : constant GNAT_GCC_Exception_Access :=
-                                To_GNAT_GCC_Exception (GCC_Exception);
-         begin
-            Excep.all := GNAT_Occurrence.Occurrence;
-            return GNAT_Occurrence.Occurrence'Access;
-         end;
-
-      else
-         --  A default one
-
-         Set_Foreign_Occurrence (Excep, GCC_Exception.all'Address);
-
-         return Excep;
-      end if;
-   end Setup_Current_Excep;
-
-   -------------------
-   -- Begin_Handler --
-   -------------------
-
-   procedure Begin_Handler (GCC_Exception : not null GCC_Exception_Access) is
-      pragma Unreferenced (GCC_Exception);
-   begin
-      null;
-   end Begin_Handler;
-
-   -----------------
-   -- End_Handler --
-   -----------------
-
-   procedure End_Handler (GCC_Exception : GCC_Exception_Access) is
-   begin
-      if GCC_Exception /= null then
-
-         --  The exception might have been reraised, in this case the cleanup
-         --  mustn't be called.
-
-         Unwind_DeleteException (GCC_Exception);
-      end if;
-   end End_Handler;
-
-   -----------------------------
-   -- Reraise_GCC_Exception --
-   -----------------------------
-
-   procedure Reraise_GCC_Exception
-     (GCC_Exception : not null GCC_Exception_Access)
-   is
-   begin
-      --  Simply propagate it
-
-      Propagate_GCC_Exception (GCC_Exception);
-   end Reraise_GCC_Exception;
-
-   -----------------------------
-   -- Propagate_GCC_Exception --
-   -----------------------------
-
-   --  Call Unwind_RaiseException to actually throw, taking care of handling
-   --  the two phase scheme it implements.
-
-   procedure Propagate_GCC_Exception
-     (GCC_Exception : not null GCC_Exception_Access)
-   is
-      Excep : EOA;
-
-   begin
-      --  Perform a standard raise first. If a regular handler is found, it
-      --  will be entered after all the intermediate cleanups have run. If
-      --  there is no regular handler, it will return.
-
-      Unwind_RaiseException (GCC_Exception);
-
-      --  If we get here we know the exception is not handled, as otherwise
-      --  Unwind_RaiseException arranges for the handler to be entered. Take
-      --  the necessary steps to enable the debugger to gain control while the
-      --  stack is still intact.
-
-      Excep := Setup_Current_Excep (GCC_Exception);
-      Notify_Unhandled_Exception (Excep);
-
-      --  Now, un a forced unwind to trigger cleanups. Control should not
-      --  resume there, if there are cleanups and in any cases as the
-      --  unwinding hook calls Unhandled_Exception_Terminate when end of
-      --  stack is reached.
-
-      Unwind_ForcedUnwind
-        (GCC_Exception,
-         CleanupUnwind_Handler'Address,
-         System.Null_Address);
-
-      --  We get here in case of error. The debugger has been notified before
-      --  the second step above.
-
-      Unhandled_Except_Handler (GCC_Exception);
-   end Propagate_GCC_Exception;
-
-   -------------------------
-   -- Propagate_Exception --
-   -------------------------
-
-   procedure Propagate_Exception (Excep : EOA) is
-   begin
-      Propagate_GCC_Exception (To_GCC_Exception (Excep.Machine_Occurrence));
-   end Propagate_Exception;
-
-   -----------------------------
-   -- Set_Exception_Parameter --
-   -----------------------------
-
-   procedure Set_Exception_Parameter
-     (Excep         : EOA;
-      GCC_Exception : not null GCC_Exception_Access)
-   is
-   begin
-      --  Setup the exception occurrence
-
-      if GCC_Exception.Class = GNAT_Exception_Class then
-
-         --  From the GCC exception
-
-         declare
-            GNAT_Occurrence : constant GNAT_GCC_Exception_Access :=
-                                To_GNAT_GCC_Exception (GCC_Exception);
-         begin
-            Save_Occurrence (Excep.all, GNAT_Occurrence.Occurrence);
-         end;
-
-      else
-         --  A default one
-
-         Set_Foreign_Occurrence (Excep, GCC_Exception.all'Address);
-      end if;
-   end Set_Exception_Parameter;
-
-   ------------------------------
-   -- Unhandled_Except_Handler --
-   ------------------------------
-
-   procedure Unhandled_Except_Handler
-     (GCC_Exception : not null GCC_Exception_Access)
-   is
-      Excep : EOA;
-   begin
-      Excep := Setup_Current_Excep (GCC_Exception);
-      Unhandled_Exception_Terminate (Excep);
-   end Unhandled_Except_Handler;
-
-   -------------
-   -- EID_For --
-   -------------
-
-   function EID_For
-     (GNAT_Exception : not null GNAT_GCC_Exception_Access) return Exception_Id
-   is
-   begin
-      return GNAT_Exception.Occurrence.Id;
-   end EID_For;
-
-   ----------------------
-   -- Foreign_Data_For --
-   ----------------------
-
-   function Foreign_Data_For
-     (E : SSL.Exception_Data_Ptr) return Address
-   is
-   begin
-      return E.Foreign_Data;
-   end Foreign_Data_For;
-
-   --------------------------
-   -- Is_Handled_By_Others --
-   --------------------------
-
-   function Is_Handled_By_Others (E : SSL.Exception_Data_Ptr) return Boolean is
-   begin
-      return not E.all.Not_Handled_By_Others;
-   end Is_Handled_By_Others;
-
-   ------------------
-   -- Language_For --
-   ------------------
-
-   function Language_For (E : SSL.Exception_Data_Ptr) return Character is
-   begin
-      return E.all.Lang;
-   end Language_For;
-
-end Exception_Propagation;
Index: a-except.adb
===================================================================
--- a-except.adb	(revision 247293)
+++ a-except.adb	(working copy)
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 1992-2015, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2017, Free Software Foundation, Inc.         --
 --                                                                          --
 -- 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- --
@@ -29,8 +29,6 @@
 --                                                                          --
 ------------------------------------------------------------------------------
 
-pragma Compiler_Unit_Warning;
-
 pragma Style_Checks (All_Checks);
 --  No subprogram ordering check, due to logical grouping
 
@@ -39,16 +37,29 @@
 --  elaboration circularities with System.Exception_Tables.
 
 with System;                  use System;
+with System.Exceptions;       use System.Exceptions;
 with System.Exceptions_Debug; use System.Exceptions_Debug;
 with System.Standard_Library; use System.Standard_Library;
 with System.Soft_Links;       use System.Soft_Links;
+with System.WCh_Con;          use System.WCh_Con;
+with System.WCh_StW;          use System.WCh_StW;
 
+pragma Warnings (Off);
+--  Suppress complaints about Symbolic not being referenced, and about it not
+--  having pragma Preelaborate.
+with System.Traceback.Symbolic;
+--  Bring Symbolic into the closure. If it is the s-trasym-dwarf.adb version,
+--  it will install symbolic tracebacks as the default decorator. Otherwise,
+--  symbolic tracebacks are not supported, and we fall back to hexadecimal
+--  addresses.
+pragma Warnings (On);
+
 package body Ada.Exceptions is
 
    pragma Suppress (All_Checks);
-   --  We definitely do not want exceptions occurring within this unit, or we
-   --  are in big trouble. If an exceptional situation does occur, better that
-   --  it not be raised, since raising it can cause confusing chaos.
+   --  We definitely do not want exceptions occurring within this unit, or
+   --  we are in big trouble. If an exceptional situation does occur, better
+   --  that it not be raised, since raising it can cause confusing chaos.
 
    -----------------------
    -- Local Subprograms --
@@ -58,22 +69,47 @@
    --  from C clients using the given external name, even though they are not
    --  technically visible in the Ada sense.
 
-   procedure Process_Raise_Exception (E : Exception_Id);
-   pragma No_Return (Process_Raise_Exception);
-   --  This is the lowest level raise routine. It raises the exception
-   --  referenced by Current_Excep.all in the TSD, without deferring abort
-   --  (the caller must ensure that abort is deferred on entry).
+   function Code_Address_For_AAA return System.Address;
+   function Code_Address_For_ZZZ return System.Address;
+   --  Return start and end of procedures in this package
+   --
+   --  These procedures are used to provide exclusion bounds in
+   --  calls to Call_Chain at exception raise points from this unit. The
+   --  purpose is to arrange for the exception tracebacks not to include
+   --  frames from subprograms involved in the raise process, as these are
+   --  meaningless from the user's standpoint.
+   --
+   --  For these bounds to be meaningful, we need to ensure that the object
+   --  code for the subprograms involved in processing a raise is located
+   --  after the object code Code_Address_For_AAA and before the object
+   --  code Code_Address_For_ZZZ. This will indeed be the case as long as
+   --  the following rules are respected:
+   --
+   --  1) The bodies of the subprograms involved in processing a raise
+   --     are located after the body of Code_Address_For_AAA and before the
+   --     body of Code_Address_For_ZZZ.
+   --
+   --  2) No pragma Inline applies to any of these subprograms, as this
+   --     could delay the corresponding assembly output until the end of
+   --     the unit.
 
+   procedure Call_Chain (Excep : EOA);
+   --  Store up to Max_Tracebacks in Excep, corresponding to the current
+   --  call chain.
+
+   function Image (Index : Integer) return String;
+   --  Return string image corresponding to Index
+
    procedure To_Stderr (S : String);
    pragma Export (Ada, To_Stderr, "__gnat_to_stderr");
-   --  Little routine to output string to stderr that is also used in the
-   --  tasking run time.
+   --  Little routine to output string to stderr that is also used
+   --  in the tasking run time.
 
    procedure To_Stderr (C : Character);
    pragma Inline (To_Stderr);
    pragma Export (Ada, To_Stderr, "__gnat_to_stderr_char");
-   --  Little routine to output a character to stderr, used by some of the
-   --  separate units below.
+   --  Little routine to output a character to stderr, used by some of
+   --  the separate units below.
 
    package Exception_Data is
 
@@ -88,22 +124,21 @@
          Line   : Integer        := 0;
          Column : Integer        := 0;
          Msg2   : System.Address := System.Null_Address);
-      --  This routine is called to setup the exception referenced by the
-      --  Current_Excep field in the TSD to contain the indicated Id value
-      --  and message. Msg1 is a null terminated string which is generated
-      --  as the exception message. If line is non-zero, then a colon and
-      --  the decimal representation of this integer is appended to the
-      --  message. Ditto for Column. When Msg2 is non-null, a space and this
-      --  additional null terminated string is added to the message.
+      --  This routine is called to setup the exception referenced by X
+      --  to contain the indicated Id value and message. Msg1 is a null
+      --  terminated string which is generated as the exception message. If
+      --  line is non-zero, then a colon and the decimal representation of
+      --  this integer is appended to the message. Ditto for Column. When Msg2
+      --  is non-null, a space and this additional null terminated string is
+      --  added to the message.
 
       procedure Set_Exception_Msg
         (Excep   : EOA;
          Id      : Exception_Id;
          Message : String);
-      --  This routine is called to setup the exception referenced by the
-      --  Current_Excep field in the TSD to contain the indicated Id value and
-      --  message. Message is a string which is generated as the exception
-      --  message.
+      --  This routine is called to setup the exception referenced by X
+      --  to contain the indicated Id value and message. Message is a string
+      --  which is generated as the exception message.
 
       ---------------------------------------
       -- Exception Information Subprograms --
@@ -176,14 +211,29 @@
 
       procedure Unhandled_Exception_Terminate (Excep : EOA);
       pragma No_Return (Unhandled_Exception_Terminate);
-      --  This procedure is called to terminate program execution following an
-      --  unhandled exception. The exception information, including traceback
-      --  if available is output, and execution is then terminated. Note that
-      --  at the point where this routine is called, the stack has typically
-      --  been destroyed.
+      --  This procedure is called to terminate execution following an
+      --  unhandled exception. The exception information, including
+      --  traceback if available is output, and execution is then
+      --  terminated. Note that at the point where this routine is
+      --  called, the stack has typically been destroyed.
 
    end Exception_Traces;
 
+   package Exception_Propagation is
+
+      ---------------------------------------
+      -- Exception Propagation Subprograms --
+      ---------------------------------------
+
+      function Allocate_Occurrence return EOA;
+      --  Allocate an exception occurrence (as well as the machine occurrence)
+
+      procedure Propagate_Exception (Excep : EOA);
+      pragma No_Return (Propagate_Exception);
+      --  This procedure propagates the exception represented by Excep
+
+   end Exception_Propagation;
+
    package Stream_Attributes is
 
       ----------------------------------
@@ -201,18 +251,32 @@
 
    end Stream_Attributes;
 
-   procedure Raise_Current_Excep (E : Exception_Id);
-   pragma No_Return (Raise_Current_Excep);
-   pragma Export (C, Raise_Current_Excep, "__gnat_raise_nodefer_with_msg");
-   --  This is a simple wrapper to Process_Raise_Exception.
-   --
-   --  This external name for Raise_Current_Excep is historical, and probably
-   --  should be changed but for now we keep it, because gdb and gigi know
-   --  about it.
+   procedure Complete_Occurrence (X : EOA);
+   --  Finish building the occurrence: save the call chain and notify the
+   --  debugger.
 
+   procedure Complete_And_Propagate_Occurrence (X : EOA);
+   pragma No_Return (Complete_And_Propagate_Occurrence);
+   --  This is a simple wrapper to Complete_Occurrence and
+   --  Exception_Propagation.Propagate_Exception.
+
+   function Create_Occurrence_From_Signal_Handler
+     (E : Exception_Id;
+      M : System.Address) return EOA;
+   --  Create and build an exception occurrence using exception id E and
+   --  nul-terminated message M.
+
+   function Create_Machine_Occurrence_From_Signal_Handler
+     (E : Exception_Id;
+      M : System.Address) return System.Address;
+   pragma Export (C, Create_Machine_Occurrence_From_Signal_Handler,
+                  "__gnat_create_machine_occurrence_from_signal_handler");
+   --  Create and build an exception occurrence using exception id E and
+   --  nul-terminated message M. Return the machine occurrence.
+
    procedure Raise_Exception_No_Defer
-      (E       : Exception_Id;
-       Message : String := "");
+     (E       : Exception_Id;
+      Message : String := "");
    pragma Export
     (Ada, Raise_Exception_No_Defer,
      "ada__exceptions__raise_exception_no_defer");
@@ -222,45 +286,41 @@
    procedure Raise_With_Msg (E : Exception_Id);
    pragma No_Return (Raise_With_Msg);
    pragma Export (C, Raise_With_Msg, "__gnat_raise_with_msg");
-   --  Raises an exception with given exception id value. A message is
-   --  associated with the raise, and has already been stored in the exception
-   --  occurrence referenced by the Current_Excep in the TSD. Abort is deferred
-   --  before the raise call.
+   --  Raises an exception with given exception id value. A message
+   --  is associated with the raise, and has already been stored in the
+   --  exception occurrence referenced by the Current_Excep in the TSD.
+   --  Abort is deferred before the raise call.
 
    procedure Raise_With_Location_And_Msg
      (E : Exception_Id;
       F : System.Address;
       L : Integer;
+      C : Integer := 0;
       M : System.Address := System.Null_Address);
    pragma No_Return (Raise_With_Location_And_Msg);
    --  Raise an exception with given exception id value. A filename and line
    --  number is associated with the raise and is stored in the exception
-   --  occurrence and in addition a string message M is appended to this
-   --  if M is not null.
+   --  occurrence and in addition a column and a string message M may be
+   --  appended to this (if not null/0).
 
-   procedure Raise_Constraint_Error
-     (File : System.Address;
-      Line : Integer);
+   procedure Raise_Constraint_Error (File : System.Address; Line : Integer);
    pragma No_Return (Raise_Constraint_Error);
-   pragma Export
-     (C, Raise_Constraint_Error, "__gnat_raise_constraint_error");
+   pragma Export (C, Raise_Constraint_Error, "__gnat_raise_constraint_error");
    --  Raise constraint error with file:line information
 
    procedure Raise_Constraint_Error_Msg
-     (File : System.Address;
-      Line : Integer;
-      Msg  : System.Address);
+     (File   : System.Address;
+      Line   : Integer;
+      Column : Integer;
+      Msg    : System.Address);
    pragma No_Return (Raise_Constraint_Error_Msg);
    pragma Export
      (C, Raise_Constraint_Error_Msg, "__gnat_raise_constraint_error_msg");
-   --  Raise constraint error with file:line + msg information
+   --  Raise constraint error with file:line:col + msg information
 
-   procedure Raise_Program_Error
-     (File : System.Address;
-      Line : Integer);
+   procedure Raise_Program_Error (File : System.Address; Line : Integer);
    pragma No_Return (Raise_Program_Error);
-   pragma Export
-     (C, Raise_Program_Error, "__gnat_raise_program_error");
+   pragma Export (C, Raise_Program_Error, "__gnat_raise_program_error");
    --  Raise program error with file:line information
 
    procedure Raise_Program_Error_Msg
@@ -272,12 +332,9 @@
      (C, Raise_Program_Error_Msg, "__gnat_raise_program_error_msg");
    --  Raise program error with file:line + msg information
 
-   procedure Raise_Storage_Error
-     (File : System.Address;
-      Line : Integer);
+   procedure Raise_Storage_Error (File : System.Address; Line : Integer);
    pragma No_Return (Raise_Storage_Error);
-   pragma Export
-     (C, Raise_Storage_Error, "__gnat_raise_storage_error");
+   pragma Export (C, Raise_Storage_Error, "__gnat_raise_storage_error");
    --  Raise storage error with file:line information
 
    procedure Raise_Storage_Error_Msg
@@ -294,10 +351,10 @@
    --  graph below illustrates the relations between the Raise_ subprograms
    --  and identifies the points where basic flags such as Exception_Raised
    --  are initialized.
-   --
+
    --  (i) signs indicate the flags initialization points. R stands for Raise,
    --  W for With, and E for Exception.
-   --
+
    --                   R_No_Msg    R_E   R_Pe  R_Ce  R_Se
    --                       |        |     |     |     |
    --                       +--+  +--+     +---+ | +---+
@@ -308,23 +365,24 @@
    --                        |  |  |                  |
    --                        |  |  |             Set_E_C_Msg(i)
    --                        |  |  |
-   --                   Raise_Current_Excep
+   --            Complete_And_Propagate_Occurrence
 
    procedure Reraise;
    pragma No_Return (Reraise);
    pragma Export (C, Reraise, "__gnat_reraise");
-   --  Reraises the exception referenced by the Current_Excep field of the TSD
-   --  (all fields of this exception occurrence are set). Abort is deferred
-   --  before the reraise operation.
+   --  Reraises the exception referenced by the Current_Excep field
+   --  of the TSD (all fields of this exception occurrence are set).
+   --  Abort is deferred before the reraise operation. Called from
+   --  System.Tasking.RendezVous.Exceptional_Complete_RendezVous
 
    procedure Transfer_Occurrence
      (Target : Exception_Occurrence_Access;
       Source : Exception_Occurrence);
    pragma Export (C, Transfer_Occurrence, "__gnat_transfer_occurrence");
-   --  Called from System.Tasking.RendezVous.Exceptional_Complete_RendezVous
-   --  to setup Target from Source as an exception to be propagated in the
-   --  caller task. Target is expected to be a pointer to the fixed TSD
-   --  occurrence for this task.
+   --  Called from s-tasren.adb:Local_Complete_RendezVous and
+   --  s-tpobop.adb:Exceptional_Complete_Entry_Body to setup Target from
+   --  Source as an exception to be propagated in the caller task. Target is
+   --  expected to be a pointer to the fixed TSD occurrence for this task.
 
    --------------------------------
    -- Run-Time Check Subprograms --
@@ -334,91 +392,88 @@
    --  attached. The parameters are the file name and line number in each
    --  case. The names are defined by Exp_Ch11.Get_RT_Exception_Name.
 
-   --  Note on ordering of these subprograms. Normally in the Ada.Exceptions
-   --  units we do not care about the ordering of entries for Rcheck
-   --  subprograms, and the normal approach is to keep them in the same
-   --  order as declarations in Types.
-
-   --  This section is an IMPORTANT EXCEPTION. It is required by the .Net
-   --  runtime that the routine Rcheck_PE_Finalize_Raise_Exception is at the
-   --  end of the list (for reasons that are documented in the exceptmsg.awk
-   --  script which takes care of generating the required exception data).
-
-   procedure Rcheck_CE_Access_Check                   -- 00
+   procedure Rcheck_CE_Access_Check
      (File : System.Address; Line : Integer);
-   procedure Rcheck_CE_Null_Access_Parameter          -- 01
+   procedure Rcheck_CE_Null_Access_Parameter
      (File : System.Address; Line : Integer);
-   procedure Rcheck_CE_Discriminant_Check             -- 02
+   procedure Rcheck_CE_Discriminant_Check
      (File : System.Address; Line : Integer);
-   procedure Rcheck_CE_Divide_By_Zero                 -- 03
+   procedure Rcheck_CE_Divide_By_Zero
      (File : System.Address; Line : Integer);
-   procedure Rcheck_CE_Explicit_Raise                 -- 04
+   procedure Rcheck_CE_Explicit_Raise
      (File : System.Address; Line : Integer);
-   procedure Rcheck_CE_Index_Check                    -- 05
+   procedure Rcheck_CE_Index_Check
      (File : System.Address; Line : Integer);
-   procedure Rcheck_CE_Invalid_Data                   -- 06
+   procedure Rcheck_CE_Invalid_Data
      (File : System.Address; Line : Integer);
-   procedure Rcheck_CE_Length_Check                   -- 07
+   procedure Rcheck_CE_Length_Check
      (File : System.Address; Line : Integer);
-   procedure Rcheck_CE_Null_Exception_Id              -- 08
+   procedure Rcheck_CE_Null_Exception_Id
      (File : System.Address; Line : Integer);
-   procedure Rcheck_CE_Null_Not_Allowed               -- 09
+   procedure Rcheck_CE_Null_Not_Allowed
      (File : System.Address; Line : Integer);
-   procedure Rcheck_CE_Overflow_Check                 -- 10
+   procedure Rcheck_CE_Overflow_Check
      (File : System.Address; Line : Integer);
-   procedure Rcheck_CE_Partition_Check                -- 11
+   procedure Rcheck_CE_Partition_Check
      (File : System.Address; Line : Integer);
-   procedure Rcheck_CE_Range_Check                    -- 12
+   procedure Rcheck_CE_Range_Check
      (File : System.Address; Line : Integer);
-   procedure Rcheck_CE_Tag_Check                      -- 13
+   procedure Rcheck_CE_Tag_Check
      (File : System.Address; Line : Integer);
-   procedure Rcheck_PE_Access_Before_Elaboration      -- 14
+   procedure Rcheck_PE_Access_Before_Elaboration
      (File : System.Address; Line : Integer);
-   procedure Rcheck_PE_Accessibility_Check            -- 15
+   procedure Rcheck_PE_Accessibility_Check
      (File : System.Address; Line : Integer);
-   procedure Rcheck_PE_Address_Of_Intrinsic           -- 16
+   procedure Rcheck_PE_Address_Of_Intrinsic
      (File : System.Address; Line : Integer);
-   procedure Rcheck_PE_Aliased_Parameters             -- 17
+   procedure Rcheck_PE_Aliased_Parameters
      (File : System.Address; Line : Integer);
-   procedure Rcheck_PE_All_Guards_Closed              -- 18
+   procedure Rcheck_PE_All_Guards_Closed
      (File : System.Address; Line : Integer);
-   procedure Rcheck_PE_Bad_Predicated_Generic_Type    -- 19
+   procedure Rcheck_PE_Bad_Predicated_Generic_Type
      (File : System.Address; Line : Integer);
-   procedure Rcheck_PE_Current_Task_In_Entry_Body     -- 20
+   procedure Rcheck_PE_Current_Task_In_Entry_Body
      (File : System.Address; Line : Integer);
-   procedure Rcheck_PE_Duplicated_Entry_Address       -- 21
+   procedure Rcheck_PE_Duplicated_Entry_Address
      (File : System.Address; Line : Integer);
-   procedure Rcheck_PE_Explicit_Raise                 -- 22
+   procedure Rcheck_PE_Explicit_Raise
      (File : System.Address; Line : Integer);
-
-   procedure Rcheck_PE_Implicit_Return                -- 24
+   procedure Rcheck_PE_Implicit_Return
      (File : System.Address; Line : Integer);
-   procedure Rcheck_PE_Misaligned_Address_Value       -- 25
+   procedure Rcheck_PE_Misaligned_Address_Value
      (File : System.Address; Line : Integer);
-   procedure Rcheck_PE_Missing_Return                 -- 26
+   procedure Rcheck_PE_Missing_Return
      (File : System.Address; Line : Integer);
-   procedure Rcheck_PE_Overlaid_Controlled_Object     -- 27
+   procedure Rcheck_PE_Non_Transportable_Actual
      (File : System.Address; Line : Integer);
-   procedure Rcheck_PE_Potentially_Blocking_Operation -- 28
+   procedure Rcheck_PE_Overlaid_Controlled_Object
      (File : System.Address; Line : Integer);
-   procedure Rcheck_PE_Stubbed_Subprogram_Called      -- 29
+   procedure Rcheck_PE_Potentially_Blocking_Operation
      (File : System.Address; Line : Integer);
-   procedure Rcheck_PE_Unchecked_Union_Restriction    -- 30
+   procedure Rcheck_PE_Stubbed_Subprogram_Called
      (File : System.Address; Line : Integer);
-   procedure Rcheck_PE_Non_Transportable_Actual       -- 31
+   procedure Rcheck_PE_Unchecked_Union_Restriction
      (File : System.Address; Line : Integer);
-   procedure Rcheck_SE_Empty_Storage_Pool             -- 32
+   procedure Rcheck_SE_Empty_Storage_Pool
      (File : System.Address; Line : Integer);
-   procedure Rcheck_SE_Explicit_Raise                 -- 33
+   procedure Rcheck_SE_Explicit_Raise
      (File : System.Address; Line : Integer);
-   procedure Rcheck_SE_Infinite_Recursion             -- 34
+   procedure Rcheck_SE_Infinite_Recursion
      (File : System.Address; Line : Integer);
-   procedure Rcheck_SE_Object_Too_Large               -- 35
+   procedure Rcheck_SE_Object_Too_Large
      (File : System.Address; Line : Integer);
-   procedure Rcheck_PE_Stream_Operation_Not_Allowed   -- 36
+   procedure Rcheck_PE_Stream_Operation_Not_Allowed
      (File : System.Address; Line : Integer);
+   procedure Rcheck_CE_Access_Check_Ext
+     (File : System.Address; Line, Column : Integer);
+   procedure Rcheck_CE_Index_Check_Ext
+     (File : System.Address; Line, Column, Index, First, Last : Integer);
+   procedure Rcheck_CE_Invalid_Data_Ext
+     (File : System.Address; Line, Column, Index, First, Last : Integer);
+   procedure Rcheck_CE_Range_Check_Ext
+     (File : System.Address; Line, Column, Index, First, Last : Integer);
 
-   procedure Rcheck_PE_Finalize_Raised_Exception      -- 23
+   procedure Rcheck_PE_Finalize_Raised_Exception
      (File : System.Address; Line : Integer);
    --  This routine is separated out because it has quite different behavior
    --  from the others. This is the "finalize/adjust raised exception". This
@@ -500,6 +555,15 @@
    pragma Export (C, Rcheck_SE_Object_Too_Large,
                   "__gnat_rcheck_SE_Object_Too_Large");
 
+   pragma Export (C, Rcheck_CE_Access_Check_Ext,
+                  "__gnat_rcheck_CE_Access_Check_ext");
+   pragma Export (C, Rcheck_CE_Index_Check_Ext,
+                  "__gnat_rcheck_CE_Index_Check_ext");
+   pragma Export (C, Rcheck_CE_Invalid_Data_Ext,
+                  "__gnat_rcheck_CE_Invalid_Data_ext");
+   pragma Export (C, Rcheck_CE_Range_Check_Ext,
+                  "__gnat_rcheck_CE_Range_Check_ext");
+
    --  None of these procedures ever returns (they raise an exception). By
    --  using pragma No_Return, we ensure that any junk code after the call,
    --  such as normal return epilogue stuff, can be eliminated).
@@ -530,8 +594,8 @@
    pragma No_Return (Rcheck_PE_Implicit_Return);
    pragma No_Return (Rcheck_PE_Misaligned_Address_Value);
    pragma No_Return (Rcheck_PE_Missing_Return);
+   pragma No_Return (Rcheck_PE_Non_Transportable_Actual);
    pragma No_Return (Rcheck_PE_Overlaid_Controlled_Object);
-   pragma No_Return (Rcheck_PE_Non_Transportable_Actual);
    pragma No_Return (Rcheck_PE_Potentially_Blocking_Operation);
    pragma No_Return (Rcheck_PE_Stream_Operation_Not_Allowed);
    pragma No_Return (Rcheck_PE_Stubbed_Subprogram_Called);
@@ -542,125 +606,11 @@
    pragma No_Return (Rcheck_SE_Infinite_Recursion);
    pragma No_Return (Rcheck_SE_Object_Too_Large);
 
-   --  For compatibility with previous version of GNAT, to preserve bootstrap
+   pragma No_Return (Rcheck_CE_Access_Check_Ext);
+   pragma No_Return (Rcheck_CE_Index_Check_Ext);
+   pragma No_Return (Rcheck_CE_Invalid_Data_Ext);
+   pragma No_Return (Rcheck_CE_Range_Check_Ext);
 
-   procedure Rcheck_00 (File : System.Address; Line : Integer);
-   procedure Rcheck_01 (File : System.Address; Line : Integer);
-   procedure Rcheck_02 (File : System.Address; Line : Integer);
-   procedure Rcheck_03 (File : System.Address; Line : Integer);
-   procedure Rcheck_04 (File : System.Address; Line : Integer);
-   procedure Rcheck_05 (File : System.Address; Line : Integer);
-   procedure Rcheck_06 (File : System.Address; Line : Integer);
-   procedure Rcheck_07 (File : System.Address; Line : Integer);
-   procedure Rcheck_08 (File : System.Address; Line : Integer);
-   procedure Rcheck_09 (File : System.Address; Line : Integer);
-   procedure Rcheck_10 (File : System.Address; Line : Integer);
-   procedure Rcheck_11 (File : System.Address; Line : Integer);
-   procedure Rcheck_12 (File : System.Address; Line : Integer);
-   procedure Rcheck_13 (File : System.Address; Line : Integer);
-   procedure Rcheck_14 (File : System.Address; Line : Integer);
-   procedure Rcheck_15 (File : System.Address; Line : Integer);
-   procedure Rcheck_16 (File : System.Address; Line : Integer);
-   procedure Rcheck_17 (File : System.Address; Line : Integer);
-   procedure Rcheck_18 (File : System.Address; Line : Integer);
-   procedure Rcheck_19 (File : System.Address; Line : Integer);
-   procedure Rcheck_20 (File : System.Address; Line : Integer);
-   procedure Rcheck_21 (File : System.Address; Line : Integer);
-   procedure Rcheck_22 (File : System.Address; Line : Integer);
-   procedure Rcheck_23 (File : System.Address; Line : Integer);
-   procedure Rcheck_24 (File : System.Address; Line : Integer);
-   procedure Rcheck_25 (File : System.Address; Line : Integer);
-   procedure Rcheck_26 (File : System.Address; Line : Integer);
-   procedure Rcheck_27 (File : System.Address; Line : Integer);
-   procedure Rcheck_28 (File : System.Address; Line : Integer);
-   procedure Rcheck_29 (File : System.Address; Line : Integer);
-   procedure Rcheck_30 (File : System.Address; Line : Integer);
-   procedure Rcheck_31 (File : System.Address; Line : Integer);
-   procedure Rcheck_32 (File : System.Address; Line : Integer);
-   procedure Rcheck_33 (File : System.Address; Line : Integer);
-   procedure Rcheck_34 (File : System.Address; Line : Integer);
-   procedure Rcheck_35 (File : System.Address; Line : Integer);
-   procedure Rcheck_36 (File : System.Address; Line : Integer);
-
-   pragma Export (C, Rcheck_00, "__gnat_rcheck_00");
-   pragma Export (C, Rcheck_01, "__gnat_rcheck_01");
-   pragma Export (C, Rcheck_02, "__gnat_rcheck_02");
-   pragma Export (C, Rcheck_03, "__gnat_rcheck_03");
-   pragma Export (C, Rcheck_04, "__gnat_rcheck_04");
-   pragma Export (C, Rcheck_05, "__gnat_rcheck_05");
-   pragma Export (C, Rcheck_06, "__gnat_rcheck_06");
-   pragma Export (C, Rcheck_07, "__gnat_rcheck_07");
-   pragma Export (C, Rcheck_08, "__gnat_rcheck_08");
-   pragma Export (C, Rcheck_09, "__gnat_rcheck_09");
-   pragma Export (C, Rcheck_10, "__gnat_rcheck_10");
-   pragma Export (C, Rcheck_11, "__gnat_rcheck_11");
-   pragma Export (C, Rcheck_12, "__gnat_rcheck_12");
-   pragma Export (C, Rcheck_13, "__gnat_rcheck_13");
-   pragma Export (C, Rcheck_14, "__gnat_rcheck_14");
-   pragma Export (C, Rcheck_15, "__gnat_rcheck_15");
-   pragma Export (C, Rcheck_16, "__gnat_rcheck_16");
-   pragma Export (C, Rcheck_17, "__gnat_rcheck_17");
-   pragma Export (C, Rcheck_18, "__gnat_rcheck_18");
-   pragma Export (C, Rcheck_19, "__gnat_rcheck_19");
-   pragma Export (C, Rcheck_20, "__gnat_rcheck_20");
-   pragma Export (C, Rcheck_21, "__gnat_rcheck_21");
-   pragma Export (C, Rcheck_22, "__gnat_rcheck_22");
-   pragma Export (C, Rcheck_23, "__gnat_rcheck_23");
-   pragma Export (C, Rcheck_24, "__gnat_rcheck_24");
-   pragma Export (C, Rcheck_25, "__gnat_rcheck_25");
-   pragma Export (C, Rcheck_26, "__gnat_rcheck_26");
-   pragma Export (C, Rcheck_27, "__gnat_rcheck_27");
-   pragma Export (C, Rcheck_28, "__gnat_rcheck_28");
-   pragma Export (C, Rcheck_29, "__gnat_rcheck_29");
-   pragma Export (C, Rcheck_30, "__gnat_rcheck_30");
-   pragma Export (C, Rcheck_31, "__gnat_rcheck_31");
-   pragma Export (C, Rcheck_32, "__gnat_rcheck_32");
-   pragma Export (C, Rcheck_33, "__gnat_rcheck_33");
-   pragma Export (C, Rcheck_34, "__gnat_rcheck_34");
-   pragma Export (C, Rcheck_35, "__gnat_rcheck_35");
-   pragma Export (C, Rcheck_36, "__gnat_rcheck_36");
-
-   --  None of these procedures ever returns (they raise an exception). By
-   --  using pragma No_Return, we ensure that any junk code after the call,
-   --  such as normal return epilogue stuff, can be eliminated).
-
-   pragma No_Return (Rcheck_00);
-   pragma No_Return (Rcheck_01);
-   pragma No_Return (Rcheck_02);
-   pragma No_Return (Rcheck_03);
-   pragma No_Return (Rcheck_04);
-   pragma No_Return (Rcheck_05);
-   pragma No_Return (Rcheck_06);
-   pragma No_Return (Rcheck_07);
-   pragma No_Return (Rcheck_08);
-   pragma No_Return (Rcheck_09);
-   pragma No_Return (Rcheck_10);
-   pragma No_Return (Rcheck_11);
-   pragma No_Return (Rcheck_12);
-   pragma No_Return (Rcheck_13);
-   pragma No_Return (Rcheck_14);
-   pragma No_Return (Rcheck_15);
-   pragma No_Return (Rcheck_16);
-   pragma No_Return (Rcheck_17);
-   pragma No_Return (Rcheck_18);
-   pragma No_Return (Rcheck_19);
-   pragma No_Return (Rcheck_20);
-   pragma No_Return (Rcheck_21);
-   pragma No_Return (Rcheck_22);
-   pragma No_Return (Rcheck_23);
-   pragma No_Return (Rcheck_24);
-   pragma No_Return (Rcheck_25);
-   pragma No_Return (Rcheck_26);
-   pragma No_Return (Rcheck_27);
-   pragma No_Return (Rcheck_28);
-   pragma No_Return (Rcheck_29);
-   pragma No_Return (Rcheck_30);
-   pragma No_Return (Rcheck_32);
-   pragma No_Return (Rcheck_33);
-   pragma No_Return (Rcheck_34);
-   pragma No_Return (Rcheck_35);
-   pragma No_Return (Rcheck_36);
-
    ---------------------------------------------
    -- Reason Strings for Run-Time Check Calls --
    ---------------------------------------------
@@ -727,6 +677,33 @@
    --  The actual polling routine is separate, so that it can easily be
    --  replaced with a target dependent version.
 
+   --------------------------
+   -- Code_Address_For_AAA --
+   --------------------------
+
+   --  This function gives us the start of the PC range for addresses within
+   --  the exception unit itself. We hope that gigi/gcc keep all the procedures
+   --  in their original order.
+
+   function Code_Address_For_AAA return System.Address is
+   begin
+      --  We are using a label instead of Code_Address_For_AAA'Address because
+      --  on some platforms the latter does not yield the address we want, but
+      --  the address of a stub or of a descriptor instead. This is the case at
+      --  least on PA-HPUX.
+
+      <<Start_Of_AAA>>
+      return Start_Of_AAA'Address;
+   end Code_Address_For_AAA;
+
+   ----------------
+   -- Call_Chain --
+   ----------------
+
+   procedure Call_Chain (Excep : EOA) is separate;
+   --  The actual Call_Chain routine is separate, so that it can easily
+   --  be dummied out when no exception traceback information is needed.
+
    -------------------
    -- EId_To_String --
    -------------------
@@ -752,9 +729,9 @@
      (X : Exception_Occurrence) return Exception_Id
    is
    begin
-      --  Note that the following test used to be here for the original Ada 95
-      --  semantics, but these were modified by AI-241 to require returning
-      --  Null_Id instead of raising Constraint_Error.
+      --  Note that the following test used to be here for the original
+      --  Ada 95 semantics, but these were modified by AI-241 to require
+      --  returning Null_Id instead of raising Constraint_Error.
 
       --  if X.Id = Null_Id then
       --     raise Constraint_Error;
@@ -784,9 +761,9 @@
    begin
       if X.Id = Null_Id then
          raise Constraint_Error;
+      else
+         return X.Msg (1 .. X.Msg_Length);
       end if;
-
-      return X.Msg (1 .. X.Msg_Length);
    end Exception_Message;
 
    --------------------
@@ -797,9 +774,9 @@
    begin
       if Id = null then
          raise Constraint_Error;
+      else
+         return To_Ptr (Id.Full_Name) (1 .. Id.Name_Length - 1);
       end if;
-
-      return To_Ptr (Id.Full_Name) (1 .. Id.Name_Length - 1);
    end Exception_Name;
 
    function Exception_Name (X : Exception_Occurrence) return String is
@@ -839,16 +816,50 @@
    --  This package can be easily dummied out if we do not want the basic
    --  support for exception messages (such as in Ada 83).
 
+   ---------------------------
+   -- Exception_Propagation --
+   ---------------------------
+
+   package body Exception_Propagation is separate;
+   --  Depending on the actual exception mechanism used (front-end or
+   --  back-end based), the implementation will differ, which is why this
+   --  package is separated.
+
    ----------------------
    -- Exception_Traces --
    ----------------------
 
    package body Exception_Traces is separate;
    --  Depending on the underlying support for IO the implementation will
-   --  differ. Moreover we would like to dummy out this package in case we do
-   --  not want any exception tracing support. This is why this package is
-   --  separated.
+   --  differ. Moreover we would like to dummy out this package in case we
+   --  do not want any exception tracing support. This is why this package
+   --  is separated.
 
+   --------------------------------------
+   -- Get_Exception_Machine_Occurrence --
+   --------------------------------------
+
+   function Get_Exception_Machine_Occurrence
+     (X : Exception_Occurrence) return System.Address
+   is
+   begin
+      return X.Machine_Occurrence;
+   end Get_Exception_Machine_Occurrence;
+
+   -----------
+   -- Image --
+   -----------
+
+   function Image (Index : Integer) return String is
+      Result : constant String := Integer'Image (Index);
+   begin
+      if Result (1) = ' ' then
+         return Result (2 .. Result'Last);
+      else
+         return Result;
+      end if;
+   end Image;
+
    -----------------------
    -- Stream Attributes --
    -----------------------
@@ -857,59 +868,13 @@
    --  This package can be easily dummied out if we do not want the
    --  support for streaming Exception_Ids and Exception_Occurrences.
 
-   -----------------------------
-   -- Process_Raise_Exception --
-   -----------------------------
-
-   procedure Process_Raise_Exception (E : Exception_Id) is
-      pragma Inspection_Point (E);
-      --  This is so the debugger can reliably inspect the parameter
-
-      Jumpbuf_Ptr : constant Address := Get_Jmpbuf_Address.all;
-      Excep       : constant EOA := Get_Current_Excep.all;
-
-      procedure builtin_longjmp (buffer : Address; Flag : Integer);
-      pragma No_Return (builtin_longjmp);
-      pragma Import (C, builtin_longjmp, "_gnat_builtin_longjmp");
-
-   begin
-      --  WARNING: There should be no exception handler for this body because
-      --  this would cause gigi to prepend a setup for a new jmpbuf to the
-      --  sequence of statements in case of built-in sjljl. We would then
-      --  always get this new buf in Jumpbuf_Ptr instead of the one for the
-      --  exception we are handling, which would completely break the whole
-      --  design of this procedure.
-
-      --  If the jump buffer pointer is non-null, transfer control using it.
-      --  Otherwise announce an unhandled exception (note that this means that
-      --  we have no finalizations to do other than at the outer level).
-      --  Perform the necessary notification tasks in both cases.
-
-      if Jumpbuf_Ptr /= Null_Address then
-         if not Excep.Exception_Raised then
-            Excep.Exception_Raised := True;
-            Exception_Traces.Notify_Handled_Exception (Excep);
-         end if;
-
-         builtin_longjmp (Jumpbuf_Ptr, 1);
-
-      else
-         Exception_Traces.Notify_Unhandled_Exception (Excep);
-         Exception_Traces.Unhandled_Exception_Terminate (Excep);
-      end if;
-   end Process_Raise_Exception;
-
    ----------------------------
    -- Raise_Constraint_Error --
    ----------------------------
 
-   procedure Raise_Constraint_Error
-     (File : System.Address;
-      Line : Integer)
-   is
+   procedure Raise_Constraint_Error (File : System.Address; Line : Integer) is
    begin
-      Raise_With_Location_And_Msg
-        (Constraint_Error_Def'Access, File, Line);
+      Raise_With_Location_And_Msg (Constraint_Error_Def'Access, File, Line);
    end Raise_Constraint_Error;
 
    --------------------------------
@@ -917,41 +882,60 @@
    --------------------------------
 
    procedure Raise_Constraint_Error_Msg
-     (File : System.Address;
-      Line : Integer;
-      Msg  : System.Address)
+     (File   : System.Address;
+      Line   : Integer;
+      Column : Integer;
+      Msg    : System.Address)
    is
    begin
       Raise_With_Location_And_Msg
-        (Constraint_Error_Def'Access, File, Line, Msg);
+        (Constraint_Error_Def'Access, File, Line, Column, Msg);
    end Raise_Constraint_Error_Msg;
 
    -------------------------
-   -- Raise_Current_Excep --
+   -- Complete_Occurrence --
    -------------------------
 
-   procedure Raise_Current_Excep (E : Exception_Id) is
+   procedure Complete_Occurrence (X : EOA) is
+   begin
+      --  Compute the backtrace for this occurrence if the corresponding
+      --  binder option has been set. Call_Chain takes care of the reraise
+      --  case.
 
-      pragma Inspection_Point (E);
-      --  This is so the debugger can reliably inspect the parameter when
-      --  inserting a breakpoint at the start of this procedure.
+      --  ??? Using Call_Chain here means we are going to walk up the stack
+      --  once only for backtracing purposes before doing it again for the
+      --  propagation per se.
 
-      Id : Exception_Id := E;
-      pragma Volatile (Id);
-      pragma Warnings (Off, Id);
-      --  In order to provide support for breakpoints on unhandled exceptions,
-      --  the debugger will also need to be able to inspect the value of E from
-      --  another (inner) frame. So we need to make sure that if E is passed in
-      --  a register, its value is also spilled on stack. For this, we store
-      --  the parameter value in a local variable, and add a pragma Volatile to
-      --  make sure it is spilled. The pragma Warnings (Off) is needed because
-      --  the compiler knows that Id is not referenced and that this use of
-      --  pragma Volatile is peculiar.
+      --  The first inspection is much lighter, though, as it only requires
+      --  partial unwinding of each frame. Additionally, although we could use
+      --  the personality routine to record the addresses while propagating,
+      --  this method has two drawbacks:
 
+      --  1) the trace is incomplete if the exception is handled since we
+      --  don't walk past the frame with the handler,
+
+      --    and
+
+      --  2) we would miss the frames for which our personality routine is not
+      --  called, e.g. if C or C++ calls are on the way.
+
+      Call_Chain (X);
+
+      --  Notify the debugger
+      Debug_Raise_Exception
+        (E       => SSL.Exception_Data_Ptr (X.Id),
+         Message => X.Msg (1 .. X.Msg_Length));
+   end Complete_Occurrence;
+
+   ---------------------------------------
+   -- Complete_And_Propagate_Occurrence --
+   ---------------------------------------
+
+   procedure Complete_And_Propagate_Occurrence (X : EOA) is
    begin
-      Debug_Raise_Exception (E => SSL.Exception_Data_Ptr (E), Message => "");
-      Process_Raise_Exception (E);
-   end Raise_Current_Excep;
+      Complete_Occurrence (X);
+      Exception_Propagation.Propagate_Exception (X);
+   end Complete_And_Propagate_Occurrence;
 
    ---------------------
    -- Raise_Exception --
@@ -961,8 +945,7 @@
      (E       : Exception_Id;
       Message : String := "")
    is
-      EF    : Exception_Id := E;
-      Excep : constant EOA := Get_Current_Excep.all;
+      EF : Exception_Id := E;
    begin
       --  Raise CE if E = Null_ID (AI-446)
 
@@ -972,9 +955,7 @@
 
       --  Go ahead and raise appropriate exception
 
-      Exception_Data.Set_Exception_Msg (Excep, EF, Message);
-      Abort_Defer.all;
-      Raise_Current_Excep (EF);
+      Raise_Exception_Always (EF, Message);
    end Raise_Exception;
 
    ----------------------------
@@ -985,11 +966,16 @@
      (E       : Exception_Id;
       Message : String := "")
    is
-      Excep : constant EOA := Get_Current_Excep.all;
+      X : constant EOA := Exception_Propagation.Allocate_Occurrence;
+
    begin
-      Exception_Data.Set_Exception_Msg (Excep, E, Message);
-      Abort_Defer.all;
-      Raise_Current_Excep (E);
+      Exception_Data.Set_Exception_Msg (X, E, Message);
+
+      if not ZCX_By_Default then
+         Abort_Defer.all;
+      end if;
+
+      Complete_And_Propagate_Occurrence (X);
    end Raise_Exception_Always;
 
    ------------------------------
@@ -1000,13 +986,14 @@
      (E       : Exception_Id;
       Message : String := "")
    is
-      Excep : constant EOA := Get_Current_Excep.all;
+      X : constant EOA := Exception_Propagation.Allocate_Occurrence;
+
    begin
-      Exception_Data.Set_Exception_Msg (Excep, E, Message);
+      Exception_Data.Set_Exception_Msg (X, E, Message);
 
       --  Do not call Abort_Defer.all, as specified by the spec
 
-      Raise_Current_Excep (E);
+      Complete_And_Propagate_Occurrence (X);
    end Raise_Exception_No_Defer;
 
    -------------------------------------
@@ -1019,11 +1006,13 @@
       Prefix             : constant String := "adjust/finalize raised ";
       Orig_Msg           : constant String := Exception_Message (X);
       Orig_Prefix_Length : constant Natural :=
-        Integer'Min (Prefix'Length, Orig_Msg'Length);
-      Orig_Prefix        : String renames Orig_Msg
-        (Orig_Msg'First ..  Orig_Msg'First + Orig_Prefix_Length - 1);
+                             Integer'Min (Prefix'Length, Orig_Msg'Length);
+
+      Orig_Prefix : String renames
+        Orig_Msg (Orig_Msg'First .. Orig_Msg'First + Orig_Prefix_Length - 1);
+
    begin
-      --  Message already has proper prefix, just re-reraise
+      --  Message already has the proper prefix, just re-raise
 
       if Orig_Prefix = Prefix then
          Raise_Exception_No_Defer
@@ -1053,6 +1042,39 @@
       end if;
    end Raise_From_Controlled_Operation;
 
+   -------------------------------------------
+   -- Create_Occurrence_From_Signal_Handler --
+   -------------------------------------------
+
+   function Create_Occurrence_From_Signal_Handler
+     (E : Exception_Id;
+      M : System.Address) return EOA
+   is
+      X : constant EOA := Exception_Propagation.Allocate_Occurrence;
+
+   begin
+      Exception_Data.Set_Exception_C_Msg (X, E, M);
+
+      if not ZCX_By_Default then
+         Abort_Defer.all;
+      end if;
+
+      Complete_Occurrence (X);
+      return X;
+   end Create_Occurrence_From_Signal_Handler;
+
+   ---------------------------------------------------
+   -- Create_Machine_Occurrence_From_Signal_Handler --
+   ---------------------------------------------------
+
+   function Create_Machine_Occurrence_From_Signal_Handler
+     (E : Exception_Id;
+      M : System.Address) return System.Address
+   is
+   begin
+      return Create_Occurrence_From_Signal_Handler (E, M).Machine_Occurrence;
+   end Create_Machine_Occurrence_From_Signal_Handler;
+
    -------------------------------
    -- Raise_From_Signal_Handler --
    -------------------------------
@@ -1061,11 +1083,9 @@
      (E : Exception_Id;
       M : System.Address)
    is
-      Excep : constant EOA := Get_Current_Excep.all;
    begin
-      Exception_Data.Set_Exception_C_Msg (Excep, E, M);
-      Abort_Defer.all;
-      Process_Raise_Exception (E);
+      Exception_Propagation.Propagate_Exception
+        (Create_Occurrence_From_Signal_Handler (E, M));
    end Raise_From_Signal_Handler;
 
    -------------------------
@@ -1077,8 +1097,7 @@
       Line : Integer)
    is
    begin
-      Raise_With_Location_And_Msg
-        (Program_Error_Def'Access, File, Line);
+      Raise_With_Location_And_Msg (Program_Error_Def'Access, File, Line);
    end Raise_Program_Error;
 
    -----------------------------
@@ -1092,7 +1111,7 @@
    is
    begin
       Raise_With_Location_And_Msg
-        (Program_Error_Def'Access, File, Line, Msg);
+        (Program_Error_Def'Access, File, Line, M => Msg);
    end Raise_Program_Error_Msg;
 
    -------------------------
@@ -1104,8 +1123,7 @@
       Line : Integer)
    is
    begin
-      Raise_With_Location_And_Msg
-        (Storage_Error_Def'Access, File, Line);
+      Raise_With_Location_And_Msg (Storage_Error_Def'Access, File, Line);
    end Raise_Storage_Error;
 
    -----------------------------
@@ -1119,7 +1137,7 @@
    is
    begin
       Raise_With_Location_And_Msg
-        (Storage_Error_Def'Access, File, Line, Msg);
+        (Storage_Error_Def'Access, File, Line, M => Msg);
    end Raise_Storage_Error_Msg;
 
    ---------------------------------
@@ -1130,13 +1148,18 @@
      (E : Exception_Id;
       F : System.Address;
       L : Integer;
+      C : Integer := 0;
       M : System.Address := System.Null_Address)
    is
-      Excep : constant EOA := Get_Current_Excep.all;
+      X : constant EOA := Exception_Propagation.Allocate_Occurrence;
    begin
-      Exception_Data.Set_Exception_C_Msg (Excep, E, F, L, Msg2 => M);
-      Abort_Defer.all;
-      Raise_Current_Excep (E);
+      Exception_Data.Set_Exception_C_Msg (X, E, F, L, C, M);
+
+      if not ZCX_By_Default then
+         Abort_Defer.all;
+      end if;
+
+      Complete_And_Propagate_Occurrence (X);
    end Raise_With_Location_And_Msg;
 
    --------------------
@@ -1144,15 +1167,28 @@
    --------------------
 
    procedure Raise_With_Msg (E : Exception_Id) is
-      Excep : constant EOA := Get_Current_Excep.all;
-
+      Excep : constant EOA := Exception_Propagation.Allocate_Occurrence;
+      Ex    : constant Exception_Occurrence_Access := Get_Current_Excep.all;
    begin
       Excep.Exception_Raised := False;
       Excep.Id               := E;
       Excep.Num_Tracebacks   := 0;
       Excep.Pid              := Local_Partition_ID;
-      Abort_Defer.all;
-      Raise_Current_Excep (E);
+
+      --  Copy the message from the current exception
+      --  Change the interface to be called with an occurrence ???
+
+      Excep.Msg_Length                  := Ex.Msg_Length;
+      Excep.Msg (1 .. Excep.Msg_Length) := Ex.Msg (1 .. Ex.Msg_Length);
+
+      --  The following is a common pattern, should be abstracted
+      --  into a procedure call ???
+
+      if not ZCX_By_Default then
+         Abort_Defer.all;
+      end if;
+
+      Complete_And_Propagate_Occurrence (Excep);
    end Raise_With_Msg;
 
    -----------------------------------------
@@ -1163,98 +1199,98 @@
      (File : System.Address; Line : Integer)
    is
    begin
-      Raise_Constraint_Error_Msg (File, Line, Rmsg_00'Address);
+      Raise_Constraint_Error_Msg (File, Line, 0, Rmsg_00'Address);
    end Rcheck_CE_Access_Check;
 
    procedure Rcheck_CE_Null_Access_Parameter
      (File : System.Address; Line : Integer)
    is
    begin
-      Raise_Constraint_Error_Msg (File, Line, Rmsg_01'Address);
+      Raise_Constraint_Error_Msg (File, Line, 0, Rmsg_01'Address);
    end Rcheck_CE_Null_Access_Parameter;
 
    procedure Rcheck_CE_Discriminant_Check
      (File : System.Address; Line : Integer)
    is
    begin
-      Raise_Constraint_Error_Msg (File, Line, Rmsg_02'Address);
+      Raise_Constraint_Error_Msg (File, Line, 0, Rmsg_02'Address);
    end Rcheck_CE_Discriminant_Check;
 
    procedure Rcheck_CE_Divide_By_Zero
      (File : System.Address; Line : Integer)
    is
    begin
-      Raise_Constraint_Error_Msg (File, Line, Rmsg_03'Address);
+      Raise_Constraint_Error_Msg (File, Line, 0, Rmsg_03'Address);
    end Rcheck_CE_Divide_By_Zero;
 
    procedure Rcheck_CE_Explicit_Raise
      (File : System.Address; Line : Integer)
    is
    begin
-      Raise_Constraint_Error_Msg (File, Line, Rmsg_04'Address);
+      Raise_Constraint_Error_Msg (File, Line, 0, Rmsg_04'Address);
    end Rcheck_CE_Explicit_Raise;
 
    procedure Rcheck_CE_Index_Check
      (File : System.Address; Line : Integer)
    is
    begin
-      Raise_Constraint_Error_Msg (File, Line, Rmsg_05'Address);
+      Raise_Constraint_Error_Msg (File, Line, 0, Rmsg_05'Address);
    end Rcheck_CE_Index_Check;
 
    procedure Rcheck_CE_Invalid_Data
      (File : System.Address; Line : Integer)
    is
    begin
-      Raise_Constraint_Error_Msg (File, Line, Rmsg_06'Address);
+      Raise_Constraint_Error_Msg (File, Line, 0, Rmsg_06'Address);
    end Rcheck_CE_Invalid_Data;
 
    procedure Rcheck_CE_Length_Check
      (File : System.Address; Line : Integer)
    is
    begin
-      Raise_Constraint_Error_Msg (File, Line, Rmsg_07'Address);
+      Raise_Constraint_Error_Msg (File, Line, 0, Rmsg_07'Address);
    end Rcheck_CE_Length_Check;
 
    procedure Rcheck_CE_Null_Exception_Id
      (File : System.Address; Line : Integer)
    is
    begin
-      Raise_Constraint_Error_Msg (File, Line, Rmsg_08'Address);
+      Raise_Constraint_Error_Msg (File, Line, 0, Rmsg_08'Address);
    end Rcheck_CE_Null_Exception_Id;
 
    procedure Rcheck_CE_Null_Not_Allowed
      (File : System.Address; Line : Integer)
    is
    begin
-      Raise_Constraint_Error_Msg (File, Line, Rmsg_09'Address);
+      Raise_Constraint_Error_Msg (File, Line, 0, Rmsg_09'Address);
    end Rcheck_CE_Null_Not_Allowed;
 
    procedure Rcheck_CE_Overflow_Check
      (File : System.Address; Line : Integer)
    is
    begin
-      Raise_Constraint_Error_Msg (File, Line, Rmsg_10'Address);
+      Raise_Constraint_Error_Msg (File, Line, 0, Rmsg_10'Address);
    end Rcheck_CE_Overflow_Check;
 
    procedure Rcheck_CE_Partition_Check
      (File : System.Address; Line : Integer)
    is
    begin
-      Raise_Constraint_Error_Msg (File, Line, Rmsg_11'Address);
+      Raise_Constraint_Error_Msg (File, Line, 0, Rmsg_11'Address);
    end Rcheck_CE_Partition_Check;
 
    procedure Rcheck_CE_Range_Check
      (File : System.Address; Line : Integer)
    is
    begin
-      Raise_Constraint_Error_Msg (File, Line, Rmsg_12'Address);
+      Raise_Constraint_Error_Msg (File, Line, 0, Rmsg_12'Address);
    end Rcheck_CE_Range_Check;
 
    procedure Rcheck_CE_Tag_Check
      (File : System.Address; Line : Integer)
    is
    begin
-      Raise_Constraint_Error_Msg (File, Line, Rmsg_13'Address);
+      Raise_Constraint_Error_Msg (File, Line, 0, Rmsg_13'Address);
    end Rcheck_CE_Tag_Check;
 
    procedure Rcheck_PE_Access_Before_Elaboration
@@ -1341,6 +1377,13 @@
       Raise_Program_Error_Msg (File, Line, Rmsg_26'Address);
    end Rcheck_PE_Missing_Return;
 
+   procedure Rcheck_PE_Non_Transportable_Actual
+     (File : System.Address; Line : Integer)
+   is
+   begin
+      Raise_Program_Error_Msg (File, Line, Rmsg_31'Address);
+   end Rcheck_PE_Non_Transportable_Actual;
+
    procedure Rcheck_PE_Overlaid_Controlled_Object
      (File : System.Address; Line : Integer)
    is
@@ -1355,6 +1398,13 @@
       Raise_Program_Error_Msg (File, Line, Rmsg_28'Address);
    end Rcheck_PE_Potentially_Blocking_Operation;
 
+   procedure Rcheck_PE_Stream_Operation_Not_Allowed
+     (File : System.Address; Line : Integer)
+   is
+   begin
+      Raise_Program_Error_Msg (File, Line, Rmsg_36'Address);
+   end Rcheck_PE_Stream_Operation_Not_Allowed;
+
    procedure Rcheck_PE_Stubbed_Subprogram_Called
      (File : System.Address; Line : Integer)
    is
@@ -1369,13 +1419,6 @@
       Raise_Program_Error_Msg (File, Line, Rmsg_30'Address);
    end Rcheck_PE_Unchecked_Union_Restriction;
 
-   procedure Rcheck_PE_Non_Transportable_Actual
-     (File : System.Address; Line : Integer)
-   is
-   begin
-      Raise_Program_Error_Msg (File, Line, Rmsg_31'Address);
-   end Rcheck_PE_Non_Transportable_Actual;
-
    procedure Rcheck_SE_Empty_Storage_Pool
      (File : System.Address; Line : Integer)
    is
@@ -1404,116 +1447,79 @@
       Raise_Storage_Error_Msg (File, Line, Rmsg_35'Address);
    end Rcheck_SE_Object_Too_Large;
 
-   procedure Rcheck_PE_Stream_Operation_Not_Allowed
-     (File : System.Address; Line : Integer)
+   procedure Rcheck_CE_Access_Check_Ext
+     (File : System.Address; Line, Column : Integer)
    is
    begin
-      Raise_Program_Error_Msg (File, Line, Rmsg_36'Address);
-   end Rcheck_PE_Stream_Operation_Not_Allowed;
+      Raise_Constraint_Error_Msg (File, Line, Column, Rmsg_00'Address);
+   end Rcheck_CE_Access_Check_Ext;
 
+   procedure Rcheck_CE_Index_Check_Ext
+     (File : System.Address; Line, Column, Index, First, Last : Integer)
+   is
+      Msg : constant String :=
+              Rmsg_05 (Rmsg_05'First .. Rmsg_05'Last - 1) & ASCII.LF
+              & "index " & Image (Index) & " not in " & Image (First)
+              & ".." & Image (Last) & ASCII.NUL;
+   begin
+      Raise_Constraint_Error_Msg (File, Line, Column, Msg'Address);
+   end Rcheck_CE_Index_Check_Ext;
+
+   procedure Rcheck_CE_Invalid_Data_Ext
+     (File : System.Address; Line, Column, Index, First, Last : Integer)
+   is
+      Msg : constant String :=
+              Rmsg_06 (Rmsg_06'First .. Rmsg_06'Last - 1) & ASCII.LF
+              & "value " & Image (Index) & " not in " & Image (First)
+              & ".." & Image (Last) & ASCII.NUL;
+   begin
+      Raise_Constraint_Error_Msg (File, Line, Column, Msg'Address);
+   end Rcheck_CE_Invalid_Data_Ext;
+
+   procedure Rcheck_CE_Range_Check_Ext
+     (File : System.Address; Line, Column, Index, First, Last : Integer)
+   is
+      Msg : constant String :=
+              Rmsg_12 (Rmsg_12'First .. Rmsg_12'Last - 1) & ASCII.LF
+              & "value " & Image (Index) & " not in " & Image (First)
+              & ".." & Image (Last) & ASCII.NUL;
+   begin
+      Raise_Constraint_Error_Msg (File, Line, Column, Msg'Address);
+   end Rcheck_CE_Range_Check_Ext;
+
    procedure Rcheck_PE_Finalize_Raised_Exception
      (File : System.Address; Line : Integer)
    is
-      E     : constant Exception_Id := Program_Error_Def'Access;
-      Excep : constant EOA := Get_Current_Excep.all;
+      X : constant EOA := Exception_Propagation.Allocate_Occurrence;
 
    begin
       --  This is "finalize/adjust raised exception". This subprogram is always
-      --  called with abort deferred, unlike all other Rcheck_* subprograms,
-      --  itneeds to call Raise_Exception_No_Defer.
+      --  called with abort deferred, unlike all other Rcheck_* subprograms, it
+      --  needs to call Raise_Exception_No_Defer.
 
       --  This is consistent with Raise_From_Controlled_Operation
 
-      Exception_Data.Set_Exception_C_Msg (Excep, E, File, Line, 0,
-                                          Rmsg_23'Address);
-      Raise_Current_Excep (E);
+      Exception_Data.Set_Exception_C_Msg
+        (X, Program_Error_Def'Access, File, Line, 0, Rmsg_23'Address);
+      Complete_And_Propagate_Occurrence (X);
    end Rcheck_PE_Finalize_Raised_Exception;
 
-   procedure Rcheck_00 (File : System.Address; Line : Integer)
-     renames Rcheck_CE_Access_Check;
-   procedure Rcheck_01 (File : System.Address; Line : Integer)
-     renames Rcheck_CE_Null_Access_Parameter;
-   procedure Rcheck_02 (File : System.Address; Line : Integer)
-     renames Rcheck_CE_Discriminant_Check;
-   procedure Rcheck_03 (File : System.Address; Line : Integer)
-     renames Rcheck_CE_Divide_By_Zero;
-   procedure Rcheck_04 (File : System.Address; Line : Integer)
-     renames Rcheck_CE_Explicit_Raise;
-   procedure Rcheck_05 (File : System.Address; Line : Integer)
-     renames Rcheck_CE_Index_Check;
-   procedure Rcheck_06 (File : System.Address; Line : Integer)
-     renames Rcheck_CE_Invalid_Data;
-   procedure Rcheck_07 (File : System.Address; Line : Integer)
-     renames Rcheck_CE_Length_Check;
-   procedure Rcheck_08 (File : System.Address; Line : Integer)
-     renames Rcheck_CE_Null_Exception_Id;
-   procedure Rcheck_09 (File : System.Address; Line : Integer)
-     renames Rcheck_CE_Null_Not_Allowed;
-   procedure Rcheck_10 (File : System.Address; Line : Integer)
-     renames Rcheck_CE_Overflow_Check;
-   procedure Rcheck_11 (File : System.Address; Line : Integer)
-     renames Rcheck_CE_Partition_Check;
-   procedure Rcheck_12 (File : System.Address; Line : Integer)
-     renames Rcheck_CE_Range_Check;
-   procedure Rcheck_13 (File : System.Address; Line : Integer)
-     renames Rcheck_CE_Tag_Check;
-   procedure Rcheck_14 (File : System.Address; Line : Integer)
-     renames Rcheck_PE_Access_Before_Elaboration;
-   procedure Rcheck_15 (File : System.Address; Line : Integer)
-     renames Rcheck_PE_Accessibility_Check;
-   procedure Rcheck_16 (File : System.Address; Line : Integer)
-     renames Rcheck_PE_Address_Of_Intrinsic;
-   procedure Rcheck_17 (File : System.Address; Line : Integer)
-     renames Rcheck_PE_Aliased_Parameters;
-   procedure Rcheck_18 (File : System.Address; Line : Integer)
-     renames Rcheck_PE_All_Guards_Closed;
-   procedure Rcheck_19 (File : System.Address; Line : Integer)
-     renames Rcheck_PE_Bad_Predicated_Generic_Type;
-   procedure Rcheck_20 (File : System.Address; Line : Integer)
-     renames Rcheck_PE_Current_Task_In_Entry_Body;
-   procedure Rcheck_21 (File : System.Address; Line : Integer)
-     renames Rcheck_PE_Duplicated_Entry_Address;
-   procedure Rcheck_22 (File : System.Address; Line : Integer)
-     renames Rcheck_PE_Explicit_Raise;
-   procedure Rcheck_23 (File : System.Address; Line : Integer)
-     renames Rcheck_PE_Finalize_Raised_Exception;
-   procedure Rcheck_24 (File : System.Address; Line : Integer)
-     renames Rcheck_PE_Implicit_Return;
-   procedure Rcheck_25 (File : System.Address; Line : Integer)
-     renames Rcheck_PE_Misaligned_Address_Value;
-   procedure Rcheck_26 (File : System.Address; Line : Integer)
-     renames Rcheck_PE_Missing_Return;
-   procedure Rcheck_27 (File : System.Address; Line : Integer)
-     renames Rcheck_PE_Overlaid_Controlled_Object;
-   procedure Rcheck_28 (File : System.Address; Line : Integer)
-     renames Rcheck_PE_Potentially_Blocking_Operation;
-   procedure Rcheck_29 (File : System.Address; Line : Integer)
-     renames Rcheck_PE_Stubbed_Subprogram_Called;
-   procedure Rcheck_30 (File : System.Address; Line : Integer)
-     renames Rcheck_PE_Unchecked_Union_Restriction;
-   procedure Rcheck_31 (File : System.Address; Line : Integer)
-     renames Rcheck_PE_Non_Transportable_Actual;
-   procedure Rcheck_32 (File : System.Address; Line : Integer)
-     renames Rcheck_SE_Empty_Storage_Pool;
-   procedure Rcheck_33 (File : System.Address; Line : Integer)
-     renames Rcheck_SE_Explicit_Raise;
-   procedure Rcheck_34 (File : System.Address; Line : Integer)
-     renames Rcheck_SE_Infinite_Recursion;
-   procedure Rcheck_35 (File : System.Address; Line : Integer)
-     renames Rcheck_SE_Object_Too_Large;
-   procedure Rcheck_36 (File : System.Address; Line : Integer)
-     renames Rcheck_PE_Stream_Operation_Not_Allowed;
-
    -------------
    -- Reraise --
    -------------
 
    procedure Reraise is
-      Excep : constant EOA := Get_Current_Excep.all;
+      Excep    : constant EOA := Exception_Propagation.Allocate_Occurrence;
+      Saved_MO : constant System.Address := Excep.Machine_Occurrence;
 
    begin
-      Abort_Defer.all;
-      Raise_Current_Excep (Excep.Id);
+      if not ZCX_By_Default then
+         Abort_Defer.all;
+      end if;
+
+      Save_Occurrence (Excep.all, Get_Current_Excep.all.all);
+      Excep.Machine_Occurrence := Saved_MO;
+      Complete_And_Propagate_Occurrence (Excep);
    end Reraise;
 
    --------------------------------------
@@ -1522,10 +1528,18 @@
 
    procedure Reraise_Library_Exception_If_Any is
       LE : Exception_Occurrence;
+
    begin
       if Library_Exception_Set then
          LE := Library_Exception;
-         Raise_From_Controlled_Operation (LE);
+
+         if LE.Id = Null_Id then
+            Raise_Exception_No_Defer
+              (E       => Program_Error'Identity,
+               Message => "finalize/adjust raised exception");
+         else
+            Raise_From_Controlled_Operation (LE);
+         end if;
       end if;
    end Reraise_Library_Exception_If_Any;
 
@@ -1535,10 +1549,10 @@
 
    procedure Reraise_Occurrence (X : Exception_Occurrence) is
    begin
-      if X.Id /= null then
-         Abort_Defer.all;
-         Save_Occurrence (Get_Current_Excep.all.all, X);
-         Raise_Current_Excep (X.Id);
+      if X.Id = null then
+         return;
+      else
+         Reraise_Occurrence_Always (X);
       end if;
    end Reraise_Occurrence;
 
@@ -1548,9 +1562,11 @@
 
    procedure Reraise_Occurrence_Always (X : Exception_Occurrence) is
    begin
-      Abort_Defer.all;
-      Save_Occurrence (Get_Current_Excep.all.all, X);
-      Raise_Current_Excep (X.Id);
+      if not ZCX_By_Default then
+         Abort_Defer.all;
+      end if;
+
+      Reraise_Occurrence_No_Defer (X);
    end Reraise_Occurrence_Always;
 
    ---------------------------------
@@ -1558,9 +1574,12 @@
    ---------------------------------
 
    procedure Reraise_Occurrence_No_Defer (X : Exception_Occurrence) is
+      Excep    : constant EOA := Exception_Propagation.Allocate_Occurrence;
+      Saved_MO : constant System.Address := Excep.Machine_Occurrence;
    begin
-      Save_Occurrence (Get_Current_Excep.all.all, X);
-      Raise_Current_Excep (X.Id);
+      Save_Occurrence (Excep.all, X);
+      Excep.Machine_Occurrence := Saved_MO;
+      Complete_And_Propagate_Occurrence (Excep);
    end Reraise_Occurrence_No_Defer;
 
    ---------------------
@@ -1572,11 +1591,15 @@
       Source : Exception_Occurrence)
    is
    begin
-      Target.Id             := Source.Id;
-      Target.Msg_Length     := Source.Msg_Length;
-      Target.Num_Tracebacks := Source.Num_Tracebacks;
-      Target.Pid            := Source.Pid;
+      --  As the machine occurrence might be a data that must be finalized
+      --  (outside any Ada mechanism), do not copy it
 
+      Target.Id                 := Source.Id;
+      Target.Machine_Occurrence := System.Null_Address;
+      Target.Msg_Length         := Source.Msg_Length;
+      Target.Num_Tracebacks     := Source.Num_Tracebacks;
+      Target.Pid                := Source.Pid;
+
       Target.Msg (1 .. Target.Msg_Length) :=
         Source.Msg (1 .. Target.Msg_Length);
 
@@ -1610,13 +1633,10 @@
    ---------------
 
    procedure To_Stderr (C : Character) is
-      type int is new Integer;
-
-      procedure put_char_stderr (C : int);
-      pragma Import (C, put_char_stderr, "put_char_stderr");
-
+      procedure Put_Char_Stderr (C : Character);
+      pragma Import (C, Put_Char_Stderr, "put_char_stderr");
    begin
-      put_char_stderr (Character'Pos (C));
+      Put_Char_Stderr (C);
    end To_Stderr;
 
    procedure To_Stderr (S : String) is
@@ -1651,4 +1671,78 @@
         and then Exception_Identity (Ex.all) = Standard'Abort_Signal'Identity;
    end Triggered_By_Abort;
 
+   -------------------------
+   -- Wide_Exception_Name --
+   -------------------------
+
+   WC_Encoding : Character;
+   pragma Import (C, WC_Encoding, "__gl_wc_encoding");
+   --  Encoding method for source, as exported by binder
+
+   function Wide_Exception_Name
+     (Id : Exception_Id) return Wide_String
+   is
+      S : constant String := Exception_Name (Id);
+      W : Wide_String (1 .. S'Length);
+      L : Natural;
+   begin
+      String_To_Wide_String
+        (S, W, L, Get_WC_Encoding_Method (WC_Encoding));
+      return W (1 .. L);
+   end Wide_Exception_Name;
+
+   function Wide_Exception_Name
+     (X : Exception_Occurrence) return Wide_String
+   is
+      S : constant String := Exception_Name (X);
+      W : Wide_String (1 .. S'Length);
+      L : Natural;
+   begin
+      String_To_Wide_String
+        (S, W, L, Get_WC_Encoding_Method (WC_Encoding));
+      return W (1 .. L);
+   end Wide_Exception_Name;
+
+   ----------------------------
+   -- Wide_Wide_Exception_Name --
+   -----------------------------
+
+   function Wide_Wide_Exception_Name
+     (Id : Exception_Id) return Wide_Wide_String
+   is
+      S : constant String := Exception_Name (Id);
+      W : Wide_Wide_String (1 .. S'Length);
+      L : Natural;
+   begin
+      String_To_Wide_Wide_String
+        (S, W, L, Get_WC_Encoding_Method (WC_Encoding));
+      return W (1 .. L);
+   end Wide_Wide_Exception_Name;
+
+   function Wide_Wide_Exception_Name
+     (X : Exception_Occurrence) return Wide_Wide_String
+   is
+      S : constant String := Exception_Name (X);
+      W : Wide_Wide_String (1 .. S'Length);
+      L : Natural;
+   begin
+      String_To_Wide_Wide_String
+        (S, W, L, Get_WC_Encoding_Method (WC_Encoding));
+      return W (1 .. L);
+   end Wide_Wide_Exception_Name;
+
+   --------------------------
+   -- Code_Address_For_ZZZ --
+   --------------------------
+
+   --  This function gives us the end of the PC range for addresses
+   --  within the exception unit itself. We hope that gigi/gcc keeps all the
+   --  procedures in their original order.
+
+   function Code_Address_For_ZZZ return System.Address is
+   begin
+      <<Start_Of_ZZZ>>
+      return Start_Of_ZZZ'Address;
+   end Code_Address_For_ZZZ;
+
 end Ada.Exceptions;
Index: a-except.ads
===================================================================
--- a-except.ads	(revision 247293)
+++ a-except.ads	(working copy)
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 S p e c                                  --
 --                                                                          --
---          Copyright (C) 1992-2015, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2017, Free Software Foundation, Inc.         --
 --                                                                          --
 -- This specification is derived from the Ada Reference Manual for use with --
 -- GNAT. The copyright notice above, and the license provisions that follow --
@@ -33,24 +33,15 @@
 --                                                                          --
 ------------------------------------------------------------------------------
 
---  This version of Ada.Exceptions is used only for building the compiler
---  and certain basic tools. The "real" version of Ada.Exceptions is in
---  a-except-2005.ads/adb, and is used for all other builds where full Ada
---  functionality is required. In particular, it is used for building run
---  times on all targets.
+--  This version of Ada.Exceptions fully supports Ada 95 and later language
+--  versions.  It is used in all situations except for the build of the
+--  compiler and other basic tools. For these latter builds, we use an
+--  Ada 95-only version.
 
---  This version is limited to Ada 95 features. It omits Ada 2005 features
---  such as the additional definitions of Exception_Name returning
---  Wide_[Wide_]String. It differs from the version specified in the Ada 95 RM
---  only in that it is declared Preelaborate (see declaration below for why
---  this is done).
-
 --  The reason for this splitting off of a separate version is to support
 --  older bootstrap compilers that do not support Ada 2005 features, and
 --  Ada.Exceptions is part of the compiler sources.
 
-pragma Compiler_Unit_Warning;
-
 pragma Polling (Off);
 --  We must turn polling off for this unit, because otherwise we get
 --  elaboration circularities with ourself.
@@ -62,26 +53,40 @@
 
 package Ada.Exceptions is
    pragma Preelaborate;
-   --  We make this preelaborable. If we did not do this, then run time units
-   --  used by the compiler (e.g. s-soflin.ads) would run into trouble.
-   --  Conformance with Ada 95 is not an issue, since this version is used
-   --  only by the compiler.
+   --  In accordance with Ada 2005 AI-362.
 
    type Exception_Id is private;
+   pragma Preelaborable_Initialization (Exception_Id);
 
    Null_Id : constant Exception_Id;
 
    type Exception_Occurrence is limited private;
+   pragma Preelaborable_Initialization (Exception_Occurrence);
 
    type Exception_Occurrence_Access is access all Exception_Occurrence;
 
    Null_Occurrence : constant Exception_Occurrence;
 
+   function Exception_Name (Id : Exception_Id) return String;
+
    function Exception_Name (X : Exception_Occurrence) return String;
-   --  Same as Exception_Name (Exception_Identity (X))
 
-   function Exception_Name (Id : Exception_Id) return String;
+   function Wide_Exception_Name
+     (Id : Exception_Id) return Wide_String;
+   pragma Ada_05 (Wide_Exception_Name);
 
+   function Wide_Exception_Name
+     (X : Exception_Occurrence) return Wide_String;
+   pragma Ada_05 (Wide_Exception_Name);
+
+   function Wide_Wide_Exception_Name
+     (Id : Exception_Id) return Wide_Wide_String;
+   pragma Ada_05 (Wide_Wide_Exception_Name);
+
+   function Wide_Wide_Exception_Name
+     (X : Exception_Occurrence) return Wide_Wide_String;
+   pragma Ada_05 (Wide_Wide_Exception_Name);
+
    procedure Raise_Exception (E : Exception_Id; Message : String := "");
    pragma No_Return (Raise_Exception);
    --  Note: In accordance with AI-466, CE is raised if E = Null_Id
@@ -105,7 +110,9 @@
    --    0xyyyyyyyy 0xyyyyyyyy ...
    --
    --  The lines are separated by a ASCII.LF character
-   --  The nnnn is the partition Id given as decimal digits.
+   --
+   --  The nnnn is the partition Id given as decimal digits
+   --
    --  The 0x... line represents traceback program counter locations,
    --  in order with the first one being the exception location.
 
@@ -121,6 +128,22 @@
      (Source : Exception_Occurrence)
       return   Exception_Occurrence_Access;
 
+   --  Ada 2005 (AI-438): The language revision introduces the following
+   --  subprograms and attribute definitions. We do not provide them
+   --  explicitly. instead, the corresponding stream attributes are made
+   --  available through a pragma Stream_Convert in the private part.
+
+   --  procedure Read_Exception_Occurrence
+   --    (Stream : not null access Ada.Streams.Root_Stream_Type'Class;
+   --     Item   : out Exception_Occurrence);
+
+   --  procedure Write_Exception_Occurrence
+   --    (Stream : not null access Ada.Streams.Root_Stream_Type'Class;
+   --     Item   : Exception_Occurrence);
+
+   --  for Exception_Occurrence'Read use Read_Exception_Occurrence;
+   --  for Exception_Occurrence'Write use Write_Exception_Occurrence;
+
 private
    package SSL renames System.Standard_Library;
    package SP renames System.Parameters;
@@ -216,8 +239,8 @@
    pragma No_Return (Reraise_Occurrence_No_Defer);
    --  Exactly like Reraise_Occurrence, except that abort is not deferred
    --  before the call and the parameter X is known not to be the null
-   --  occurrence. This is used in generated code when it is known that
-   --  abort is already deferred.
+   --  occurrence. This is used in generated code when it is known that abort
+   --  is already deferred.
 
    function Triggered_By_Abort return Boolean;
    --  Determine whether the current exception (if it exists) is an instance of
@@ -264,6 +287,10 @@
       Id : Exception_Id;
       --  Exception_Identity for this exception occurrence
 
+      Machine_Occurrence : System.Address;
+      --  The underlying machine occurrence. For GCC, this corresponds to the
+      --  _Unwind_Exception structure address.
+
       Msg_Length : Natural := 0;
       --  Length of message (zero = no message)
 
@@ -295,18 +322,28 @@
    --  this, and it would not work right, because of the Msg and Tracebacks
    --  fields which have unused entries not copied by Save_Occurrence.
 
+   function Get_Exception_Machine_Occurrence
+     (X : Exception_Occurrence) return System.Address;
+   pragma Export (Ada, Get_Exception_Machine_Occurrence,
+                  "__gnat_get_exception_machine_occurrence");
+   --  Get the machine occurrence corresponding to an exception occurrence.
+   --  It is Null_Address if there is no machine occurrence (in runtimes that
+   --  doesn't use GCC mechanism) or if it has been lost (Save_Occurrence
+   --  doesn't save the machine occurrence).
+
    function EO_To_String (X : Exception_Occurrence) return String;
    function String_To_EO (S : String) return Exception_Occurrence;
    pragma Stream_Convert (Exception_Occurrence, String_To_EO, EO_To_String);
    --  Functions for implementing Exception_Occurrence stream attributes
 
    Null_Occurrence : constant Exception_Occurrence := (
-     Id               => null,
-     Msg_Length       => 0,
-     Msg              => (others => ' '),
-     Exception_Raised => False,
-     Pid              => 0,
-     Num_Tracebacks   => 0,
-     Tracebacks       => (others => TBE.Null_TB_Entry));
+     Id                 => null,
+     Machine_Occurrence => System.Null_Address,
+     Msg_Length         => 0,
+     Msg                => (others => ' '),
+     Exception_Raised   => False,
+     Pid                => 0,
+     Num_Tracebacks     => 0,
+     Tracebacks         => (others => TBE.Null_TB_Entry));
 
 end Ada.Exceptions;
Index: a-except-2005.ads
===================================================================
--- a-except-2005.ads	(revision 247293)
+++ a-except-2005.ads	(working copy)
@@ -1,349 +0,0 @@
-------------------------------------------------------------------------------
---                                                                          --
---                         GNAT RUN-TIME COMPONENTS                         --
---                                                                          --
---                       A D A . E X C E P T I O N S                        --
---                                                                          --
---                                 S p e c                                  --
---                                                                          --
---          Copyright (C) 1992-2015, Free Software Foundation, Inc.         --
---                                                                          --
--- This specification is derived from the Ada Reference Manual for use with --
--- GNAT. The copyright notice above, and the license provisions that follow --
--- apply solely to the  contents of the part following the private keyword. --
---                                                                          --
--- 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 version of Ada.Exceptions fully supports Ada 95 and later language
---  versions.  It is used in all situations except for the build of the
---  compiler and other basic tools. For these latter builds, we use an
---  Ada 95-only version.
-
---  The reason for this splitting off of a separate version is to support
---  older bootstrap compilers that do not support Ada 2005 features, and
---  Ada.Exceptions is part of the compiler sources.
-
-pragma Polling (Off);
---  We must turn polling off for this unit, because otherwise we get
---  elaboration circularities with ourself.
-
-with System;
-with System.Parameters;
-with System.Standard_Library;
-with System.Traceback_Entries;
-
-package Ada.Exceptions is
-   pragma Preelaborate;
-   --  In accordance with Ada 2005 AI-362.
-
-   type Exception_Id is private;
-   pragma Preelaborable_Initialization (Exception_Id);
-
-   Null_Id : constant Exception_Id;
-
-   type Exception_Occurrence is limited private;
-   pragma Preelaborable_Initialization (Exception_Occurrence);
-
-   type Exception_Occurrence_Access is access all Exception_Occurrence;
-
-   Null_Occurrence : constant Exception_Occurrence;
-
-   function Exception_Name (Id : Exception_Id) return String;
-
-   function Exception_Name (X : Exception_Occurrence) return String;
-
-   function Wide_Exception_Name
-     (Id : Exception_Id) return Wide_String;
-   pragma Ada_05 (Wide_Exception_Name);
-
-   function Wide_Exception_Name
-     (X : Exception_Occurrence) return Wide_String;
-   pragma Ada_05 (Wide_Exception_Name);
-
-   function Wide_Wide_Exception_Name
-     (Id : Exception_Id) return Wide_Wide_String;
-   pragma Ada_05 (Wide_Wide_Exception_Name);
-
-   function Wide_Wide_Exception_Name
-     (X : Exception_Occurrence) return Wide_Wide_String;
-   pragma Ada_05 (Wide_Wide_Exception_Name);
-
-   procedure Raise_Exception (E : Exception_Id; Message : String := "");
-   pragma No_Return (Raise_Exception);
-   --  Note: In accordance with AI-466, CE is raised if E = Null_Id
-
-   function Exception_Message (X : Exception_Occurrence) return String;
-
-   procedure Reraise_Occurrence (X : Exception_Occurrence);
-   --  Note: it would be really nice to give a pragma No_Return for this
-   --  procedure, but it would be wrong, since Reraise_Occurrence does return
-   --  if the argument is the null exception occurrence. See also procedure
-   --  Reraise_Occurrence_Always in the private part of this package.
-
-   function Exception_Identity (X : Exception_Occurrence) return Exception_Id;
-
-   function Exception_Information (X : Exception_Occurrence) return String;
-   --  The format of the exception information is as follows:
-   --
-   --    exception name (as in Exception_Name)
-   --    message (or a null line if no message)
-   --    PID=nnnn
-   --    0xyyyyyyyy 0xyyyyyyyy ...
-   --
-   --  The lines are separated by a ASCII.LF character
-   --
-   --  The nnnn is the partition Id given as decimal digits
-   --
-   --  The 0x... line represents traceback program counter locations,
-   --  in order with the first one being the exception location.
-
-   --  Note on ordering: the compiler uses the Save_Occurrence procedure, but
-   --  not the function from Rtsfind, so it is important that the procedure
-   --  come first, since Rtsfind finds the first matching entity.
-
-   procedure Save_Occurrence
-     (Target : out Exception_Occurrence;
-      Source : Exception_Occurrence);
-
-   function Save_Occurrence
-     (Source : Exception_Occurrence)
-      return   Exception_Occurrence_Access;
-
-   --  Ada 2005 (AI-438): The language revision introduces the following
-   --  subprograms and attribute definitions. We do not provide them
-   --  explicitly. instead, the corresponding stream attributes are made
-   --  available through a pragma Stream_Convert in the private part.
-
-   --  procedure Read_Exception_Occurrence
-   --    (Stream : not null access Ada.Streams.Root_Stream_Type'Class;
-   --     Item   : out Exception_Occurrence);
-
-   --  procedure Write_Exception_Occurrence
-   --    (Stream : not null access Ada.Streams.Root_Stream_Type'Class;
-   --     Item   : Exception_Occurrence);
-
-   --  for Exception_Occurrence'Read use Read_Exception_Occurrence;
-   --  for Exception_Occurrence'Write use Write_Exception_Occurrence;
-
-private
-   package SSL renames System.Standard_Library;
-   package SP renames System.Parameters;
-
-   subtype EOA is Exception_Occurrence_Access;
-
-   Exception_Msg_Max_Length : constant := SP.Default_Exception_Msg_Max_Length;
-
-   ------------------
-   -- Exception_Id --
-   ------------------
-
-   subtype Code_Loc is System.Address;
-   --  Code location used in building exception tables and for call addresses
-   --  when propagating an exception. Values of this type are created by using
-   --  Label'Address or extracted from machine states using Get_Code_Loc.
-
-   Null_Loc : constant Code_Loc := System.Null_Address;
-   --  Null code location, used to flag outer level frame
-
-   type Exception_Id is new SSL.Exception_Data_Ptr;
-
-   function EId_To_String (X : Exception_Id) return String;
-   function String_To_EId (S : String) return Exception_Id;
-   pragma Stream_Convert (Exception_Id, String_To_EId, EId_To_String);
-   --  Functions for implementing Exception_Id stream attributes
-
-   Null_Id : constant Exception_Id := null;
-
-   -------------------------
-   -- Private Subprograms --
-   -------------------------
-
-   function Exception_Name_Simple (X : Exception_Occurrence) return String;
-   --  Like Exception_Name, but returns the simple non-qualified name of the
-   --  exception. This is used to implement the Exception_Name function in
-   --  Current_Exceptions (the DEC compatible unit). It is called from the
-   --  compiler generated code (using Rtsfind, which does not respect the
-   --  private barrier, so we can place this function in the private part
-   --  where the compiler can find it, but the spec is unchanged.)
-
-   procedure Raise_Exception_Always (E : Exception_Id; Message : String := "");
-   pragma No_Return (Raise_Exception_Always);
-   pragma Export (Ada, Raise_Exception_Always, "__gnat_raise_exception");
-   --  This differs from Raise_Exception only in that the caller has determined
-   --  that for sure the parameter E is not null, and that therefore no check
-   --  for Null_Id is required. The expander converts Raise_Exception calls to
-   --  Raise_Exception_Always if it can determine this is the case. The Export
-   --  allows this routine to be accessed from Pure units.
-
-   procedure Raise_From_Signal_Handler
-     (E : Exception_Id;
-      M : System.Address);
-   pragma Export
-     (Ada, Raise_From_Signal_Handler,
-           "ada__exceptions__raise_from_signal_handler");
-   pragma No_Return (Raise_From_Signal_Handler);
-   --  This routine is used to raise an exception from a signal handler. The
-   --  signal handler has already stored the machine state (i.e. the state that
-   --  corresponds to the location at which the signal was raised). E is the
-   --  Exception_Id specifying what exception is being raised, and M is a
-   --  pointer to a null-terminated string which is the message to be raised.
-   --  Note that this routine never returns, so it is permissible to simply
-   --  jump to this routine, rather than call it. This may be appropriate for
-   --  systems where the right way to get out of signal handler is to alter the
-   --  PC value in the machine state or in some other way ask the operating
-   --  system to return here rather than to the original location.
-
-   procedure Raise_From_Controlled_Operation
-     (X : Ada.Exceptions.Exception_Occurrence);
-   pragma No_Return (Raise_From_Controlled_Operation);
-   pragma Export
-     (Ada, Raise_From_Controlled_Operation,
-           "__gnat_raise_from_controlled_operation");
-   --  Raise Program_Error, providing information about X (an exception raised
-   --  during a controlled operation) in the exception message.
-
-   procedure Reraise_Library_Exception_If_Any;
-   pragma Export
-     (Ada, Reraise_Library_Exception_If_Any,
-           "__gnat_reraise_library_exception_if_any");
-   --  If there was an exception raised during library-level finalization,
-   --  reraise the exception.
-
-   procedure Reraise_Occurrence_Always (X : Exception_Occurrence);
-   pragma No_Return (Reraise_Occurrence_Always);
-   --  This differs from Raise_Occurrence only in that the caller guarantees
-   --  that for sure the parameter X is not the null occurrence, and that
-   --  therefore this procedure cannot return. The expander uses this routine
-   --  in the translation of a raise statement with no parameter (reraise).
-
-   procedure Reraise_Occurrence_No_Defer (X : Exception_Occurrence);
-   pragma No_Return (Reraise_Occurrence_No_Defer);
-   --  Exactly like Reraise_Occurrence, except that abort is not deferred
-   --  before the call and the parameter X is known not to be the null
-   --  occurrence. This is used in generated code when it is known that abort
-   --  is already deferred.
-
-   function Triggered_By_Abort return Boolean;
-   --  Determine whether the current exception (if it exists) is an instance of
-   --  Standard'Abort_Signal.
-
-   -----------------------
-   -- Polling Interface --
-   -----------------------
-
-   --  The GNAT compiler has an option to generate polling calls to the Poll
-   --  routine in this package. Specifying the -gnatP option for a compilation
-   --  causes a call to Ada.Exceptions.Poll to be generated on every subprogram
-   --  entry and on every iteration of a loop, thus avoiding the possibility of
-   --  a case of unbounded time between calls.
-
-   --  This polling interface may be used for instrumentation or debugging
-   --  purposes (e.g. implementing watchpoints in software or in the debugger).
-
-   --  In the GNAT technology itself, this interface is used to implement
-   --  immediate asynchronous transfer of control and immediate abort on
-   --  targets which do not provide for one thread interrupting another.
-
-   --  Note: this used to be in a separate unit called System.Poll, but that
-   --  caused horrible circular elaboration problems between System.Poll and
-   --  Ada.Exceptions.
-
-   procedure Poll;
-   --  Check for asynchronous abort. Note that we do not inline the body.
-   --  This makes the interface more useful for debugging purposes.
-
-   --------------------------
-   -- Exception_Occurrence --
-   --------------------------
-
-   package TBE renames System.Traceback_Entries;
-
-   Max_Tracebacks : constant := 50;
-   --  Maximum number of trace backs stored in exception occurrence
-
-   subtype Tracebacks_Array is TBE.Tracebacks_Array (1 .. Max_Tracebacks);
-   --  Traceback array stored in exception occurrence
-
-   type Exception_Occurrence is record
-      Id : Exception_Id;
-      --  Exception_Identity for this exception occurrence
-
-      Machine_Occurrence : System.Address;
-      --  The underlying machine occurrence. For GCC, this corresponds to the
-      --  _Unwind_Exception structure address.
-
-      Msg_Length : Natural := 0;
-      --  Length of message (zero = no message)
-
-      Msg : String (1 .. Exception_Msg_Max_Length);
-      --  Characters of message
-
-      Exception_Raised : Boolean := False;
-      --  Set to true to indicate that this exception occurrence has actually
-      --  been raised. When an exception occurrence is first created, this is
-      --  set to False, then when it is processed by Raise_Current_Exception,
-      --  it is set to True. If Raise_Current_Exception is used to raise an
-      --  exception for which this flag is already True, then it knows that
-      --  it is dealing with the reraise case (which is useful to distinguish
-      --  for exception tracing purposes).
-
-      Pid : Natural := 0;
-      --  Partition_Id for partition raising exception
-
-      Num_Tracebacks : Natural range 0 .. Max_Tracebacks := 0;
-      --  Number of traceback entries stored
-
-      Tracebacks : Tracebacks_Array;
-      --  Stored tracebacks (in Tracebacks (1 .. Num_Tracebacks))
-   end record;
-
-   function "=" (Left, Right : Exception_Occurrence) return Boolean
-     is abstract;
-   --  Don't allow comparison on exception occurrences, we should not need
-   --  this, and it would not work right, because of the Msg and Tracebacks
-   --  fields which have unused entries not copied by Save_Occurrence.
-
-   function Get_Exception_Machine_Occurrence
-     (X : Exception_Occurrence) return System.Address;
-   pragma Export (Ada, Get_Exception_Machine_Occurrence,
-                  "__gnat_get_exception_machine_occurrence");
-   --  Get the machine occurrence corresponding to an exception occurrence.
-   --  It is Null_Address if there is no machine occurrence (in runtimes that
-   --  doesn't use GCC mechanism) or if it has been lost (Save_Occurrence
-   --  doesn't save the machine occurrence).
-
-   function EO_To_String (X : Exception_Occurrence) return String;
-   function String_To_EO (S : String) return Exception_Occurrence;
-   pragma Stream_Convert (Exception_Occurrence, String_To_EO, EO_To_String);
-   --  Functions for implementing Exception_Occurrence stream attributes
-
-   Null_Occurrence : constant Exception_Occurrence := (
-     Id                 => null,
-     Machine_Occurrence => System.Null_Address,
-     Msg_Length         => 0,
-     Msg                => (others => ' '),
-     Exception_Raised   => False,
-     Pid                => 0,
-     Num_Tracebacks     => 0,
-     Tracebacks         => (others => TBE.Null_TB_Entry));
-
-end Ada.Exceptions;
Index: a-except-2005.adb
===================================================================
--- a-except-2005.adb	(revision 247293)
+++ a-except-2005.adb	(working copy)
@@ -1,1748 +0,0 @@
-------------------------------------------------------------------------------
---                                                                          --
---                         GNAT COMPILER COMPONENTS                         --
---                                                                          --
---                       A D A . E X C E P T I O N S                        --
---                                                                          --
---                                 B o d y                                  --
---                                                                          --
---          Copyright (C) 1992-2015, Free Software Foundation, Inc.         --
---                                                                          --
--- 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.      --
---                                                                          --
-------------------------------------------------------------------------------
-
-pragma Style_Checks (All_Checks);
---  No subprogram ordering check, due to logical grouping
-
-pragma Polling (Off);
---  We must turn polling off for this unit, because otherwise we get
---  elaboration circularities with System.Exception_Tables.
-
-with System;                  use System;
-with System.Exceptions;       use System.Exceptions;
-with System.Exceptions_Debug; use System.Exceptions_Debug;
-with System.Standard_Library; use System.Standard_Library;
-with System.Soft_Links;       use System.Soft_Links;
-with System.WCh_Con;          use System.WCh_Con;
-with System.WCh_StW;          use System.WCh_StW;
-
-pragma Warnings (Off);
---  Suppress complaints about Symbolic not being referenced, and about it not
---  having pragma Preelaborate.
-with System.Traceback.Symbolic;
---  Bring Symbolic into the closure. If it is the s-trasym-dwarf.adb version,
---  it will install symbolic tracebacks as the default decorator. Otherwise,
---  symbolic tracebacks are not supported, and we fall back to hexadecimal
---  addresses.
-pragma Warnings (On);
-
-package body Ada.Exceptions is
-
-   pragma Suppress (All_Checks);
-   --  We definitely do not want exceptions occurring within this unit, or
-   --  we are in big trouble. If an exceptional situation does occur, better
-   --  that it not be raised, since raising it can cause confusing chaos.
-
-   -----------------------
-   -- Local Subprograms --
-   -----------------------
-
-   --  Note: the exported subprograms in this package body are called directly
-   --  from C clients using the given external name, even though they are not
-   --  technically visible in the Ada sense.
-
-   function Code_Address_For_AAA return System.Address;
-   function Code_Address_For_ZZZ return System.Address;
-   --  Return start and end of procedures in this package
-   --
-   --  These procedures are used to provide exclusion bounds in
-   --  calls to Call_Chain at exception raise points from this unit. The
-   --  purpose is to arrange for the exception tracebacks not to include
-   --  frames from subprograms involved in the raise process, as these are
-   --  meaningless from the user's standpoint.
-   --
-   --  For these bounds to be meaningful, we need to ensure that the object
-   --  code for the subprograms involved in processing a raise is located
-   --  after the object code Code_Address_For_AAA and before the object
-   --  code Code_Address_For_ZZZ. This will indeed be the case as long as
-   --  the following rules are respected:
-   --
-   --  1) The bodies of the subprograms involved in processing a raise
-   --     are located after the body of Code_Address_For_AAA and before the
-   --     body of Code_Address_For_ZZZ.
-   --
-   --  2) No pragma Inline applies to any of these subprograms, as this
-   --     could delay the corresponding assembly output until the end of
-   --     the unit.
-
-   procedure Call_Chain (Excep : EOA);
-   --  Store up to Max_Tracebacks in Excep, corresponding to the current
-   --  call chain.
-
-   function Image (Index : Integer) return String;
-   --  Return string image corresponding to Index
-
-   procedure To_Stderr (S : String);
-   pragma Export (Ada, To_Stderr, "__gnat_to_stderr");
-   --  Little routine to output string to stderr that is also used
-   --  in the tasking run time.
-
-   procedure To_Stderr (C : Character);
-   pragma Inline (To_Stderr);
-   pragma Export (Ada, To_Stderr, "__gnat_to_stderr_char");
-   --  Little routine to output a character to stderr, used by some of
-   --  the separate units below.
-
-   package Exception_Data is
-
-      -----------------------------------
-      -- Exception Message Subprograms --
-      -----------------------------------
-
-      procedure Set_Exception_C_Msg
-        (Excep  : EOA;
-         Id     : Exception_Id;
-         Msg1   : System.Address;
-         Line   : Integer        := 0;
-         Column : Integer        := 0;
-         Msg2   : System.Address := System.Null_Address);
-      --  This routine is called to setup the exception referenced by X
-      --  to contain the indicated Id value and message. Msg1 is a null
-      --  terminated string which is generated as the exception message. If
-      --  line is non-zero, then a colon and the decimal representation of
-      --  this integer is appended to the message. Ditto for Column. When Msg2
-      --  is non-null, a space and this additional null terminated string is
-      --  added to the message.
-
-      procedure Set_Exception_Msg
-        (Excep   : EOA;
-         Id      : Exception_Id;
-         Message : String);
-      --  This routine is called to setup the exception referenced by X
-      --  to contain the indicated Id value and message. Message is a string
-      --  which is generated as the exception message.
-
-      ---------------------------------------
-      -- Exception Information Subprograms --
-      ---------------------------------------
-
-      function Untailored_Exception_Information
-        (X : Exception_Occurrence) return String;
-      --  This is used by Stream_Attributes.EO_To_String to convert an
-      --  Exception_Occurrence to a String for the stream attributes.
-      --  String_To_EO understands the format, as documented here.
-      --
-      --  The format of the string is as follows:
-      --
-      --    raised <exception name> : <message>
-      --    (" : <message>" is present only if Exception_Message is not empty)
-      --    PID=nnnn (only if nonzero)
-      --    Call stack traceback locations:  (only if at least one location)
-      --    <0xyyyyyyyy 0xyyyyyyyy ...>      (is recorded)
-      --
-      --  The lines are separated by a ASCII.LF character.
-      --  The nnnn is the partition Id given as decimal digits.
-      --  The 0x... line represents traceback program counter locations, in
-      --  execution order with the first one being the exception location.
-      --
-      --  The Exception_Name and Message lines are omitted in the abort
-      --  signal case, since this is not really an exception.
-      --
-      --  Note: If the format of the generated string is changed, please note
-      --  that an equivalent modification to the routine String_To_EO must be
-      --  made to preserve proper functioning of the stream attributes.
-
-      function Exception_Information (X : Exception_Occurrence) return String;
-      --  This is the implementation of Ada.Exceptions.Exception_Information,
-      --  as defined in the Ada RM.
-      --
-      --  If no traceback decorator (see GNAT.Exception_Traces) is currently
-      --  in place, this is the same as Untailored_Exception_Information.
-      --  Otherwise, the decorator is used to produce a symbolic traceback
-      --  instead of hexadecimal addresses.
-      --
-      --  Note that unlike Untailored_Exception_Information, there is no need
-      --  to keep the output of Exception_Information stable for streaming
-      --  purposes, and in fact the output differs across platforms.
-
-   end Exception_Data;
-
-   package Exception_Traces is
-
-      -------------------------------------------------
-      -- Run-Time Exception Notification Subprograms --
-      -------------------------------------------------
-
-      --  These subprograms provide a common run-time interface to trigger the
-      --  actions required when an exception is about to be propagated (e.g.
-      --  user specified actions or output of exception information). They are
-      --  exported to be usable by the Ada exception handling personality
-      --  routine when the GCC 3 mechanism is used.
-
-      procedure Notify_Handled_Exception (Excep : EOA);
-      pragma Export
-        (C, Notify_Handled_Exception, "__gnat_notify_handled_exception");
-      --  This routine is called for a handled occurrence is about to be
-      --  propagated.
-
-      procedure Notify_Unhandled_Exception (Excep : EOA);
-      pragma Export
-        (C, Notify_Unhandled_Exception, "__gnat_notify_unhandled_exception");
-      --  This routine is called when an unhandled occurrence is about to be
-      --  propagated.
-
-      procedure Unhandled_Exception_Terminate (Excep : EOA);
-      pragma No_Return (Unhandled_Exception_Terminate);
-      --  This procedure is called to terminate execution following an
-      --  unhandled exception. The exception information, including
-      --  traceback if available is output, and execution is then
-      --  terminated. Note that at the point where this routine is
-      --  called, the stack has typically been destroyed.
-
-   end Exception_Traces;
-
-   package Exception_Propagation is
-
-      ---------------------------------------
-      -- Exception Propagation Subprograms --
-      ---------------------------------------
-
-      function Allocate_Occurrence return EOA;
-      --  Allocate an exception occurrence (as well as the machine occurrence)
-
-      procedure Propagate_Exception (Excep : EOA);
-      pragma No_Return (Propagate_Exception);
-      --  This procedure propagates the exception represented by Excep
-
-   end Exception_Propagation;
-
-   package Stream_Attributes is
-
-      ----------------------------------
-      -- Stream Attribute Subprograms --
-      ----------------------------------
-
-      function EId_To_String (X : Exception_Id) return String;
-      function String_To_EId (S : String) return Exception_Id;
-      --  Functions for implementing Exception_Id stream attributes
-
-      function EO_To_String (X : Exception_Occurrence) return String;
-      function String_To_EO (S : String) return Exception_Occurrence;
-      --  Functions for implementing Exception_Occurrence stream
-      --  attributes
-
-   end Stream_Attributes;
-
-   procedure Complete_Occurrence (X : EOA);
-   --  Finish building the occurrence: save the call chain and notify the
-   --  debugger.
-
-   procedure Complete_And_Propagate_Occurrence (X : EOA);
-   pragma No_Return (Complete_And_Propagate_Occurrence);
-   --  This is a simple wrapper to Complete_Occurrence and
-   --  Exception_Propagation.Propagate_Exception.
-
-   function Create_Occurrence_From_Signal_Handler
-     (E : Exception_Id;
-      M : System.Address) return EOA;
-   --  Create and build an exception occurrence using exception id E and
-   --  nul-terminated message M.
-
-   function Create_Machine_Occurrence_From_Signal_Handler
-     (E : Exception_Id;
-      M : System.Address) return System.Address;
-   pragma Export (C, Create_Machine_Occurrence_From_Signal_Handler,
-                  "__gnat_create_machine_occurrence_from_signal_handler");
-   --  Create and build an exception occurrence using exception id E and
-   --  nul-terminated message M. Return the machine occurrence.
-
-   procedure Raise_Exception_No_Defer
-     (E       : Exception_Id;
-      Message : String := "");
-   pragma Export
-    (Ada, Raise_Exception_No_Defer,
-     "ada__exceptions__raise_exception_no_defer");
-   pragma No_Return (Raise_Exception_No_Defer);
-   --  Similar to Raise_Exception, but with no abort deferral
-
-   procedure Raise_With_Msg (E : Exception_Id);
-   pragma No_Return (Raise_With_Msg);
-   pragma Export (C, Raise_With_Msg, "__gnat_raise_with_msg");
-   --  Raises an exception with given exception id value. A message
-   --  is associated with the raise, and has already been stored in the
-   --  exception occurrence referenced by the Current_Excep in the TSD.
-   --  Abort is deferred before the raise call.
-
-   procedure Raise_With_Location_And_Msg
-     (E : Exception_Id;
-      F : System.Address;
-      L : Integer;
-      C : Integer := 0;
-      M : System.Address := System.Null_Address);
-   pragma No_Return (Raise_With_Location_And_Msg);
-   --  Raise an exception with given exception id value. A filename and line
-   --  number is associated with the raise and is stored in the exception
-   --  occurrence and in addition a column and a string message M may be
-   --  appended to this (if not null/0).
-
-   procedure Raise_Constraint_Error (File : System.Address; Line : Integer);
-   pragma No_Return (Raise_Constraint_Error);
-   pragma Export (C, Raise_Constraint_Error, "__gnat_raise_constraint_error");
-   --  Raise constraint error with file:line information
-
-   procedure Raise_Constraint_Error_Msg
-     (File   : System.Address;
-      Line   : Integer;
-      Column : Integer;
-      Msg    : System.Address);
-   pragma No_Return (Raise_Constraint_Error_Msg);
-   pragma Export
-     (C, Raise_Constraint_Error_Msg, "__gnat_raise_constraint_error_msg");
-   --  Raise constraint error with file:line:col + msg information
-
-   procedure Raise_Program_Error (File : System.Address; Line : Integer);
-   pragma No_Return (Raise_Program_Error);
-   pragma Export (C, Raise_Program_Error, "__gnat_raise_program_error");
-   --  Raise program error with file:line information
-
-   procedure Raise_Program_Error_Msg
-     (File : System.Address;
-      Line : Integer;
-      Msg  : System.Address);
-   pragma No_Return (Raise_Program_Error_Msg);
-   pragma Export
-     (C, Raise_Program_Error_Msg, "__gnat_raise_program_error_msg");
-   --  Raise program error with file:line + msg information
-
-   procedure Raise_Storage_Error (File : System.Address; Line : Integer);
-   pragma No_Return (Raise_Storage_Error);
-   pragma Export (C, Raise_Storage_Error, "__gnat_raise_storage_error");
-   --  Raise storage error with file:line information
-
-   procedure Raise_Storage_Error_Msg
-     (File : System.Address;
-      Line : Integer;
-      Msg  : System.Address);
-   pragma No_Return (Raise_Storage_Error_Msg);
-   pragma Export
-     (C, Raise_Storage_Error_Msg, "__gnat_raise_storage_error_msg");
-   --  Raise storage error with file:line + reason msg information
-
-   --  The exception raising process and the automatic tracing mechanism rely
-   --  on some careful use of flags attached to the exception occurrence. The
-   --  graph below illustrates the relations between the Raise_ subprograms
-   --  and identifies the points where basic flags such as Exception_Raised
-   --  are initialized.
-
-   --  (i) signs indicate the flags initialization points. R stands for Raise,
-   --  W for With, and E for Exception.
-
-   --                   R_No_Msg    R_E   R_Pe  R_Ce  R_Se
-   --                       |        |     |     |     |
-   --                       +--+  +--+     +---+ | +---+
-   --                          |  |            | | |
-   --     R_E_No_Defer(i)    R_W_Msg(i)       R_W_Loc
-   --           |               |              |   |
-   --           +------------+  |  +-----------+   +--+
-   --                        |  |  |                  |
-   --                        |  |  |             Set_E_C_Msg(i)
-   --                        |  |  |
-   --            Complete_And_Propagate_Occurrence
-
-   procedure Reraise;
-   pragma No_Return (Reraise);
-   pragma Export (C, Reraise, "__gnat_reraise");
-   --  Reraises the exception referenced by the Current_Excep field
-   --  of the TSD (all fields of this exception occurrence are set).
-   --  Abort is deferred before the reraise operation. Called from
-   --  System.Tasking.RendezVous.Exceptional_Complete_RendezVous
-
-   procedure Transfer_Occurrence
-     (Target : Exception_Occurrence_Access;
-      Source : Exception_Occurrence);
-   pragma Export (C, Transfer_Occurrence, "__gnat_transfer_occurrence");
-   --  Called from s-tasren.adb:Local_Complete_RendezVous and
-   --  s-tpobop.adb:Exceptional_Complete_Entry_Body to setup Target from
-   --  Source as an exception to be propagated in the caller task. Target is
-   --  expected to be a pointer to the fixed TSD occurrence for this task.
-
-   --------------------------------
-   -- Run-Time Check Subprograms --
-   --------------------------------
-
-   --  These subprograms raise a specific exception with a reason message
-   --  attached. The parameters are the file name and line number in each
-   --  case. The names are defined by Exp_Ch11.Get_RT_Exception_Name.
-
-   procedure Rcheck_CE_Access_Check
-     (File : System.Address; Line : Integer);
-   procedure Rcheck_CE_Null_Access_Parameter
-     (File : System.Address; Line : Integer);
-   procedure Rcheck_CE_Discriminant_Check
-     (File : System.Address; Line : Integer);
-   procedure Rcheck_CE_Divide_By_Zero
-     (File : System.Address; Line : Integer);
-   procedure Rcheck_CE_Explicit_Raise
-     (File : System.Address; Line : Integer);
-   procedure Rcheck_CE_Index_Check
-     (File : System.Address; Line : Integer);
-   procedure Rcheck_CE_Invalid_Data
-     (File : System.Address; Line : Integer);
-   procedure Rcheck_CE_Length_Check
-     (File : System.Address; Line : Integer);
-   procedure Rcheck_CE_Null_Exception_Id
-     (File : System.Address; Line : Integer);
-   procedure Rcheck_CE_Null_Not_Allowed
-     (File : System.Address; Line : Integer);
-   procedure Rcheck_CE_Overflow_Check
-     (File : System.Address; Line : Integer);
-   procedure Rcheck_CE_Partition_Check
-     (File : System.Address; Line : Integer);
-   procedure Rcheck_CE_Range_Check
-     (File : System.Address; Line : Integer);
-   procedure Rcheck_CE_Tag_Check
-     (File : System.Address; Line : Integer);
-   procedure Rcheck_PE_Access_Before_Elaboration
-     (File : System.Address; Line : Integer);
-   procedure Rcheck_PE_Accessibility_Check
-     (File : System.Address; Line : Integer);
-   procedure Rcheck_PE_Address_Of_Intrinsic
-     (File : System.Address; Line : Integer);
-   procedure Rcheck_PE_Aliased_Parameters
-     (File : System.Address; Line : Integer);
-   procedure Rcheck_PE_All_Guards_Closed
-     (File : System.Address; Line : Integer);
-   procedure Rcheck_PE_Bad_Predicated_Generic_Type
-     (File : System.Address; Line : Integer);
-   procedure Rcheck_PE_Current_Task_In_Entry_Body
-     (File : System.Address; Line : Integer);
-   procedure Rcheck_PE_Duplicated_Entry_Address
-     (File : System.Address; Line : Integer);
-   procedure Rcheck_PE_Explicit_Raise
-     (File : System.Address; Line : Integer);
-   procedure Rcheck_PE_Implicit_Return
-     (File : System.Address; Line : Integer);
-   procedure Rcheck_PE_Misaligned_Address_Value
-     (File : System.Address; Line : Integer);
-   procedure Rcheck_PE_Missing_Return
-     (File : System.Address; Line : Integer);
-   procedure Rcheck_PE_Non_Transportable_Actual
-     (File : System.Address; Line : Integer);
-   procedure Rcheck_PE_Overlaid_Controlled_Object
-     (File : System.Address; Line : Integer);
-   procedure Rcheck_PE_Potentially_Blocking_Operation
-     (File : System.Address; Line : Integer);
-   procedure Rcheck_PE_Stubbed_Subprogram_Called
-     (File : System.Address; Line : Integer);
-   procedure Rcheck_PE_Unchecked_Union_Restriction
-     (File : System.Address; Line : Integer);
-   procedure Rcheck_SE_Empty_Storage_Pool
-     (File : System.Address; Line : Integer);
-   procedure Rcheck_SE_Explicit_Raise
-     (File : System.Address; Line : Integer);
-   procedure Rcheck_SE_Infinite_Recursion
-     (File : System.Address; Line : Integer);
-   procedure Rcheck_SE_Object_Too_Large
-     (File : System.Address; Line : Integer);
-   procedure Rcheck_PE_Stream_Operation_Not_Allowed
-     (File : System.Address; Line : Integer);
-   procedure Rcheck_CE_Access_Check_Ext
-     (File : System.Address; Line, Column : Integer);
-   procedure Rcheck_CE_Index_Check_Ext
-     (File : System.Address; Line, Column, Index, First, Last : Integer);
-   procedure Rcheck_CE_Invalid_Data_Ext
-     (File : System.Address; Line, Column, Index, First, Last : Integer);
-   procedure Rcheck_CE_Range_Check_Ext
-     (File : System.Address; Line, Column, Index, First, Last : Integer);
-
-   procedure Rcheck_PE_Finalize_Raised_Exception
-     (File : System.Address; Line : Integer);
-   --  This routine is separated out because it has quite different behavior
-   --  from the others. This is the "finalize/adjust raised exception". This
-   --  subprogram is always called with abort deferred, unlike all other
-   --  Rcheck_* subprograms, it needs to call Raise_Exception_No_Defer.
-
-   pragma Export (C, Rcheck_CE_Access_Check,
-                  "__gnat_rcheck_CE_Access_Check");
-   pragma Export (C, Rcheck_CE_Null_Access_Parameter,
-                  "__gnat_rcheck_CE_Null_Access_Parameter");
-   pragma Export (C, Rcheck_CE_Discriminant_Check,
-                  "__gnat_rcheck_CE_Discriminant_Check");
-   pragma Export (C, Rcheck_CE_Divide_By_Zero,
-                  "__gnat_rcheck_CE_Divide_By_Zero");
-   pragma Export (C, Rcheck_CE_Explicit_Raise,
-                  "__gnat_rcheck_CE_Explicit_Raise");
-   pragma Export (C, Rcheck_CE_Index_Check,
-                  "__gnat_rcheck_CE_Index_Check");
-   pragma Export (C, Rcheck_CE_Invalid_Data,
-                  "__gnat_rcheck_CE_Invalid_Data");
-   pragma Export (C, Rcheck_CE_Length_Check,
-                  "__gnat_rcheck_CE_Length_Check");
-   pragma Export (C, Rcheck_CE_Null_Exception_Id,
-                  "__gnat_rcheck_CE_Null_Exception_Id");
-   pragma Export (C, Rcheck_CE_Null_Not_Allowed,
-                  "__gnat_rcheck_CE_Null_Not_Allowed");
-   pragma Export (C, Rcheck_CE_Overflow_Check,
-                  "__gnat_rcheck_CE_Overflow_Check");
-   pragma Export (C, Rcheck_CE_Partition_Check,
-                  "__gnat_rcheck_CE_Partition_Check");
-   pragma Export (C, Rcheck_CE_Range_Check,
-                  "__gnat_rcheck_CE_Range_Check");
-   pragma Export (C, Rcheck_CE_Tag_Check,
-                  "__gnat_rcheck_CE_Tag_Check");
-   pragma Export (C, Rcheck_PE_Access_Before_Elaboration,
-                  "__gnat_rcheck_PE_Access_Before_Elaboration");
-   pragma Export (C, Rcheck_PE_Accessibility_Check,
-                  "__gnat_rcheck_PE_Accessibility_Check");
-   pragma Export (C, Rcheck_PE_Address_Of_Intrinsic,
-                  "__gnat_rcheck_PE_Address_Of_Intrinsic");
-   pragma Export (C, Rcheck_PE_Aliased_Parameters,
-                  "__gnat_rcheck_PE_Aliased_Parameters");
-   pragma Export (C, Rcheck_PE_All_Guards_Closed,
-                  "__gnat_rcheck_PE_All_Guards_Closed");
-   pragma Export (C, Rcheck_PE_Bad_Predicated_Generic_Type,
-                  "__gnat_rcheck_PE_Bad_Predicated_Generic_Type");
-   pragma Export (C, Rcheck_PE_Current_Task_In_Entry_Body,
-                  "__gnat_rcheck_PE_Current_Task_In_Entry_Body");
-   pragma Export (C, Rcheck_PE_Duplicated_Entry_Address,
-                  "__gnat_rcheck_PE_Duplicated_Entry_Address");
-   pragma Export (C, Rcheck_PE_Explicit_Raise,
-                  "__gnat_rcheck_PE_Explicit_Raise");
-   pragma Export (C, Rcheck_PE_Finalize_Raised_Exception,
-                  "__gnat_rcheck_PE_Finalize_Raised_Exception");
-   pragma Export (C, Rcheck_PE_Implicit_Return,
-                  "__gnat_rcheck_PE_Implicit_Return");
-   pragma Export (C, Rcheck_PE_Misaligned_Address_Value,
-                  "__gnat_rcheck_PE_Misaligned_Address_Value");
-   pragma Export (C, Rcheck_PE_Missing_Return,
-                  "__gnat_rcheck_PE_Missing_Return");
-   pragma Export (C, Rcheck_PE_Non_Transportable_Actual,
-                  "__gnat_rcheck_PE_Non_Transportable_Actual");
-   pragma Export (C, Rcheck_PE_Overlaid_Controlled_Object,
-                  "__gnat_rcheck_PE_Overlaid_Controlled_Object");
-   pragma Export (C, Rcheck_PE_Potentially_Blocking_Operation,
-                  "__gnat_rcheck_PE_Potentially_Blocking_Operation");
-   pragma Export (C, Rcheck_PE_Stream_Operation_Not_Allowed,
-                  "__gnat_rcheck_PE_Stream_Operation_Not_Allowed");
-   pragma Export (C, Rcheck_PE_Stubbed_Subprogram_Called,
-                  "__gnat_rcheck_PE_Stubbed_Subprogram_Called");
-   pragma Export (C, Rcheck_PE_Unchecked_Union_Restriction,
-                  "__gnat_rcheck_PE_Unchecked_Union_Restriction");
-   pragma Export (C, Rcheck_SE_Empty_Storage_Pool,
-                  "__gnat_rcheck_SE_Empty_Storage_Pool");
-   pragma Export (C, Rcheck_SE_Explicit_Raise,
-                  "__gnat_rcheck_SE_Explicit_Raise");
-   pragma Export (C, Rcheck_SE_Infinite_Recursion,
-                  "__gnat_rcheck_SE_Infinite_Recursion");
-   pragma Export (C, Rcheck_SE_Object_Too_Large,
-                  "__gnat_rcheck_SE_Object_Too_Large");
-
-   pragma Export (C, Rcheck_CE_Access_Check_Ext,
-                  "__gnat_rcheck_CE_Access_Check_ext");
-   pragma Export (C, Rcheck_CE_Index_Check_Ext,
-                  "__gnat_rcheck_CE_Index_Check_ext");
-   pragma Export (C, Rcheck_CE_Invalid_Data_Ext,
-                  "__gnat_rcheck_CE_Invalid_Data_ext");
-   pragma Export (C, Rcheck_CE_Range_Check_Ext,
-                  "__gnat_rcheck_CE_Range_Check_ext");
-
-   --  None of these procedures ever returns (they raise an exception). By
-   --  using pragma No_Return, we ensure that any junk code after the call,
-   --  such as normal return epilogue stuff, can be eliminated).
-
-   pragma No_Return (Rcheck_CE_Access_Check);
-   pragma No_Return (Rcheck_CE_Null_Access_Parameter);
-   pragma No_Return (Rcheck_CE_Discriminant_Check);
-   pragma No_Return (Rcheck_CE_Divide_By_Zero);
-   pragma No_Return (Rcheck_CE_Explicit_Raise);
-   pragma No_Return (Rcheck_CE_Index_Check);
-   pragma No_Return (Rcheck_CE_Invalid_Data);
-   pragma No_Return (Rcheck_CE_Length_Check);
-   pragma No_Return (Rcheck_CE_Null_Exception_Id);
-   pragma No_Return (Rcheck_CE_Null_Not_Allowed);
-   pragma No_Return (Rcheck_CE_Overflow_Check);
-   pragma No_Return (Rcheck_CE_Partition_Check);
-   pragma No_Return (Rcheck_CE_Range_Check);
-   pragma No_Return (Rcheck_CE_Tag_Check);
-   pragma No_Return (Rcheck_PE_Access_Before_Elaboration);
-   pragma No_Return (Rcheck_PE_Accessibility_Check);
-   pragma No_Return (Rcheck_PE_Address_Of_Intrinsic);
-   pragma No_Return (Rcheck_PE_Aliased_Parameters);
-   pragma No_Return (Rcheck_PE_All_Guards_Closed);
-   pragma No_Return (Rcheck_PE_Bad_Predicated_Generic_Type);
-   pragma No_Return (Rcheck_PE_Current_Task_In_Entry_Body);
-   pragma No_Return (Rcheck_PE_Duplicated_Entry_Address);
-   pragma No_Return (Rcheck_PE_Explicit_Raise);
-   pragma No_Return (Rcheck_PE_Implicit_Return);
-   pragma No_Return (Rcheck_PE_Misaligned_Address_Value);
-   pragma No_Return (Rcheck_PE_Missing_Return);
-   pragma No_Return (Rcheck_PE_Non_Transportable_Actual);
-   pragma No_Return (Rcheck_PE_Overlaid_Controlled_Object);
-   pragma No_Return (Rcheck_PE_Potentially_Blocking_Operation);
-   pragma No_Return (Rcheck_PE_Stream_Operation_Not_Allowed);
-   pragma No_Return (Rcheck_PE_Stubbed_Subprogram_Called);
-   pragma No_Return (Rcheck_PE_Unchecked_Union_Restriction);
-   pragma No_Return (Rcheck_PE_Finalize_Raised_Exception);
-   pragma No_Return (Rcheck_SE_Empty_Storage_Pool);
-   pragma No_Return (Rcheck_SE_Explicit_Raise);
-   pragma No_Return (Rcheck_SE_Infinite_Recursion);
-   pragma No_Return (Rcheck_SE_Object_Too_Large);
-
-   pragma No_Return (Rcheck_CE_Access_Check_Ext);
-   pragma No_Return (Rcheck_CE_Index_Check_Ext);
-   pragma No_Return (Rcheck_CE_Invalid_Data_Ext);
-   pragma No_Return (Rcheck_CE_Range_Check_Ext);
-
-   ---------------------------------------------
-   -- Reason Strings for Run-Time Check Calls --
-   ---------------------------------------------
-
-   --  These strings are null-terminated and are used by Rcheck_nn. The
-   --  strings correspond to the definitions for Types.RT_Exception_Code.
-
-   use ASCII;
-
-   Rmsg_00 : constant String := "access check failed"              & NUL;
-   Rmsg_01 : constant String := "access parameter is null"         & NUL;
-   Rmsg_02 : constant String := "discriminant check failed"        & NUL;
-   Rmsg_03 : constant String := "divide by zero"                   & NUL;
-   Rmsg_04 : constant String := "explicit raise"                   & NUL;
-   Rmsg_05 : constant String := "index check failed"               & NUL;
-   Rmsg_06 : constant String := "invalid data"                     & NUL;
-   Rmsg_07 : constant String := "length check failed"              & NUL;
-   Rmsg_08 : constant String := "null Exception_Id"                & NUL;
-   Rmsg_09 : constant String := "null-exclusion check failed"      & NUL;
-   Rmsg_10 : constant String := "overflow check failed"            & NUL;
-   Rmsg_11 : constant String := "partition check failed"           & NUL;
-   Rmsg_12 : constant String := "range check failed"               & NUL;
-   Rmsg_13 : constant String := "tag check failed"                 & NUL;
-   Rmsg_14 : constant String := "access before elaboration"        & NUL;
-   Rmsg_15 : constant String := "accessibility check failed"       & NUL;
-   Rmsg_16 : constant String := "attempt to take address of"       &
-                                " intrinsic subprogram"            & NUL;
-   Rmsg_17 : constant String := "aliased parameters"               & NUL;
-   Rmsg_18 : constant String := "all guards closed"                & NUL;
-   Rmsg_19 : constant String := "improper use of generic subtype"  &
-                                " with predicate"                  & NUL;
-   Rmsg_20 : constant String := "Current_Task referenced in entry" &
-                                " body"                            & NUL;
-   Rmsg_21 : constant String := "duplicated entry address"         & NUL;
-   Rmsg_22 : constant String := "explicit raise"                   & NUL;
-   Rmsg_23 : constant String := "finalize/adjust raised exception" & NUL;
-   Rmsg_24 : constant String := "implicit return with No_Return"   & NUL;
-   Rmsg_25 : constant String := "misaligned address value"         & NUL;
-   Rmsg_26 : constant String := "missing return"                   & NUL;
-   Rmsg_27 : constant String := "overlaid controlled object"       & NUL;
-   Rmsg_28 : constant String := "potentially blocking operation"   & NUL;
-   Rmsg_29 : constant String := "stubbed subprogram called"        & NUL;
-   Rmsg_30 : constant String := "unchecked union restriction"      & NUL;
-   Rmsg_31 : constant String := "actual/returned class-wide"       &
-                                " value not transportable"         & NUL;
-   Rmsg_32 : constant String := "empty storage pool"               & NUL;
-   Rmsg_33 : constant String := "explicit raise"                   & NUL;
-   Rmsg_34 : constant String := "infinite recursion"               & NUL;
-   Rmsg_35 : constant String := "object too large"                 & NUL;
-   Rmsg_36 : constant String := "stream operation not allowed"     & NUL;
-
-   -----------------------
-   -- Polling Interface --
-   -----------------------
-
-   type Unsigned is mod 2 ** 32;
-
-   Counter : Unsigned := 0;
-   pragma Warnings (Off, Counter);
-   --  This counter is provided for convenience. It can be used in Poll to
-   --  perform periodic but not systematic operations.
-
-   procedure Poll is separate;
-   --  The actual polling routine is separate, so that it can easily be
-   --  replaced with a target dependent version.
-
-   --------------------------
-   -- Code_Address_For_AAA --
-   --------------------------
-
-   --  This function gives us the start of the PC range for addresses within
-   --  the exception unit itself. We hope that gigi/gcc keep all the procedures
-   --  in their original order.
-
-   function Code_Address_For_AAA return System.Address is
-   begin
-      --  We are using a label instead of Code_Address_For_AAA'Address because
-      --  on some platforms the latter does not yield the address we want, but
-      --  the address of a stub or of a descriptor instead. This is the case at
-      --  least on PA-HPUX.
-
-      <<Start_Of_AAA>>
-      return Start_Of_AAA'Address;
-   end Code_Address_For_AAA;
-
-   ----------------
-   -- Call_Chain --
-   ----------------
-
-   procedure Call_Chain (Excep : EOA) is separate;
-   --  The actual Call_Chain routine is separate, so that it can easily
-   --  be dummied out when no exception traceback information is needed.
-
-   -------------------
-   -- EId_To_String --
-   -------------------
-
-   function EId_To_String (X : Exception_Id) return String
-     renames Stream_Attributes.EId_To_String;
-
-   ------------------
-   -- EO_To_String --
-   ------------------
-
-   --  We use the null string to represent the null occurrence, otherwise we
-   --  output the Untailored_Exception_Information string for the occurrence.
-
-   function EO_To_String (X : Exception_Occurrence) return String
-     renames Stream_Attributes.EO_To_String;
-
-   ------------------------
-   -- Exception_Identity --
-   ------------------------
-
-   function Exception_Identity
-     (X : Exception_Occurrence) return Exception_Id
-   is
-   begin
-      --  Note that the following test used to be here for the original
-      --  Ada 95 semantics, but these were modified by AI-241 to require
-      --  returning Null_Id instead of raising Constraint_Error.
-
-      --  if X.Id = Null_Id then
-      --     raise Constraint_Error;
-      --  end if;
-
-      return X.Id;
-   end Exception_Identity;
-
-   ---------------------------
-   -- Exception_Information --
-   ---------------------------
-
-   function Exception_Information (X : Exception_Occurrence) return String is
-   begin
-      if X.Id = Null_Id then
-         raise Constraint_Error;
-      else
-         return Exception_Data.Exception_Information (X);
-      end if;
-   end Exception_Information;
-
-   -----------------------
-   -- Exception_Message --
-   -----------------------
-
-   function Exception_Message (X : Exception_Occurrence) return String is
-   begin
-      if X.Id = Null_Id then
-         raise Constraint_Error;
-      else
-         return X.Msg (1 .. X.Msg_Length);
-      end if;
-   end Exception_Message;
-
-   --------------------
-   -- Exception_Name --
-   --------------------
-
-   function Exception_Name (Id : Exception_Id) return String is
-   begin
-      if Id = null then
-         raise Constraint_Error;
-      else
-         return To_Ptr (Id.Full_Name) (1 .. Id.Name_Length - 1);
-      end if;
-   end Exception_Name;
-
-   function Exception_Name (X : Exception_Occurrence) return String is
-   begin
-      return Exception_Name (X.Id);
-   end Exception_Name;
-
-   ---------------------------
-   -- Exception_Name_Simple --
-   ---------------------------
-
-   function Exception_Name_Simple (X : Exception_Occurrence) return String is
-      Name : constant String := Exception_Name (X);
-      P    : Natural;
-
-   begin
-      P := Name'Length;
-      while P > 1 loop
-         exit when Name (P - 1) = '.';
-         P := P - 1;
-      end loop;
-
-      --  Return result making sure lower bound is 1
-
-      declare
-         subtype Rname is String (1 .. Name'Length - P + 1);
-      begin
-         return Rname (Name (P .. Name'Length));
-      end;
-   end Exception_Name_Simple;
-
-   --------------------
-   -- Exception_Data --
-   --------------------
-
-   package body Exception_Data is separate;
-   --  This package can be easily dummied out if we do not want the basic
-   --  support for exception messages (such as in Ada 83).
-
-   ---------------------------
-   -- Exception_Propagation --
-   ---------------------------
-
-   package body Exception_Propagation is separate;
-   --  Depending on the actual exception mechanism used (front-end or
-   --  back-end based), the implementation will differ, which is why this
-   --  package is separated.
-
-   ----------------------
-   -- Exception_Traces --
-   ----------------------
-
-   package body Exception_Traces is separate;
-   --  Depending on the underlying support for IO the implementation will
-   --  differ. Moreover we would like to dummy out this package in case we
-   --  do not want any exception tracing support. This is why this package
-   --  is separated.
-
-   --------------------------------------
-   -- Get_Exception_Machine_Occurrence --
-   --------------------------------------
-
-   function Get_Exception_Machine_Occurrence
-     (X : Exception_Occurrence) return System.Address
-   is
-   begin
-      return X.Machine_Occurrence;
-   end Get_Exception_Machine_Occurrence;
-
-   -----------
-   -- Image --
-   -----------
-
-   function Image (Index : Integer) return String is
-      Result : constant String := Integer'Image (Index);
-   begin
-      if Result (1) = ' ' then
-         return Result (2 .. Result'Last);
-      else
-         return Result;
-      end if;
-   end Image;
-
-   -----------------------
-   -- Stream Attributes --
-   -----------------------
-
-   package body Stream_Attributes is separate;
-   --  This package can be easily dummied out if we do not want the
-   --  support for streaming Exception_Ids and Exception_Occurrences.
-
-   ----------------------------
-   -- Raise_Constraint_Error --
-   ----------------------------
-
-   procedure Raise_Constraint_Error (File : System.Address; Line : Integer) is
-   begin
-      Raise_With_Location_And_Msg (Constraint_Error_Def'Access, File, Line);
-   end Raise_Constraint_Error;
-
-   --------------------------------
-   -- Raise_Constraint_Error_Msg --
-   --------------------------------
-
-   procedure Raise_Constraint_Error_Msg
-     (File   : System.Address;
-      Line   : Integer;
-      Column : Integer;
-      Msg    : System.Address)
-   is
-   begin
-      Raise_With_Location_And_Msg
-        (Constraint_Error_Def'Access, File, Line, Column, Msg);
-   end Raise_Constraint_Error_Msg;
-
-   -------------------------
-   -- Complete_Occurrence --
-   -------------------------
-
-   procedure Complete_Occurrence (X : EOA) is
-   begin
-      --  Compute the backtrace for this occurrence if the corresponding
-      --  binder option has been set. Call_Chain takes care of the reraise
-      --  case.
-
-      --  ??? Using Call_Chain here means we are going to walk up the stack
-      --  once only for backtracing purposes before doing it again for the
-      --  propagation per se.
-
-      --  The first inspection is much lighter, though, as it only requires
-      --  partial unwinding of each frame. Additionally, although we could use
-      --  the personality routine to record the addresses while propagating,
-      --  this method has two drawbacks:
-
-      --  1) the trace is incomplete if the exception is handled since we
-      --  don't walk past the frame with the handler,
-
-      --    and
-
-      --  2) we would miss the frames for which our personality routine is not
-      --  called, e.g. if C or C++ calls are on the way.
-
-      Call_Chain (X);
-
-      --  Notify the debugger
-      Debug_Raise_Exception
-        (E       => SSL.Exception_Data_Ptr (X.Id),
-         Message => X.Msg (1 .. X.Msg_Length));
-   end Complete_Occurrence;
-
-   ---------------------------------------
-   -- Complete_And_Propagate_Occurrence --
-   ---------------------------------------
-
-   procedure Complete_And_Propagate_Occurrence (X : EOA) is
-   begin
-      Complete_Occurrence (X);
-      Exception_Propagation.Propagate_Exception (X);
-   end Complete_And_Propagate_Occurrence;
-
-   ---------------------
-   -- Raise_Exception --
-   ---------------------
-
-   procedure Raise_Exception
-     (E       : Exception_Id;
-      Message : String := "")
-   is
-      EF : Exception_Id := E;
-   begin
-      --  Raise CE if E = Null_ID (AI-446)
-
-      if E = null then
-         EF := Constraint_Error'Identity;
-      end if;
-
-      --  Go ahead and raise appropriate exception
-
-      Raise_Exception_Always (EF, Message);
-   end Raise_Exception;
-
-   ----------------------------
-   -- Raise_Exception_Always --
-   ----------------------------
-
-   procedure Raise_Exception_Always
-     (E       : Exception_Id;
-      Message : String := "")
-   is
-      X : constant EOA := Exception_Propagation.Allocate_Occurrence;
-
-   begin
-      Exception_Data.Set_Exception_Msg (X, E, Message);
-
-      if not ZCX_By_Default then
-         Abort_Defer.all;
-      end if;
-
-      Complete_And_Propagate_Occurrence (X);
-   end Raise_Exception_Always;
-
-   ------------------------------
-   -- Raise_Exception_No_Defer --
-   ------------------------------
-
-   procedure Raise_Exception_No_Defer
-     (E       : Exception_Id;
-      Message : String := "")
-   is
-      X : constant EOA := Exception_Propagation.Allocate_Occurrence;
-
-   begin
-      Exception_Data.Set_Exception_Msg (X, E, Message);
-
-      --  Do not call Abort_Defer.all, as specified by the spec
-
-      Complete_And_Propagate_Occurrence (X);
-   end Raise_Exception_No_Defer;
-
-   -------------------------------------
-   -- Raise_From_Controlled_Operation --
-   -------------------------------------
-
-   procedure Raise_From_Controlled_Operation
-     (X : Ada.Exceptions.Exception_Occurrence)
-   is
-      Prefix             : constant String := "adjust/finalize raised ";
-      Orig_Msg           : constant String := Exception_Message (X);
-      Orig_Prefix_Length : constant Natural :=
-                             Integer'Min (Prefix'Length, Orig_Msg'Length);
-
-      Orig_Prefix : String renames
-        Orig_Msg (Orig_Msg'First .. Orig_Msg'First + Orig_Prefix_Length - 1);
-
-   begin
-      --  Message already has the proper prefix, just re-raise
-
-      if Orig_Prefix = Prefix then
-         Raise_Exception_No_Defer
-           (E       => Program_Error'Identity,
-            Message => Orig_Msg);
-
-      else
-         declare
-            New_Msg  : constant String := Prefix & Exception_Name (X);
-
-         begin
-            --  No message present, just provide our own
-
-            if Orig_Msg = "" then
-               Raise_Exception_No_Defer
-                 (E       => Program_Error'Identity,
-                  Message => New_Msg);
-
-            --  Message present, add informational prefix
-
-            else
-               Raise_Exception_No_Defer
-                 (E       => Program_Error'Identity,
-                  Message => New_Msg & ": " & Orig_Msg);
-            end if;
-         end;
-      end if;
-   end Raise_From_Controlled_Operation;
-
-   -------------------------------------------
-   -- Create_Occurrence_From_Signal_Handler --
-   -------------------------------------------
-
-   function Create_Occurrence_From_Signal_Handler
-     (E : Exception_Id;
-      M : System.Address) return EOA
-   is
-      X : constant EOA := Exception_Propagation.Allocate_Occurrence;
-
-   begin
-      Exception_Data.Set_Exception_C_Msg (X, E, M);
-
-      if not ZCX_By_Default then
-         Abort_Defer.all;
-      end if;
-
-      Complete_Occurrence (X);
-      return X;
-   end Create_Occurrence_From_Signal_Handler;
-
-   ---------------------------------------------------
-   -- Create_Machine_Occurrence_From_Signal_Handler --
-   ---------------------------------------------------
-
-   function Create_Machine_Occurrence_From_Signal_Handler
-     (E : Exception_Id;
-      M : System.Address) return System.Address
-   is
-   begin
-      return Create_Occurrence_From_Signal_Handler (E, M).Machine_Occurrence;
-   end Create_Machine_Occurrence_From_Signal_Handler;
-
-   -------------------------------
-   -- Raise_From_Signal_Handler --
-   -------------------------------
-
-   procedure Raise_From_Signal_Handler
-     (E : Exception_Id;
-      M : System.Address)
-   is
-   begin
-      Exception_Propagation.Propagate_Exception
-        (Create_Occurrence_From_Signal_Handler (E, M));
-   end Raise_From_Signal_Handler;
-
-   -------------------------
-   -- Raise_Program_Error --
-   -------------------------
-
-   procedure Raise_Program_Error
-     (File : System.Address;
-      Line : Integer)
-   is
-   begin
-      Raise_With_Location_And_Msg (Program_Error_Def'Access, File, Line);
-   end Raise_Program_Error;
-
-   -----------------------------
-   -- Raise_Program_Error_Msg --
-   -----------------------------
-
-   procedure Raise_Program_Error_Msg
-     (File : System.Address;
-      Line : Integer;
-      Msg  : System.Address)
-   is
-   begin
-      Raise_With_Location_And_Msg
-        (Program_Error_Def'Access, File, Line, M => Msg);
-   end Raise_Program_Error_Msg;
-
-   -------------------------
-   -- Raise_Storage_Error --
-   -------------------------
-
-   procedure Raise_Storage_Error
-     (File : System.Address;
-      Line : Integer)
-   is
-   begin
-      Raise_With_Location_And_Msg (Storage_Error_Def'Access, File, Line);
-   end Raise_Storage_Error;
-
-   -----------------------------
-   -- Raise_Storage_Error_Msg --
-   -----------------------------
-
-   procedure Raise_Storage_Error_Msg
-     (File : System.Address;
-      Line : Integer;
-      Msg  : System.Address)
-   is
-   begin
-      Raise_With_Location_And_Msg
-        (Storage_Error_Def'Access, File, Line, M => Msg);
-   end Raise_Storage_Error_Msg;
-
-   ---------------------------------
-   -- Raise_With_Location_And_Msg --
-   ---------------------------------
-
-   procedure Raise_With_Location_And_Msg
-     (E : Exception_Id;
-      F : System.Address;
-      L : Integer;
-      C : Integer := 0;
-      M : System.Address := System.Null_Address)
-   is
-      X : constant EOA := Exception_Propagation.Allocate_Occurrence;
-   begin
-      Exception_Data.Set_Exception_C_Msg (X, E, F, L, C, M);
-
-      if not ZCX_By_Default then
-         Abort_Defer.all;
-      end if;
-
-      Complete_And_Propagate_Occurrence (X);
-   end Raise_With_Location_And_Msg;
-
-   --------------------
-   -- Raise_With_Msg --
-   --------------------
-
-   procedure Raise_With_Msg (E : Exception_Id) is
-      Excep : constant EOA := Exception_Propagation.Allocate_Occurrence;
-      Ex    : constant Exception_Occurrence_Access := Get_Current_Excep.all;
-   begin
-      Excep.Exception_Raised := False;
-      Excep.Id               := E;
-      Excep.Num_Tracebacks   := 0;
-      Excep.Pid              := Local_Partition_ID;
-
-      --  Copy the message from the current exception
-      --  Change the interface to be called with an occurrence ???
-
-      Excep.Msg_Length                  := Ex.Msg_Length;
-      Excep.Msg (1 .. Excep.Msg_Length) := Ex.Msg (1 .. Ex.Msg_Length);
-
-      --  The following is a common pattern, should be abstracted
-      --  into a procedure call ???
-
-      if not ZCX_By_Default then
-         Abort_Defer.all;
-      end if;
-
-      Complete_And_Propagate_Occurrence (Excep);
-   end Raise_With_Msg;
-
-   -----------------------------------------
-   -- Calls to Run-Time Check Subprograms --
-   -----------------------------------------
-
-   procedure Rcheck_CE_Access_Check
-     (File : System.Address; Line : Integer)
-   is
-   begin
-      Raise_Constraint_Error_Msg (File, Line, 0, Rmsg_00'Address);
-   end Rcheck_CE_Access_Check;
-
-   procedure Rcheck_CE_Null_Access_Parameter
-     (File : System.Address; Line : Integer)
-   is
-   begin
-      Raise_Constraint_Error_Msg (File, Line, 0, Rmsg_01'Address);
-   end Rcheck_CE_Null_Access_Parameter;
-
-   procedure Rcheck_CE_Discriminant_Check
-     (File : System.Address; Line : Integer)
-   is
-   begin
-      Raise_Constraint_Error_Msg (File, Line, 0, Rmsg_02'Address);
-   end Rcheck_CE_Discriminant_Check;
-
-   procedure Rcheck_CE_Divide_By_Zero
-     (File : System.Address; Line : Integer)
-   is
-   begin
-      Raise_Constraint_Error_Msg (File, Line, 0, Rmsg_03'Address);
-   end Rcheck_CE_Divide_By_Zero;
-
-   procedure Rcheck_CE_Explicit_Raise
-     (File : System.Address; Line : Integer)
-   is
-   begin
-      Raise_Constraint_Error_Msg (File, Line, 0, Rmsg_04'Address);
-   end Rcheck_CE_Explicit_Raise;
-
-   procedure Rcheck_CE_Index_Check
-     (File : System.Address; Line : Integer)
-   is
-   begin
-      Raise_Constraint_Error_Msg (File, Line, 0, Rmsg_05'Address);
-   end Rcheck_CE_Index_Check;
-
-   procedure Rcheck_CE_Invalid_Data
-     (File : System.Address; Line : Integer)
-   is
-   begin
-      Raise_Constraint_Error_Msg (File, Line, 0, Rmsg_06'Address);
-   end Rcheck_CE_Invalid_Data;
-
-   procedure Rcheck_CE_Length_Check
-     (File : System.Address; Line : Integer)
-   is
-   begin
-      Raise_Constraint_Error_Msg (File, Line, 0, Rmsg_07'Address);
-   end Rcheck_CE_Length_Check;
-
-   procedure Rcheck_CE_Null_Exception_Id
-     (File : System.Address; Line : Integer)
-   is
-   begin
-      Raise_Constraint_Error_Msg (File, Line, 0, Rmsg_08'Address);
-   end Rcheck_CE_Null_Exception_Id;
-
-   procedure Rcheck_CE_Null_Not_Allowed
-     (File : System.Address; Line : Integer)
-   is
-   begin
-      Raise_Constraint_Error_Msg (File, Line, 0, Rmsg_09'Address);
-   end Rcheck_CE_Null_Not_Allowed;
-
-   procedure Rcheck_CE_Overflow_Check
-     (File : System.Address; Line : Integer)
-   is
-   begin
-      Raise_Constraint_Error_Msg (File, Line, 0, Rmsg_10'Address);
-   end Rcheck_CE_Overflow_Check;
-
-   procedure Rcheck_CE_Partition_Check
-     (File : System.Address; Line : Integer)
-   is
-   begin
-      Raise_Constraint_Error_Msg (File, Line, 0, Rmsg_11'Address);
-   end Rcheck_CE_Partition_Check;
-
-   procedure Rcheck_CE_Range_Check
-     (File : System.Address; Line : Integer)
-   is
-   begin
-      Raise_Constraint_Error_Msg (File, Line, 0, Rmsg_12'Address);
-   end Rcheck_CE_Range_Check;
-
-   procedure Rcheck_CE_Tag_Check
-     (File : System.Address; Line : Integer)
-   is
-   begin
-      Raise_Constraint_Error_Msg (File, Line, 0, Rmsg_13'Address);
-   end Rcheck_CE_Tag_Check;
-
-   procedure Rcheck_PE_Access_Before_Elaboration
-     (File : System.Address; Line : Integer)
-   is
-   begin
-      Raise_Program_Error_Msg (File, Line, Rmsg_14'Address);
-   end Rcheck_PE_Access_Before_Elaboration;
-
-   procedure Rcheck_PE_Accessibility_Check
-     (File : System.Address; Line : Integer)
-   is
-   begin
-      Raise_Program_Error_Msg (File, Line, Rmsg_15'Address);
-   end Rcheck_PE_Accessibility_Check;
-
-   procedure Rcheck_PE_Address_Of_Intrinsic
-     (File : System.Address; Line : Integer)
-   is
-   begin
-      Raise_Program_Error_Msg (File, Line, Rmsg_16'Address);
-   end Rcheck_PE_Address_Of_Intrinsic;
-
-   procedure Rcheck_PE_Aliased_Parameters
-     (File : System.Address; Line : Integer)
-   is
-   begin
-      Raise_Program_Error_Msg (File, Line, Rmsg_17'Address);
-   end Rcheck_PE_Aliased_Parameters;
-
-   procedure Rcheck_PE_All_Guards_Closed
-     (File : System.Address; Line : Integer)
-   is
-   begin
-      Raise_Program_Error_Msg (File, Line, Rmsg_18'Address);
-   end Rcheck_PE_All_Guards_Closed;
-
-   procedure Rcheck_PE_Bad_Predicated_Generic_Type
-     (File : System.Address; Line : Integer)
-   is
-   begin
-      Raise_Program_Error_Msg (File, Line, Rmsg_19'Address);
-   end Rcheck_PE_Bad_Predicated_Generic_Type;
-
-   procedure Rcheck_PE_Current_Task_In_Entry_Body
-     (File : System.Address; Line : Integer)
-   is
-   begin
-      Raise_Program_Error_Msg (File, Line, Rmsg_20'Address);
-   end Rcheck_PE_Current_Task_In_Entry_Body;
-
-   procedure Rcheck_PE_Duplicated_Entry_Address
-     (File : System.Address; Line : Integer)
-   is
-   begin
-      Raise_Program_Error_Msg (File, Line, Rmsg_21'Address);
-   end Rcheck_PE_Duplicated_Entry_Address;
-
-   procedure Rcheck_PE_Explicit_Raise
-     (File : System.Address; Line : Integer)
-   is
-   begin
-      Raise_Program_Error_Msg (File, Line, Rmsg_22'Address);
-   end Rcheck_PE_Explicit_Raise;
-
-   procedure Rcheck_PE_Implicit_Return
-     (File : System.Address; Line : Integer)
-   is
-   begin
-      Raise_Program_Error_Msg (File, Line, Rmsg_24'Address);
-   end Rcheck_PE_Implicit_Return;
-
-   procedure Rcheck_PE_Misaligned_Address_Value
-     (File : System.Address; Line : Integer)
-   is
-   begin
-      Raise_Program_Error_Msg (File, Line, Rmsg_25'Address);
-   end Rcheck_PE_Misaligned_Address_Value;
-
-   procedure Rcheck_PE_Missing_Return
-     (File : System.Address; Line : Integer)
-   is
-   begin
-      Raise_Program_Error_Msg (File, Line, Rmsg_26'Address);
-   end Rcheck_PE_Missing_Return;
-
-   procedure Rcheck_PE_Non_Transportable_Actual
-     (File : System.Address; Line : Integer)
-   is
-   begin
-      Raise_Program_Error_Msg (File, Line, Rmsg_31'Address);
-   end Rcheck_PE_Non_Transportable_Actual;
-
-   procedure Rcheck_PE_Overlaid_Controlled_Object
-     (File : System.Address; Line : Integer)
-   is
-   begin
-      Raise_Program_Error_Msg (File, Line, Rmsg_27'Address);
-   end Rcheck_PE_Overlaid_Controlled_Object;
-
-   procedure Rcheck_PE_Potentially_Blocking_Operation
-     (File : System.Address; Line : Integer)
-   is
-   begin
-      Raise_Program_Error_Msg (File, Line, Rmsg_28'Address);
-   end Rcheck_PE_Potentially_Blocking_Operation;
-
-   procedure Rcheck_PE_Stream_Operation_Not_Allowed
-     (File : System.Address; Line : Integer)
-   is
-   begin
-      Raise_Program_Error_Msg (File, Line, Rmsg_36'Address);
-   end Rcheck_PE_Stream_Operation_Not_Allowed;
-
-   procedure Rcheck_PE_Stubbed_Subprogram_Called
-     (File : System.Address; Line : Integer)
-   is
-   begin
-      Raise_Program_Error_Msg (File, Line, Rmsg_29'Address);
-   end Rcheck_PE_Stubbed_Subprogram_Called;
-
-   procedure Rcheck_PE_Unchecked_Union_Restriction
-     (File : System.Address; Line : Integer)
-   is
-   begin
-      Raise_Program_Error_Msg (File, Line, Rmsg_30'Address);
-   end Rcheck_PE_Unchecked_Union_Restriction;
-
-   procedure Rcheck_SE_Empty_Storage_Pool
-     (File : System.Address; Line : Integer)
-   is
-   begin
-      Raise_Storage_Error_Msg (File, Line, Rmsg_32'Address);
-   end Rcheck_SE_Empty_Storage_Pool;
-
-   procedure Rcheck_SE_Explicit_Raise
-     (File : System.Address; Line : Integer)
-   is
-   begin
-      Raise_Storage_Error_Msg (File, Line, Rmsg_33'Address);
-   end Rcheck_SE_Explicit_Raise;
-
-   procedure Rcheck_SE_Infinite_Recursion
-     (File : System.Address; Line : Integer)
-   is
-   begin
-      Raise_Storage_Error_Msg (File, Line, Rmsg_34'Address);
-   end Rcheck_SE_Infinite_Recursion;
-
-   procedure Rcheck_SE_Object_Too_Large
-     (File : System.Address; Line : Integer)
-   is
-   begin
-      Raise_Storage_Error_Msg (File, Line, Rmsg_35'Address);
-   end Rcheck_SE_Object_Too_Large;
-
-   procedure Rcheck_CE_Access_Check_Ext
-     (File : System.Address; Line, Column : Integer)
-   is
-   begin
-      Raise_Constraint_Error_Msg (File, Line, Column, Rmsg_00'Address);
-   end Rcheck_CE_Access_Check_Ext;
-
-   procedure Rcheck_CE_Index_Check_Ext
-     (File : System.Address; Line, Column, Index, First, Last : Integer)
-   is
-      Msg : constant String :=
-              Rmsg_05 (Rmsg_05'First .. Rmsg_05'Last - 1) & ASCII.LF
-              & "index " & Image (Index) & " not in " & Image (First)
-              & ".." & Image (Last) & ASCII.NUL;
-   begin
-      Raise_Constraint_Error_Msg (File, Line, Column, Msg'Address);
-   end Rcheck_CE_Index_Check_Ext;
-
-   procedure Rcheck_CE_Invalid_Data_Ext
-     (File : System.Address; Line, Column, Index, First, Last : Integer)
-   is
-      Msg : constant String :=
-              Rmsg_06 (Rmsg_06'First .. Rmsg_06'Last - 1) & ASCII.LF
-              & "value " & Image (Index) & " not in " & Image (First)
-              & ".." & Image (Last) & ASCII.NUL;
-   begin
-      Raise_Constraint_Error_Msg (File, Line, Column, Msg'Address);
-   end Rcheck_CE_Invalid_Data_Ext;
-
-   procedure Rcheck_CE_Range_Check_Ext
-     (File : System.Address; Line, Column, Index, First, Last : Integer)
-   is
-      Msg : constant String :=
-              Rmsg_12 (Rmsg_12'First .. Rmsg_12'Last - 1) & ASCII.LF
-              & "value " & Image (Index) & " not in " & Image (First)
-              & ".." & Image (Last) & ASCII.NUL;
-   begin
-      Raise_Constraint_Error_Msg (File, Line, Column, Msg'Address);
-   end Rcheck_CE_Range_Check_Ext;
-
-   procedure Rcheck_PE_Finalize_Raised_Exception
-     (File : System.Address; Line : Integer)
-   is
-      X : constant EOA := Exception_Propagation.Allocate_Occurrence;
-
-   begin
-      --  This is "finalize/adjust raised exception". This subprogram is always
-      --  called with abort deferred, unlike all other Rcheck_* subprograms, it
-      --  needs to call Raise_Exception_No_Defer.
-
-      --  This is consistent with Raise_From_Controlled_Operation
-
-      Exception_Data.Set_Exception_C_Msg
-        (X, Program_Error_Def'Access, File, Line, 0, Rmsg_23'Address);
-      Complete_And_Propagate_Occurrence (X);
-   end Rcheck_PE_Finalize_Raised_Exception;
-
-   -------------
-   -- Reraise --
-   -------------
-
-   procedure Reraise is
-      Excep    : constant EOA := Exception_Propagation.Allocate_Occurrence;
-      Saved_MO : constant System.Address := Excep.Machine_Occurrence;
-
-   begin
-      if not ZCX_By_Default then
-         Abort_Defer.all;
-      end if;
-
-      Save_Occurrence (Excep.all, Get_Current_Excep.all.all);
-      Excep.Machine_Occurrence := Saved_MO;
-      Complete_And_Propagate_Occurrence (Excep);
-   end Reraise;
-
-   --------------------------------------
-   -- Reraise_Library_Exception_If_Any --
-   --------------------------------------
-
-   procedure Reraise_Library_Exception_If_Any is
-      LE : Exception_Occurrence;
-
-   begin
-      if Library_Exception_Set then
-         LE := Library_Exception;
-
-         if LE.Id = Null_Id then
-            Raise_Exception_No_Defer
-              (E       => Program_Error'Identity,
-               Message => "finalize/adjust raised exception");
-         else
-            Raise_From_Controlled_Operation (LE);
-         end if;
-      end if;
-   end Reraise_Library_Exception_If_Any;
-
-   ------------------------
-   -- Reraise_Occurrence --
-   ------------------------
-
-   procedure Reraise_Occurrence (X : Exception_Occurrence) is
-   begin
-      if X.Id = null then
-         return;
-      else
-         Reraise_Occurrence_Always (X);
-      end if;
-   end Reraise_Occurrence;
-
-   -------------------------------
-   -- Reraise_Occurrence_Always --
-   -------------------------------
-
-   procedure Reraise_Occurrence_Always (X : Exception_Occurrence) is
-   begin
-      if not ZCX_By_Default then
-         Abort_Defer.all;
-      end if;
-
-      Reraise_Occurrence_No_Defer (X);
-   end Reraise_Occurrence_Always;
-
-   ---------------------------------
-   -- Reraise_Occurrence_No_Defer --
-   ---------------------------------
-
-   procedure Reraise_Occurrence_No_Defer (X : Exception_Occurrence) is
-      Excep    : constant EOA := Exception_Propagation.Allocate_Occurrence;
-      Saved_MO : constant System.Address := Excep.Machine_Occurrence;
-   begin
-      Save_Occurrence (Excep.all, X);
-      Excep.Machine_Occurrence := Saved_MO;
-      Complete_And_Propagate_Occurrence (Excep);
-   end Reraise_Occurrence_No_Defer;
-
-   ---------------------
-   -- Save_Occurrence --
-   ---------------------
-
-   procedure Save_Occurrence
-     (Target : out Exception_Occurrence;
-      Source : Exception_Occurrence)
-   is
-   begin
-      --  As the machine occurrence might be a data that must be finalized
-      --  (outside any Ada mechanism), do not copy it
-
-      Target.Id                 := Source.Id;
-      Target.Machine_Occurrence := System.Null_Address;
-      Target.Msg_Length         := Source.Msg_Length;
-      Target.Num_Tracebacks     := Source.Num_Tracebacks;
-      Target.Pid                := Source.Pid;
-
-      Target.Msg (1 .. Target.Msg_Length) :=
-        Source.Msg (1 .. Target.Msg_Length);
-
-      Target.Tracebacks (1 .. Target.Num_Tracebacks) :=
-        Source.Tracebacks (1 .. Target.Num_Tracebacks);
-   end Save_Occurrence;
-
-   function Save_Occurrence (Source : Exception_Occurrence) return EOA is
-      Target : constant EOA := new Exception_Occurrence;
-   begin
-      Save_Occurrence (Target.all, Source);
-      return Target;
-   end Save_Occurrence;
-
-   -------------------
-   -- String_To_EId --
-   -------------------
-
-   function String_To_EId (S : String) return Exception_Id
-     renames Stream_Attributes.String_To_EId;
-
-   ------------------
-   -- String_To_EO --
-   ------------------
-
-   function String_To_EO (S : String) return Exception_Occurrence
-     renames Stream_Attributes.String_To_EO;
-
-   ---------------
-   -- To_Stderr --
-   ---------------
-
-   procedure To_Stderr (C : Character) is
-      procedure Put_Char_Stderr (C : Character);
-      pragma Import (C, Put_Char_Stderr, "put_char_stderr");
-   begin
-      Put_Char_Stderr (C);
-   end To_Stderr;
-
-   procedure To_Stderr (S : String) is
-   begin
-      for J in S'Range loop
-         if S (J) /= ASCII.CR then
-            To_Stderr (S (J));
-         end if;
-      end loop;
-   end To_Stderr;
-
-   -------------------------
-   -- Transfer_Occurrence --
-   -------------------------
-
-   procedure Transfer_Occurrence
-     (Target : Exception_Occurrence_Access;
-      Source : Exception_Occurrence)
-   is
-   begin
-      Save_Occurrence (Target.all, Source);
-   end Transfer_Occurrence;
-
-   ------------------------
-   -- Triggered_By_Abort --
-   ------------------------
-
-   function Triggered_By_Abort return Boolean is
-      Ex : constant Exception_Occurrence_Access := Get_Current_Excep.all;
-   begin
-      return Ex /= null
-        and then Exception_Identity (Ex.all) = Standard'Abort_Signal'Identity;
-   end Triggered_By_Abort;
-
-   -------------------------
-   -- Wide_Exception_Name --
-   -------------------------
-
-   WC_Encoding : Character;
-   pragma Import (C, WC_Encoding, "__gl_wc_encoding");
-   --  Encoding method for source, as exported by binder
-
-   function Wide_Exception_Name
-     (Id : Exception_Id) return Wide_String
-   is
-      S : constant String := Exception_Name (Id);
-      W : Wide_String (1 .. S'Length);
-      L : Natural;
-   begin
-      String_To_Wide_String
-        (S, W, L, Get_WC_Encoding_Method (WC_Encoding));
-      return W (1 .. L);
-   end Wide_Exception_Name;
-
-   function Wide_Exception_Name
-     (X : Exception_Occurrence) return Wide_String
-   is
-      S : constant String := Exception_Name (X);
-      W : Wide_String (1 .. S'Length);
-      L : Natural;
-   begin
-      String_To_Wide_String
-        (S, W, L, Get_WC_Encoding_Method (WC_Encoding));
-      return W (1 .. L);
-   end Wide_Exception_Name;
-
-   ----------------------------
-   -- Wide_Wide_Exception_Name --
-   -----------------------------
-
-   function Wide_Wide_Exception_Name
-     (Id : Exception_Id) return Wide_Wide_String
-   is
-      S : constant String := Exception_Name (Id);
-      W : Wide_Wide_String (1 .. S'Length);
-      L : Natural;
-   begin
-      String_To_Wide_Wide_String
-        (S, W, L, Get_WC_Encoding_Method (WC_Encoding));
-      return W (1 .. L);
-   end Wide_Wide_Exception_Name;
-
-   function Wide_Wide_Exception_Name
-     (X : Exception_Occurrence) return Wide_Wide_String
-   is
-      S : constant String := Exception_Name (X);
-      W : Wide_Wide_String (1 .. S'Length);
-      L : Natural;
-   begin
-      String_To_Wide_Wide_String
-        (S, W, L, Get_WC_Encoding_Method (WC_Encoding));
-      return W (1 .. L);
-   end Wide_Wide_Exception_Name;
-
-   --------------------------
-   -- Code_Address_For_ZZZ --
-   --------------------------
-
-   --  This function gives us the end of the PC range for addresses
-   --  within the exception unit itself. We hope that gigi/gcc keeps all the
-   --  procedures in their original order.
-
-   function Code_Address_For_ZZZ return System.Address is
-   begin
-      <<Start_Of_ZZZ>>
-      return Start_Of_ZZZ'Address;
-   end Code_Address_For_ZZZ;
-
-end Ada.Exceptions;
Index: raise.c
===================================================================
--- raise.c	(revision 247293)
+++ raise.c	(working copy)
@@ -6,7 +6,7 @@
  *                                                                          *
  *                          C Implementation File                           *
  *                                                                          *
- *             Copyright (C) 1992-2012, Free Software Foundation, Inc.      *
+ *             Copyright (C) 1992-2017, Free Software Foundation, Inc.      *
  *                                                                          *
  * 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- *
@@ -47,20 +47,6 @@
 extern "C" {
 #endif
 
-/*  Wrapper to builtin_longjmp.  This is for the compiler eh only, as the sjlj
-    runtime library interfaces directly to the intrinsic.  We can't yet do
-    this for the compiler itself, because this capability relies on changes
-    made in April 2008 and we need to preserve the possibility to bootstrap
-    with an older base version.  */
-
-#if defined (IN_GCC) && !defined (IN_RTS)
-void
-_gnat_builtin_longjmp (void *ptr, int flag ATTRIBUTE_UNUSED)
-{
-   __builtin_longjmp (ptr, 1);
-}
-#endif
-
 /* When an exception is raised for which no handler exists, the procedure
    Ada.Exceptions.Unhandled_Exception is called, which performs the call to
    adafinal to complete finalization, and then prints out the error messages
@@ -84,6 +70,71 @@
   __gnat_os_exit (1);
 }
 
+#ifndef IN_RTS
+int
+__gnat_backtrace (void **array ATTRIBUTE_UNUSED,
+                  int size ATTRIBUTE_UNUSED,
+                  void *exclude_min ATTRIBUTE_UNUSED,
+                  void *exclude_max ATTRIBUTE_UNUSED,
+                  int skip_frames ATTRIBUTE_UNUSED)
+{
+  return 0;
+}
+
+void
+__gnat_eh_personality (void)
+{
+  abort ();
+}
+
+void
+__gnat_rcheck_04 (void)
+{
+  abort ();
+}
+
+void
+__gnat_rcheck_10 (void)
+{
+  abort ();
+}
+
+void
+__gnat_rcheck_19 (void)
+{
+  abort ();
+}
+
+void
+__gnat_rcheck_20 (void)
+{
+  abort ();
+}
+
+void
+__gnat_rcheck_21 (void)
+{
+  abort ();
+}
+
+void
+__gnat_rcheck_30 (void)
+{
+  abort ();
+}
+
+void
+__gnat_rcheck_31 (void)
+{
+  abort ();
+}
+
+void
+__gnat_rcheck_32 (void)
+{
+  abort ();
+}
+#endif
 #ifdef __cplusplus
 }
 #endif
Index: raise-gcc.c
===================================================================
--- raise-gcc.c	(revision 247293)
+++ raise-gcc.c	(working copy)
@@ -6,7 +6,7 @@
  *                                                                          *
  *                          C Implementation File                           *
  *                                                                          *
- *             Copyright (C) 1992-2016, Free Software Foundation, Inc.      *
+ *             Copyright (C) 1992-2017, Free Software Foundation, Inc.      *
  *                                                                          *
  * 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- *
@@ -32,10 +32,6 @@
 /* Code related to the integration of the GCC mechanism for exception
    handling.  */
 
-#ifndef IN_RTS
-#error "RTS unit only"
-#endif
-
 #ifndef CERT
 #include "tconfig.h"
 #include "tsystem.h"
@@ -45,9 +41,14 @@
 #endif
 
 #include <stdarg.h>
+
+#ifdef __cplusplus
+# include <cstdlib>
+#else
 typedef char bool;
 # define true 1
 # define false 0
+#endif
 
 #include "raise.h"
 
@@ -72,6 +73,10 @@
 
 #include "unwind.h"
 
+#ifdef __cplusplus
+extern "C" {
+#endif
+
 typedef struct _Unwind_Context _Unwind_Context;
 typedef struct _Unwind_Exception _Unwind_Exception;
 
@@ -79,7 +84,7 @@
 __gnat_Unwind_RaiseException (_Unwind_Exception *);
 
 _Unwind_Reason_Code
-__gnat_Unwind_ForcedUnwind (_Unwind_Exception *, void *, void *);
+__gnat_Unwind_ForcedUnwind (_Unwind_Exception *, _Unwind_Stop_Fn, void *);
 
 extern struct Exception_Occurrence *__gnat_setup_current_excep
  (_Unwind_Exception *);
@@ -209,7 +214,7 @@
 }
 
 static void ATTRIBUTE_PRINTF_2
-db (int db_code, char * msg_format, ...)
+db (int db_code, const char * msg_format, ...)
 {
   if (db_accepted_codes () & db_code)
     {
@@ -816,8 +821,8 @@
 
       db (DB_CSITE,
 	  "c_site @ %p (+%p), len = %p, lpad @ %p (+%p)\n",
-	  (void *)region->base + cs_start, (void *)cs_start, (void *)cs_len,
-	  (void *)region->lp_base + cs_lp, (void *)cs_lp);
+	  (char *)region->base + cs_start, (void *)cs_start, (void *)cs_len,
+	  (char *)region->lp_base + cs_lp, (void *)cs_lp);
 
       /* The table is sorted, so if we've passed the IP, stop.  */
       if (ip < region->base + cs_start)
@@ -1399,7 +1404,7 @@
 
 _Unwind_Reason_Code
 __gnat_Unwind_ForcedUnwind (_Unwind_Exception *e ATTRIBUTE_UNUSED,
-			    void *handler ATTRIBUTE_UNUSED,
+			    _Unwind_Stop_Fn handler ATTRIBUTE_UNUSED,
 			    void *argument ATTRIBUTE_UNUSED)
 {
 #ifdef __USING_SJLJ_EXCEPTIONS__
@@ -1609,3 +1614,7 @@
 
 const int __gnat_unwind_exception_size = sizeof (_Unwind_Exception);
 #endif
+
+#ifdef __cplusplus
+}
+#endif
Index: system.ads
===================================================================
--- system.ads	(revision 247293)
+++ system.ads	(working copy)
@@ -7,7 +7,7 @@
 --                                 S p e c                                  --
 --                            (Compiler Version)                            --
 --                                                                          --
---          Copyright (C) 1992-2015, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2017, Free Software Foundation, Inc.         --
 --                                                                          --
 -- This specification is derived from the Ada Reference Manual for use with --
 -- GNAT. The copyright notice above, and the license provisions that follow --
@@ -163,8 +163,8 @@
    Always_Compatible_Rep     : constant Boolean := True;
    Suppress_Standard_Library : constant Boolean := False;
    Use_Ada_Main_Program_Name : constant Boolean := False;
-   Frontend_Exceptions       : constant Boolean := True;
-   ZCX_By_Default            : constant Boolean := False;
+   Frontend_Exceptions       : constant Boolean := False;
+   ZCX_By_Default            : constant Boolean := True;
 
    --  Obsolete entries, to be removed eventually (bootstrap issues)
 
@@ -173,6 +173,6 @@
    Long_Shifts_Inlined       : constant Boolean := True;
    Functions_Return_By_DSP   : constant Boolean := False;
    Support_64_Bit_Divides    : constant Boolean := True;
-   GCC_ZCX_Support           : constant Boolean := False;
+   GCC_ZCX_Support           : constant Boolean := True;
 
 end System;
Index: gcc-interface/Makefile.in
===================================================================
--- gcc-interface/Makefile.in	(revision 247293)
+++ gcc-interface/Makefile.in	(working copy)
@@ -2427,32 +2427,20 @@
 
 ifeq ($(EH_MECHANISM),-gcc)
   LIBGNAT_TARGET_PAIRS += \
-    a-exexpr.adb<a-exexpr-gcc.adb \
-    s-excmac.ads<s-excmac-gcc.ads
+    s-excmac.ads<s-excmac-gcc.ads \
+    s-excmac.adb<s-excmac-gcc.adb
   EXTRA_LIBGNAT_OBJS+=raise-gcc.o
   EXTRA_GNATRTL_NONTASKING_OBJS+=g-cppexc.o s-excmac.o
 endif
 
 ifeq ($(EH_MECHANISM),-arm)
   LIBGNAT_TARGET_PAIRS += \
-    a-exexpr.adb<a-exexpr-gcc.adb \
-    s-excmac.ads<s-excmac-arm.ads
+    s-excmac.ads<s-excmac-arm.ads \
+    s-excmac.adb<s-excmac-arm.adb
   EXTRA_LIBGNAT_OBJS+=raise-gcc.o
   EXTRA_GNATRTL_NONTASKING_OBJS+=g-cppexc.o s-excmac.o
 endif
 
-# Use the Ada 2005 version of Ada.Exceptions by default, unless specified
-# explicitly already. The base files (a-except.ad?) are used only for building
-# the compiler and other basic tools.
-# These base versions lack Ada 2005 additions which would cause bootstrap
-# problems if included in the compiler and other basic tools.
-
-ifeq ($(filter a-except%,$(LIBGNAT_TARGET_PAIRS)),)
-  LIBGNAT_TARGET_PAIRS += \
-    a-except.ads<a-except-2005.ads \
-    a-except.adb<a-except-2005.adb
-endif
-
 # Configuration of host tools
 
 # Under linux, host tools need to be linked with -ldl
Index: gcc-interface/Make-lang.in
===================================================================
--- gcc-interface/Make-lang.in	(revision 247293)
+++ gcc-interface/Make-lang.in	(working copy)
@@ -99,6 +99,8 @@
 ada-warn = $(ADA_CFLAGS) $(filter-out -pedantic, $(STRICT_WARN))
 # Unresolved warnings in specific files.
 ada/adaint.o-warn = -Wno-error
+# For unwind-pe.h
+CFLAGS-ada/raise-gcc.o += -I$(srcdir)/../libgcc -Iinclude
 
 ada/%.o: ada/gcc-interface/%.c
 	$(COMPILE) $<
@@ -223,6 +225,7 @@
 # Object files for gnat1 from C sources.
 GNAT1_C_OBJS = ada/adadecode.o ada/adaint.o ada/argv.o ada/cio.o \
  ada/cstreams.o ada/env.o ada/init.o ada/initialize.o ada/raise.o \
+ ada/raise-gcc.o \
  ada/seh_init.o ada/targext.o ada/cuintp.o ada/decl.o ada/rtfinal.o \
  ada/rtinit.o ada/misc.o ada/utils.o ada/utils2.o ada/trans.o ada/targtyps.o
 
@@ -232,6 +235,7 @@
  ada/a-chlat1.o	\
  ada/a-elchha.o	\
  ada/a-except.o	\
+ ada/a-exctra.o \
  ada/a-ioexce.o	\
  ada/ada.o	\
  ada/spark_xrefs.o	\
@@ -334,6 +338,7 @@
  ada/rident.o	\
  ada/rtsfind.o	\
  ada/s-addope.o	\
+ ada/s-addima.o \
  ada/s-assert.o	\
  ada/s-bitops.o	\
  ada/s-carun8.o	\
@@ -351,9 +356,11 @@
  ada/s-excdeb.o	\
  ada/s-except.o	\
  ada/s-exctab.o	\
+ ada/s-excmac.o \
  ada/s-htable.o	\
  ada/s-imenne.o	\
  ada/s-imgenu.o	\
+ ada/s-imgint.o \
  ada/s-mastop.o	\
  ada/s-memory.o	\
  ada/s-os_lib.o	\
@@ -372,7 +379,9 @@
  ada/s-strhas.o	\
  ada/s-string.o	\
  ada/s-strops.o	\
+ ada/s-traceb.o \
  ada/s-traent.o	\
+ ada/s-trasym.o \
  ada/s-unstyp.o	\
  ada/s-utf_32.o	\
  ada/s-valint.o	\
@@ -381,6 +390,7 @@
  ada/s-wchcnv.o	\
  ada/s-wchcon.o	\
  ada/s-wchjis.o	\
+ ada/s-wchstw.o \
  ada/scans.o	\
  ada/scil_ll.o	\
  ada/scn.o	\
@@ -514,6 +524,7 @@
  ada/osint.o      \
  ada/output.o     \
  ada/raise.o      \
+ ada/raise-gcc.o  \
  ada/restrict.o   \
  ada/rident.o     \
  ada/rtfinal.o    \
@@ -534,10 +545,12 @@
  ada/s-crtl.o     \
  ada/s-excdeb.o   \
  ada/s-except.o   \
+ ada/s-excmac.o   \
  ada/s-exctab.o   \
  ada/s-htable.o   \
  ada/s-imenne.o   \
  ada/s-imgenu.o   \
+ ada/s-imgint.o   \
  ada/s-mastop.o   \
  ada/s-memory.o   \
  ada/s-os_lib.o   \
@@ -555,11 +568,13 @@
  ada/s-string.o   \
  ada/s-strops.o   \
  ada/s-traent.o   \
+ ada/s-traceb.o   \
  ada/s-unstyp.o   \
  ada/s-utf_32.o   \
  ada/s-wchcnv.o   \
  ada/s-wchcon.o   \
  ada/s-wchjis.o   \
+ ada/s-wchstw.o   \
  ada/scans.o      \
  ada/scil_ll.o    \
  ada/scng.o       \
@@ -594,6 +609,21 @@
 # List of target dependent sources, overridden below as necessary
 TARGET_ADA_SRCS =
 
+# Select the right s-excmac according to exception layout (Itanium or arm)
+host_cpu=$(word 1, $(subst -, ,$(host)))
+EH_MECHANISM=-gcc
+ifeq ($(strip $(filter-out arm%,$(host_cpu))),)
+EH_MECHANISM=-arm
+endif
+
+ada/s-excmac.o: ada/s-excmac.ads ada/s-excmac.adb
+
+ada/s-excmac.ads: $(srcdir)/ada/s-excmac$(EH_MECHANISM).ads
+	$(CP) $< $@
+
+ada/s-excmac.adb: $(srcdir)/ada/s-excmac$(EH_MECHANISM).adb
+	$(CP) $< $@
+
 # Needs to be built with CC=gcc
 # Since the RTL should be built with the latest compiler, remove the
 #  stamp target in the parent directory whenever gnat1 is rebuilt
@@ -976,12 +1006,12 @@
 
 # Special flags - see gcc-interface/Makefile.in for the template.
 
-ada/a-except.o  : ada/a-except.adb ada/a-except.ads
+ada/a-except.o : ada/a-except.adb ada/a-except.ads ada/s-excmac.ads ada/s-excmac.adb
 	$(CC) -c $(ALL_ADAFLAGS) $(FORCE_DEBUG_ADAFLAGS) -O1 -fno-inline \
 	 $(ADA_INCLUDES) $< $(OUTPUT_OPTION)
 	@$(ADA_DEPS)
 
-ada/s-excdeb.o  : ada/s-excdeb.adb ada/s-excdeb.ads
+ada/s-excdeb.o : ada/s-excdeb.adb ada/s-excdeb.ads
 	$(CC) -c $(ALL_ADAFLAGS) $(FORCE_DEBUG_ADAFLAGS) -O0 \
 	 $(ADA_INCLUDES) $< $(OUTPUT_OPTION)
 	@$(ADA_DEPS)
