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 <ging...@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.
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;
