diff options
Diffstat (limited to 'gcc/ada/libgnat/a-exexpr.adb')
| -rw-r--r-- | gcc/ada/libgnat/a-exexpr.adb | 38 |
1 files changed, 27 insertions, 11 deletions
diff --git a/gcc/ada/libgnat/a-exexpr.adb b/gcc/ada/libgnat/a-exexpr.adb index 0fe5227..f16e2a9 100644 --- a/gcc/ada/libgnat/a-exexpr.adb +++ b/gcc/ada/libgnat/a-exexpr.adb @@ -139,7 +139,8 @@ package body Exception_Propagation is function Setup_Current_Excep (GCC_Exception : not null GCC_Exception_Access; - Phase : Unwind_Action) return EOA; + Phase : Unwind_Action; + Id : Exception_Id) return EOA; pragma Export (C, Setup_Current_Excep, "__gnat_setup_current_excep"); -- Acknowledge GCC_Exception as the current exception object being -- raised, which could be an Ada or a foreign exception object. Return @@ -195,10 +196,13 @@ package body Exception_Propagation is -- Called inserted by gigi to set the exception choice parameter from the -- gcc occurrence. - procedure Set_Foreign_Occurrence (Excep : EOA; Mo : System.Address); + procedure Set_Foreign_Occurrence + (Excep : EOA; + Mo : System.Address; + Id : Exception_Id := Foreign_Exception'Access); -- 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. + -- is empty too and the exception identity is Id. -- Hooks called when entering/leaving an exception handler for a -- given occurrence. The calls are generated by gigi in @@ -354,10 +358,13 @@ package body Exception_Propagation is -- Set_Foreign_Occurrence -- ---------------------------- - procedure Set_Foreign_Occurrence (Excep : EOA; Mo : System.Address) is + procedure Set_Foreign_Occurrence + (Excep : EOA; + Mo : System.Address; + Id : Exception_Id := Foreign_Exception'Access) is begin Excep.all := ( - Id => Foreign_Exception'Access, + Id => Id, Machine_Occurrence => Mo, Msg => <>, Msg_Length => 0, @@ -373,7 +380,8 @@ package body Exception_Propagation is function Setup_Current_Excep (GCC_Exception : not null GCC_Exception_Access; - Phase : Unwind_Action) return EOA + Phase : Unwind_Action; + Id : Exception_Id) return EOA is Excep : constant EOA := Get_Current_Excep.all; @@ -408,7 +416,11 @@ package body Exception_Propagation is -- an Ada occurrence info. Set the foreign data pointer in the -- Current Exception Buffer and return the address of the latter. - Set_Foreign_Occurrence (Excep, GCC_Exception.all'Address); + if Id = null then + Set_Foreign_Occurrence (Excep, GCC_Exception.all'Address); + else + Set_Foreign_Occurrence (Excep, GCC_Exception.all'Address, Id); + end if; return Excep; end if; @@ -589,7 +601,7 @@ package body Exception_Propagation is -- our personality routine. Excep : constant EOA := - Setup_Current_Excep (GCC_Exception, Phase => 0); + Setup_Current_Excep (GCC_Exception, Phase => 0, Id => null); begin -- Perform a standard raise first. If a regular handler is found, it @@ -653,9 +665,12 @@ package body Exception_Propagation is end; else - -- A default one + -- A default one. Take the Id from the exception object + -- created by Setup_Current_Excep. + + Set_Foreign_Occurrence (Excep, GCC_Exception.all'Address, + Get_Current_Excep.all.Id); - Set_Foreign_Occurrence (Excep, GCC_Exception.all'Address); end if; end Set_Exception_Parameter; @@ -668,7 +683,8 @@ package body Exception_Propagation is is Excep : EOA; begin - Excep := Setup_Current_Excep (GCC_Exception, Phase => UA_CLEANUP_PHASE); + Excep := Setup_Current_Excep (GCC_Exception, Phase => UA_CLEANUP_PHASE, + Id => null); Unhandled_Exception_Terminate (Excep); end Unhandled_Except_Handler; |