s-mastop-tru64.adb (Pop_Frame): Use exc_lookup_function_entry to fetch a code-range descriptor associated with...

2005-07-04  Eric Botcazou  <ebotcazou@adacore.com>

	* s-mastop-tru64.adb (Pop_Frame): Use exc_lookup_function_entry to
	fetch a code-range descriptor associated with the machine state. On
	failure set the machine state's PC to 0; on success, pass the
	descriptor to exc_virtual_unwind.

	* init.c (Tru64 section): New function __gnat_set_code_loc.

From-SVN: r101572
This commit is contained in:
Eric Botcazou 2005-07-04 15:26:02 +02:00 committed by Arnaud Charlet
parent 1a79be3c00
commit 0556b70292
2 changed files with 32 additions and 7 deletions

View File

@ -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)
{

View File

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