diff mbox

[Ada] Initialize choice exception parameter in gigi

Message ID 20131014133928.GA5527@adacore.com
State New
Headers show

Commit Message

Arnaud Charlet Oct. 14, 2013, 1:39 p.m. UTC
The code to initialize the exception parameter is now emitted in gigi rather
than in the front-end. This applies only in the ZCX case. This is slightly
more efficient and will future implementation of intefacing with C++
exceptions.
No functional change.

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

2013-10-14  Tristan Gingold  <gingold@adacore.com>

	* a-exexpr-gcc.adb (Set_Exception_Parameter): New procedure.
	(Set_Foreign_Occurrence): New procedure, extracted from
	Setup_Current_Excep.
	* exp_ch11.adb (Expand_Exception_Handlers): Do not expand choice
	parameter in case of zcx.
	* sem_ch11.adb (Analyze_Exception_Handlers): Need debug info
	for the choice parameter.
	* raise-gcc.c: Add comments.
diff mbox

Patch

Index: a-exexpr-gcc.adb
===================================================================
--- a-exexpr-gcc.adb	(revision 203538)
+++ a-exexpr-gcc.adb	(working copy)
@@ -199,13 +199,14 @@ 
      (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
+   --  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
+   --  Write Get_Current_Excep.all from GCC_Exception. Called by the
+   --  personnality routine.
 
    procedure Unhandled_Except_Handler
      (GCC_Exception : not null GCC_Exception_Access);
@@ -243,6 +244,17 @@ 
       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 initialize the exception parameter
+
+   procedure Set_Foreign_Occurrence (Excep : EOA; Mo : System.Address);
+   --  Utility routine to initialize occurrence Excep for a foreign exception
+   --  whose machine occurrence is Mo.
+
    --  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.
@@ -338,6 +350,20 @@ 
       Free (Copy);
    end GNAT_GCC_Exception_Cleanup;
 
+   ----------------------------
+   -- Set_Foreign_Occurrence --
+   ----------------------------
+
+   procedure Set_Foreign_Occurrence (Excep : EOA; Mo : System.Address) is
+   begin
+      Excep.Id := Foreign_Exception'Access;
+      Excep.Machine_Occurrence := Mo;
+      Excep.Msg_Length := 0;
+      Excep.Exception_Raised := True;
+      Excep.Pid := Local_Partition_ID;
+      Excep.Num_Tracebacks := 0;
+   end Set_Foreign_Occurrence;
+
    -------------------------
    -- Setup_Current_Excep --
    -------------------------
@@ -366,12 +392,7 @@ 
 
          --  A default one
 
-         Excep.Id := Foreign_Exception'Access;
-         Excep.Machine_Occurrence := GCC_Exception.all'Address;
-         Excep.Msg_Length := 0;
-         Excep.Exception_Raised := True;
-         Excep.Pid := Local_Partition_ID;
-         Excep.Num_Tracebacks := 0;
+         Set_Foreign_Occurrence (Excep, GCC_Exception.all'Address);
 
          return Excep;
       end if;
@@ -465,6 +486,34 @@ 
       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 --
    ------------------------------
Index: exp_ch11.adb
===================================================================
--- exp_ch11.adb	(revision 203539)
+++ exp_ch11.adb	(working copy)
@@ -1025,7 +1025,12 @@ 
                --        ...
                --     end;
 
-               if Present (Choice_Parameter (Handler)) then
+               --  This expansion is not performed when using GCC ZCX. Gigi
+               --  will insert a call to intialize the choice parameter.
+
+               if Present (Choice_Parameter (Handler))
+                 and then Exception_Mechanism /= Back_End_Exceptions
+               then
                   declare
                      Cparm : constant Entity_Id  := Choice_Parameter (Handler);
                      Cloc  : constant Source_Ptr := Sloc (Cparm);
Index: sem_ch11.adb
===================================================================
--- sem_ch11.adb	(revision 203521)
+++ sem_ch11.adb	(working copy)
@@ -199,6 +199,7 @@ 
 
                if Comes_From_Source (Choice) then
                   Check_Restriction (No_Exception_Propagation, Choice);
+                  Set_Debug_Info_Needed (Choice);
                end if;
 
                if No (H_Scope) then
Index: raise-gcc.c
===================================================================
--- raise-gcc.c	(revision 203549)
+++ raise-gcc.c	(working copy)
@@ -1217,7 +1217,9 @@ 
   setup_to_install
     (uw_context, uw_exception, action.landing_pad, action.ttype_filter);
 
-  /* Write current exception, so that it can be retrieved from Ada.  */
+  /* Write current exception, so that it can be retrieved from Ada.  It was
+     already done during phase 1 (just above), but in between, one or several
+     exceptions may have been raised (in cleanup handlers).  */
   __gnat_setup_current_excep (uw_exception);
 
   return _URC_INSTALL_CONTEXT;