s-mastop-tru64.adb (Pop_Frame): Use exc_lookup_function_entry to fetch a…

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

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);
 
@@ -519,6 +520,13 @@ __gnat_get_code_loc (struct sigcontext *context)
 }
 
 void
+__gnat_set_code_loc (struct sigcontext *context, char *pc)
+{
+  context->sc_pc = (long) pc;
+}
+
+
+void
 __gnat_enter_handler (struct sigcontext *context, char *pc)
 {
   context->sc_pc = (long) pc;

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;