diff --git a/gcc/ada/init.c b/gcc/ada/init.c index ef6b21049f2..fb08c8bff15 100644 --- a/gcc/ada/init.c +++ b/gcc/ada/init.c @@ -404,6 +404,7 @@ __gnat_install_handler (void) static void __gnat_error_handler (int, siginfo_t *, struct sigcontext *); extern char *__gnat_get_code_loc (struct sigcontext *); +extern void __gnat_set_code_loc (struct sigcontext *, char *); extern void __gnat_enter_handler (struct sigcontext *, char *); extern size_t __gnat_machine_state_length (void); @@ -518,6 +519,13 @@ __gnat_get_code_loc (struct sigcontext *context) return (char *) context->sc_pc; } +void +__gnat_set_code_loc (struct sigcontext *context, char *pc) +{ + context->sc_pc = (long) pc; +} + + void __gnat_enter_handler (struct sigcontext *context, char *pc) { diff --git a/gcc/ada/s-mastop-tru64.adb b/gcc/ada/s-mastop-tru64.adb index 8db3e0e95d6..c788817272c 100644 --- a/gcc/ada/s-mastop-tru64.adb +++ b/gcc/ada/s-mastop-tru64.adb @@ -7,7 +7,7 @@ -- B o d y -- -- (Version for Alpha/Dec Unix) -- -- -- --- Copyright (C) 1999-2003 Ada Core Technologies, Inc. -- +-- Copyright (C) 1999-2005 Ada Core Technologies, 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- -- @@ -141,13 +141,32 @@ package body System.Machine_State_Operations is is pragma Warnings (Off, Info); - procedure exc_virtual_unwind - (Fcn : System.Address; - M : Machine_State); + procedure exc_virtual_unwind (Fcn : System.Address; M : Machine_State); pragma Import (C, exc_virtual_unwind, "exc_virtual_unwind"); + function exc_lookup_function (Loc : Code_Loc) return System.Address; + pragma Import (C, exc_lookup_function, "exc_lookup_function_entry"); + + procedure c_set_code_loc (M : Machine_State; Loc : Code_Loc); + pragma Import (C, c_set_code_loc, "__gnat_set_code_loc"); + + -- Look for a code-range descriptor table containing the PC of the + -- specified machine state. If we don't find any, attempting to unwind + -- further would fail so we set the machine state's code location to a + -- value indicating that the top of the call chain is reached. This + -- happens when the function at the address pointed to by PC has not + -- been registered with the unwinding machinery, as with the __istart + -- functions generated by the linker in presence of initialization + -- routines for example. + + Prf : constant System.Address := exc_lookup_function (Get_Code_Loc (M)); + begin - exc_virtual_unwind (System.Null_Address, M); + if (Prf = System.Null_Address) then + c_set_code_loc (M, 0); + else + exc_virtual_unwind (Prf, M); + end if; end Pop_Frame; ----------------------- @@ -157,7 +176,6 @@ package body System.Machine_State_Operations is procedure Set_Machine_State (M : Machine_State) is procedure c_capture_context (M : Machine_State); pragma Import (C, c_capture_context, "exc_capture_context"); - begin c_capture_context (M); Pop_Frame (M, System.Null_Address); @@ -173,7 +191,6 @@ package body System.Machine_State_Operations is is pragma Warnings (Off, M); pragma Warnings (Off, Context); - begin null; end Set_Signal_Machine_State;