[Ada] Explicitly pass exception occurrence to notifiers

Arnaud Charlet charlet@adacore.com
Mon Jul 16 12:56:00 GMT 2012


This is an internal cleanup and preliminary to removal of useless ada
occurrence copy.
No functional change.

Tested on x86_64-pc-linux-gnu, committed on trunk

2012-07-16  Tristan Gingold  <gingold@adacore.com>

	* a-exexpr.adb (Propagate_Exception): Adjust call to
	Exception_Traces procedures.
	* a-exexpr-gcc.adb (Setup_Current_Excep): Now a
	function that returns an access to the Ada occurrence.
	(Propagate_GCC_Exception): Adjust calls.
	* raise.h (struct Exception_Occurrence): Declare.
	* a-exextr.adb: Remove useless pragma.	(Notify_Handled_Exception,
	Notify_Unhandled_Exception) (Unhandled_Exception_Terminate):
	Add Excep parameter.
	* a-except.adb (Notify_Handled_Exception,
	Notify_Unhandled_Exception) (Unhandled_Exception_Terminate):
	Add Excep parameter.
	(Process_Raise_Exception): Adjust calls.
	* a-except-2005.adb (Notify_Handled_Exception,
	Notify_Unhandled_Exception) (Unhandled_Exception_Terminate): Add
	Excep parameter.
	(Raise_Exception): Calls Raise_Exception_Always.
	* raise-gcc.c (__gnat_setup_current_excep,
	__gnat_notify_handled_exception)
	(__gnat_notify_unhandled_exception): Adjust declarations.
	(PERSONALITY_FUNCTION): Adjust calls.
	(__gnat_personality_seh0): Remove warning.

-------------- next part --------------
Index: a-exexpr.adb
===================================================================
--- a-exexpr.adb	(revision 189530)
+++ a-exexpr.adb	(working copy)
@@ -43,7 +43,7 @@
    pragma No_Return (builtin_longjmp);
    pragma Import (Intrinsic, builtin_longjmp, "__builtin_longjmp");
 
-   procedure Propagate_Continue (Excep : EOA);
+   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
@@ -74,14 +74,14 @@
       if Jumpbuf_Ptr /= Null_Address then
          if not Excep.Exception_Raised then
             Excep.Exception_Raised := True;
-            Exception_Traces.Notify_Handled_Exception;
+            Exception_Traces.Notify_Handled_Exception (Excep);
          end if;
 
          builtin_longjmp (Jumpbuf_Ptr, 1);
 
       else
-         Exception_Traces.Notify_Unhandled_Exception;
-         Exception_Traces.Unhandled_Exception_Terminate;
+         Exception_Traces.Notify_Unhandled_Exception (Excep);
+         Exception_Traces.Unhandled_Exception_Terminate (Excep);
       end if;
    end Propagate_Exception;
 
@@ -89,9 +89,10 @@
    -- Propagate_Continue --
    ------------------------
 
-   procedure Propagate_Continue (Excep : EOA) is
+   procedure Propagate_Continue (E : Exception_Id) is
+      pragma Unreferenced (E);
    begin
-      Propagate_Exception (Excep);
+      Propagate_Exception (Get_Current_Excep.all);
    end Propagate_Continue;
 
 end Exception_Propagation;
Index: raise.h
===================================================================
--- raise.h	(revision 189524)
+++ raise.h	(working copy)
@@ -49,6 +49,8 @@
 
 typedef struct Exception_Data *Exception_Id;
 
+struct Exception_Occurrence;
+
 extern void _gnat_builtin_longjmp	(void *, int);
 extern void __gnat_unhandled_terminate	(void);
 extern void *__gnat_malloc		(__SIZE_TYPE__);
Index: a-exexpr-gcc.adb
===================================================================
--- a-exexpr-gcc.adb	(revision 189530)
+++ a-exexpr-gcc.adb	(working copy)
@@ -202,8 +202,9 @@
    --  Called to implement raise without exception, ie reraise.  Called
    --  directly from gigi.
 
-   procedure Setup_Current_Excep
-     (GCC_Exception : not null GCC_Exception_Access);
+   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
 
@@ -342,8 +343,9 @@
    -- Setup_Current_Excep --
    -------------------------
 
-   procedure Setup_Current_Excep
+   function Setup_Current_Excep
      (GCC_Exception : not null GCC_Exception_Access)
+     return EOA
    is
       Excep : constant EOA := Get_Current_Excep.all;
 
@@ -359,6 +361,8 @@
                                 To_GNAT_GCC_Exception (GCC_Exception);
          begin
             Excep.all := GNAT_Occurrence.Occurrence;
+
+            return GNAT_Occurrence.Occurrence'Access;
          end;
       else
 
@@ -370,6 +374,8 @@
          Excep.Exception_Raised := True;
          Excep.Pid := Local_Partition_ID;
          Excep.Num_Tracebacks := 0;
+
+         return Excep;
       end if;
    end Setup_Current_Excep;
 
@@ -420,6 +426,7 @@
    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
@@ -432,8 +439,8 @@
       --  the necessary steps to enable the debugger to gain control while the
       --  stack is still intact.
 
-      Setup_Current_Excep (GCC_Exception);
-      Notify_Unhandled_Exception;
+      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
@@ -466,9 +473,10 @@
    procedure Unhandled_Except_Handler
      (GCC_Exception : not null GCC_Exception_Access)
    is
+      Excep : EOA;
    begin
-      Setup_Current_Excep (GCC_Exception);
-      Unhandled_Exception_Terminate;
+      Excep := Setup_Current_Excep (GCC_Exception);
+      Unhandled_Exception_Terminate (Excep);
    end Unhandled_Except_Handler;
 
    -------------
Index: a-exextr.adb
===================================================================
--- a-exextr.adb	(revision 189524)
+++ a-exextr.adb	(working copy)
@@ -72,17 +72,6 @@
    --  latter case because Notify_Handled_Exception may be called for an
    --  actually unhandled occurrence in the Front-End-SJLJ case.
 
-   --------------------------------
-   -- Import Run-Time C Routines --
-   --------------------------------
-
-   --  The purpose of the following pragma Import is to ensure that we
-   --  generate appropriate subprogram descriptors for all C routines in
-   --  the standard GNAT library that can raise exceptions. This ensures
-   --  that the exception propagation can properly find these routines
-
-   pragma Propagate_Exceptions;
-
    ----------------------
    -- Notify_Exception --
    ----------------------
@@ -132,18 +121,16 @@
    -- Notify_Handled_Exception --
    ------------------------------
 
-   procedure Notify_Handled_Exception is
+   procedure Notify_Handled_Exception (Excep : EOA) is
    begin
-      Notify_Exception (Get_Current_Excep.all, Is_Unhandled => False);
+      Notify_Exception (Excep, Is_Unhandled => False);
    end Notify_Handled_Exception;
 
    --------------------------------
    -- Notify_Unhandled_Exception --
    --------------------------------
 
-   procedure Notify_Unhandled_Exception is
-      Excep : constant EOA := Get_Current_Excep.all;
-
+   procedure Notify_Unhandled_Exception (Excep : EOA) is
    begin
       --  Check whether there is any termination handler to be executed for
       --  the environment task, and execute it if needed. Here we handle both
@@ -161,8 +148,8 @@
    -- Unhandled_Exception_Terminate --
    -----------------------------------
 
-   procedure Unhandled_Exception_Terminate is
-      Excep : Exception_Occurrence;
+   procedure Unhandled_Exception_Terminate (Excep : EOA) is
+      Occ : Exception_Occurrence;
       --  This occurrence will be used to display a message after finalization.
       --  It is necessary to save a copy here, or else the designated value
       --  could be overwritten if an exception is raised during finalization
@@ -172,8 +159,8 @@
       --  that there is enough room on the stack however.
 
    begin
-      Save_Occurrence (Excep, Get_Current_Excep.all.all);
-      Last_Chance_Handler (Excep);
+      Save_Occurrence (Occ, Excep.all);
+      Last_Chance_Handler (Occ);
    end Unhandled_Exception_Terminate;
 
    ------------------------------------
Index: a-except.adb
===================================================================
--- a-except.adb	(revision 189530)
+++ a-except.adb	(working copy)
@@ -189,19 +189,19 @@
       --  exported to be usable by the Ada exception handling personality
       --  routine when the GCC 3 mechanism is used.
 
-      procedure Notify_Handled_Exception;
+      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;
+      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;
+      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
@@ -895,14 +895,14 @@
       if Jumpbuf_Ptr /= Null_Address then
          if not Excep.Exception_Raised then
             Excep.Exception_Raised := True;
-            Exception_Traces.Notify_Handled_Exception;
+            Exception_Traces.Notify_Handled_Exception (Excep);
          end if;
 
          builtin_longjmp (Jumpbuf_Ptr, 1);
 
       else
-         Exception_Traces.Notify_Unhandled_Exception;
-         Exception_Traces.Unhandled_Exception_Terminate;
+         Exception_Traces.Notify_Unhandled_Exception (Excep);
+         Exception_Traces.Unhandled_Exception_Terminate (Excep);
       end if;
    end Process_Raise_Exception;
 
Index: a-except-2005.adb
===================================================================
--- a-except-2005.adb	(revision 189530)
+++ a-except-2005.adb	(working copy)
@@ -209,19 +209,19 @@
       --  exported to be usable by the Ada exception handling personality
       --  routine when the GCC 3 mechanism is used.
 
-      procedure Notify_Handled_Exception;
+      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;
+      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;
+      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
@@ -395,15 +395,16 @@
    --  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 Routines --
@@ -953,8 +954,6 @@
       Message : String := "")
    is
       EF : Exception_Id := E;
-      X : constant EOA := Exception_Propagation.Allocate_Occurrence;
-
    begin
       --  Raise CE if E = Null_ID (AI-446)
 
@@ -964,14 +963,7 @@
 
       --  Go ahead and raise appropriate exception
 
-      Exception_Data.Set_Exception_Msg (X, EF, Message);
-
-      if not ZCX_By_Default then
-         Abort_Defer.all;
-      end if;
-
-      Complete_Occurrence (X);
-      Exception_Propagation.Propagate_Exception (X);
+      Raise_Exception_Always (EF, Message);
    end Raise_Exception;
 
    ----------------------------
Index: raise-gcc.c
===================================================================
--- raise-gcc.c	(revision 189530)
+++ raise-gcc.c	(working copy)
@@ -77,7 +77,8 @@
 _Unwind_Reason_Code
 __gnat_Unwind_ForcedUnwind (_Unwind_Exception *, void *, void *);
 
-extern void __gnat_setup_current_excep (_Unwind_Exception *);
+extern struct Exception_Occurrence *__gnat_setup_current_excep
+ (_Unwind_Exception *);
 extern void __gnat_unhandled_except_handler (_Unwind_Exception *);
 
 #include "dwarf2.h"
@@ -1001,8 +1002,8 @@
 /* The following is defined from a-except.adb. Its purpose is to enable
    automatic backtraces upon exception raise, as provided through the
    GNAT.Traceback facilities.  */
-extern void __gnat_notify_handled_exception (void);
-extern void __gnat_notify_unhandled_exception (void);
+extern void __gnat_notify_handled_exception (struct Exception_Occurrence *);
+extern void __gnat_notify_unhandled_exception (struct Exception_Occurrence *);
 
 /* Below is the eh personality routine per se. We currently assume that only
    GNU-Ada exceptions are met.  */
@@ -1131,14 +1132,16 @@
 	}
       else
 	{
+	  struct Exception_Occurrence *excep;
+
 	  /* Trigger the appropriate notification routines before the second
 	     phase starts, which ensures the stack is still intact.
              First, setup the Ada occurrence.  */
-          __gnat_setup_current_excep (uw_exception);
+          excep = __gnat_setup_current_excep (uw_exception);
 	  if (action.kind == unhandler)
-	    __gnat_notify_unhandled_exception ();
+	    __gnat_notify_unhandled_exception (excep);
 	  else
-	    __gnat_notify_handled_exception ();
+	    __gnat_notify_handled_exception (excep);
 
 	  return _URC_HANDLER_FOUND;
 	}
@@ -1324,7 +1327,7 @@
 	  CONTEXT context;
 	  PRUNTIME_FUNCTION mf_func = NULL;
 	  ULONG64 mf_imagebase;
-	  ULONG64 mf_rsp;
+	  ULONG64 mf_rsp = 0;
 
 	  /* Get the context.  */
 	  RtlCaptureContext (&context);


More information about the Gcc-patches mailing list