+++ /dev/null
-------------------------------------------------------------------------------
--- --
--- GNAT COMPILER COMPONENTS --
--- --
--- S Y S T E M . T R A C E B A C K --
--- (HP/UX Version) --
--- --
--- B o d y --
--- --
--- $Revision: 1.1 $
--- --
--- Copyright (C) 1999-2001 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- --
--- ware Foundation; either version 2, or (at your option) any later ver- --
--- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
--- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
--- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License --
--- for more details. You should have received a copy of the GNU General --
--- Public License distributed with GNAT; see file COPYING. If not, write --
--- to the Free Software Foundation, 59 Temple Place - Suite 330, Boston, --
--- MA 02111-1307, USA. --
--- --
--- As a special exception, if other files instantiate generics from this --
--- unit, or you link this unit with other files to produce an executable, --
--- this unit does not by itself cause the resulting executable to be --
--- covered by the GNU General Public License. This exception does not --
--- however invalidate any other reasons why the executable file might be --
--- covered by the GNU Public License. --
--- --
--- GNAT was originally developed by the GNAT team at New York University. --
--- It is now maintained by Ada Core Technologies Inc (http://www.gnat.com). --
--- --
-------------------------------------------------------------------------------
-
-with Ada.Unchecked_Conversion;
-
-package body System.Traceback is
-
- -- This package implements the backtracing facility by way of a dedicated
- -- HP library for stack unwinding described in the "Runtime Architecture
- -- Document".
-
- pragma Linker_Options ("/usr/lib/libcl.a");
-
- -- The library basically offers services to fetch information about a
- -- "previous" frame based on information about a "current" one.
-
- type Current_Frame_Descriptor is record
- cur_fsz : Address; -- Frame size of current routine.
- cur_sp : Address; -- The current value of stack pointer.
- cur_rls : Address; -- PC-space of the caller.
- cur_rlo : Address; -- PC-offset of the caller.
- cur_dp : Address; -- Data Pointer of the current routine.
- top_rp : Address; -- Initial value of RP.
- top_mrp : Address; -- Initial value of MRP.
- top_sr0 : Address; -- Initial value of sr0.
- top_sr4 : Address; -- Initial value of sr4.
- top_r3 : Address; -- Initial value of gr3.
- cur_r19 : Address; -- GR19 value of the calling routine.
- top_r4 : Address; -- Initial value of gr4.
- dummy : Address; -- Reserved.
- out_rlo : Address; -- PC-offset of the caller after get_previous.
- end record;
-
- type Previous_Frame_Descriptor is record
- prev_fsz : Address; -- frame size of calling routine.
- prev_sp : Address; -- SP of calling routine.
- prev_rls : Address; -- PC_space of calling routine's caller.
- prev_rlo : Address; -- PC_offset of calling routine's caller.
- prev_dp : Address; -- DP of calling routine.
- udescr0 : Address; -- low word of calling routine's unwind desc.
- udescr1 : Address; -- high word of calling routine's unwind desc.
- ustart : Address; -- start of the unwind region.
- uend : Address; -- end of the unwind region.
- uw_index : Address; -- index into the unwind table.
- prev_r19 : Address; -- GR19 value of the caller's caller.
- top_r3 : Address; -- Caller's initial gr3.
- top_r4 : Address; -- Caller's initial gr4.
- end record;
-
- -- Provide useful shortcuts for the names
-
- subtype CFD is Current_Frame_Descriptor;
- subtype PFD is Previous_Frame_Descriptor;
-
- -- Frames with dynamic stack allocation are handled using the associated
- -- frame pointer, but HP compilers and GCC setup this pointer differently.
- -- HP compilers set it to point at the top (highest address) of the static
- -- part of the frame, wheras GCC sets it to point at the bottom of this
- -- region. We have to fake the unwinder to compensate for this difference,
- -- for which we'll need to access some subprograms unwind descriptors.
-
- type Bits_2_Value is mod 2 ** 2;
- for Bits_2_Value'Size use 2;
-
- type Bits_4_Value is mod 2 ** 4;
- for Bits_4_Value'Size use 4;
-
- type Bits_5_Value is mod 2 ** 5;
- for Bits_5_Value'Size use 5;
-
- type Bits_27_Value is mod 2 ** 27;
- for Bits_27_Value'Size use 27;
-
- type Unwind_Descriptor is record
- cannot_unwind : Boolean;
- mcode : Boolean;
- mcode_save_restore : Boolean;
- region_desc : Bits_2_Value;
- reserved0 : Boolean;
- entry_sr : Boolean;
- entry_fr : Bits_4_Value;
- entry_gr : Bits_5_Value;
-
- args_stored : Boolean;
- variable_frame : Boolean;
- separate_package_body : Boolean;
- frame_extension_mcode : Boolean;
-
- stack_overflow_check : Boolean;
- two_steps_sp_adjust : Boolean;
- sr4_export : Boolean;
- cxx_info : Boolean;
-
- cxx_try_catch : Boolean;
- sched_entry_seq : Boolean;
- reserved1 : Boolean;
- save_sp : Boolean;
-
- save_rp : Boolean;
- save_mrp : Boolean;
- save_r19 : Boolean;
- cleanups : Boolean;
-
- hpe_interrupt_marker : Boolean;
- hpux_interrupt_marker : Boolean;
- large_frame : Boolean;
- alloca_frame : Boolean;
-
- reserved2 : Boolean;
- frame_size : Bits_27_Value;
- end record;
-
- for Unwind_Descriptor'Size use 64;
-
- for Unwind_Descriptor use record
- cannot_unwind at 0 range 0 .. 0;
- mcode at 0 range 1 .. 1;
- mcode_save_restore at 0 range 2 .. 2;
- region_desc at 0 range 3 .. 4;
- reserved0 at 0 range 5 .. 5;
- entry_sr at 0 range 6 .. 6;
- entry_fr at 0 range 7 .. 10;
-
- entry_gr at 1 range 3 .. 7;
-
- args_stored at 2 range 0 .. 0;
- variable_frame at 2 range 1 .. 1;
- separate_package_body at 2 range 2 .. 2;
- frame_extension_mcode at 2 range 3 .. 3;
- stack_overflow_check at 2 range 4 .. 4;
- two_steps_sp_adjust at 2 range 5 .. 5;
- sr4_export at 2 range 6 .. 6;
- cxx_info at 2 range 7 .. 7;
-
- cxx_try_catch at 3 range 0 .. 0;
- sched_entry_seq at 3 range 1 .. 1;
- reserved1 at 3 range 2 .. 2;
- save_sp at 3 range 3 .. 3;
- save_rp at 3 range 4 .. 4;
- save_mrp at 3 range 5 .. 5;
- save_r19 at 3 range 6 .. 6;
- cleanups at 3 range 7 .. 7;
-
- hpe_interrupt_marker at 4 range 0 .. 0;
- hpux_interrupt_marker at 4 range 1 .. 1;
- large_frame at 4 range 2 .. 2;
- alloca_frame at 4 range 3 .. 3;
-
- reserved2 at 4 range 4 .. 4;
- frame_size at 4 range 5 .. 31;
- end record;
-
- subtype UWD is Unwind_Descriptor;
- type UWD_Ptr is access all UWD;
-
- function To_UWD_Access is new Ada.Unchecked_Conversion (Address, UWD_Ptr);
-
- -- The descriptor associated with a given code location is retrieved
- -- using functions imported from the HP library, requiring the definition
- -- of additional structures.
-
- type Unwind_Table_Region is record
- Table_Start : Address;
- Table_End : Address;
- end record;
- -- An Unwind Table region, which is a memory area containing Unwind
- -- Descriptors.
-
- subtype UWT is Unwind_Table_Region;
- type UWT_Ptr is access all UWT;
-
- function To_UWT_Address is new Ada.Unchecked_Conversion (UWT_Ptr, Address);
-
- -- The subprograms imported below are provided by the HP library
-
- function U_get_unwind_table return UWT;
- pragma Import (C, U_get_unwind_table, "U_get_unwind_table");
- -- Get the unwind table region associated with the current executable.
- -- This function is actually documented as having an argument, but which
- -- is only used for the MPE/iX targets.
-
- function U_get_shLib_unwind_table (r19 : Address) return UWT;
- pragma Import (C, U_get_shLib_unwind_table, "U_get_shLib_unw_tbl");
- -- Return the unwind table region associated with a possible shared
- -- library, as determined by the provided r19 value.
-
- function U_get_shLib_text_addr (r19 : Address) return Address;
- pragma Import (C, U_get_shLib_text_addr, "U_get_shLib_text_addr");
- -- Return the address at which the code for a shared library begins, or
- -- -1 if the value provided for r19 does not identify shared library code.
-
- function U_get_unwind_entry
- (Pc : Address;
- Space : Address;
- Table_Start : Address;
- Table_End : Address)
- return Address;
- pragma Import (C, U_get_unwind_entry, "U_get_unwind_entry");
- -- Given the bounds of an unwind table, return the address of the
- -- unwind descriptor associated with a code location/space. In the case
- -- of shared library code, the offset from the beginning of the library
- -- is expected as Pc.
-
- procedure U_init_frame_record (Frame : access CFD);
- pragma Import (C, U_init_frame_record, "U_init_frame_record");
-
- procedure U_prep_frame_rec_for_unwind (Frame : access CFD);
- pragma Import (C, U_prep_frame_rec_for_unwind,
- "U_prep_frame_rec_for_unwind");
-
- -- Fetch the description data of the frame in which these two procedures
- -- are called.
-
- function U_get_u_rlo (Cur : access CFD; Prev : access PFD) return Integer;
- pragma Import (C, U_get_u_rlo, "U_IS_STUB_OR_CALLX");
- -- From a complete current frame with a return location possibly located
- -- into a linker generated stub, and basic information about the previous
- -- frame, place the first non stub return location into the current frame.
- -- Return -1 if something went wrong during the computation.
-
- function U_is_shared_pc (rlo : Address; r19 : Address) return Address;
- pragma Import (C, U_is_shared_pc, "U_is_shared_pc");
- -- Return 0 if the provided return location does not correspond to code
- -- in a shared library, or something non null otherwise.
-
- function U_get_previous_frame_x
- (current_frame : access CFD;
- previous_frame : access PFD;
- previous_size : Integer)
- return Integer;
- pragma Import (C, U_get_previous_frame_x, "U_get_previous_frame_x");
- -- Fetch the data describing the "previous" frame relatively to the
- -- "current" one. "previous_size" should be the size of the "previous"
- -- frame descriptor provided.
- --
- -- The library provides a simpler interface without the size parameter
- -- but it is not usable when frames with dynamically allocated space are
- -- on the way.
-
- ------------------
- -- C_Call_Chain --
- ------------------
-
- function C_Call_Chain
- (Traceback : System.Address;
- Max_Len : Natural)
- return Natural
- is
- Val : Natural;
-
- begin
- Call_Chain (Traceback, Max_Len, Val);
- return Val;
- end C_Call_Chain;
-
- ----------------
- -- Call_Chain --
- ----------------
-
- procedure Call_Chain
- (Traceback : System.Address;
- Max_Len : Natural;
- Len : out Natural;
- Exclude_Min : System.Address := System.Null_Address;
- Exclude_Max : System.Address := System.Null_Address)
- is
- type Tracebacks_Array is array (1 .. Max_Len) of System.Address;
- pragma Suppress_Initialization (Tracebacks_Array);
-
- -- The code location returned by the unwinder is a return location but
- -- what we need is a call point. Under HP-UX call instructions are 4
- -- bytes long and the return point they specify is 4 bytes beyond the
- -- next instruction because of the delay slot.
-
- Call_Size : constant := 4;
- DSlot_Size : constant := 4;
- Rlo_Offset : constant := Call_Size + DSlot_Size;
-
- -- Moreover, the return point is passed via a register which two least
- -- significant bits specify a privilege level that we will have to mask.
-
- Priv_Mask : constant := 16#00000003#;
-
- Frame : aliased CFD;
- Code : System.Address;
- J : Natural := 1;
- Pop_Success : Boolean;
- Trace : Tracebacks_Array;
- for Trace'Address use Traceback;
-
- -- The backtracing process needs a set of subprograms :
-
- function UWD_For_RLO_Of (Frame : access CFD) return UWD_Ptr;
- -- Return an access to the unwind descriptor for the caller of
- -- a given frame, using only the provided return location.
-
- function UWD_For_Caller_Of (Frame : access CFD) return UWD_Ptr;
- -- Return an access to the unwind descriptor for the user code caller
- -- of a given frame, or null if the information is not available.
-
- function Pop_Frame (Frame : access CFD) return Boolean;
- -- Update the provided machine state structure so that it reflects
- -- the state one call frame "above" the initial one.
- --
- -- Return True if the operation has been successful, False otherwise.
- -- Failure typically occurs when the top of the call stack has been
- -- reached.
-
- function Prepare_For_Unwind_Of (Frame : access CFD) return Boolean;
- -- Perform the necessary adaptations to the machine state before
- -- calling the unwinder. Currently used for the specific case of
- -- dynamically sized previous frames.
- --
- -- Return True if everything went fine, or False otherwise.
-
- Program_UWT : constant UWT := U_get_unwind_table;
-
- ---------------
- -- Pop_Frame --
- ---------------
-
- function Pop_Frame (Frame : access CFD) return Boolean is
- Up_Frame : aliased PFD;
- State_Ready : Boolean;
-
- begin
- -- Check/adapt the state before calling the unwinder and return
- -- if anything went wrong.
-
- State_Ready := Prepare_For_Unwind_Of (Frame);
-
- if not State_Ready then
- return False;
- end if;
-
- -- Now, safely call the unwinder and use the results.
-
- if U_get_previous_frame_x (Frame,
- Up_Frame'Access,
- Up_Frame'Size) /= 0
- then
- return False;
- end if;
-
- -- In case a stub is on the way, the usual previous return location
- -- (the one in prev_rlo) is the one in the stub and the "real" one
- -- is placed in the "current" record, so let's take this one into
- -- account.
-
- Frame.out_rlo := Frame.cur_rlo;
-
- Frame.cur_fsz := Up_Frame.prev_fsz;
- Frame.cur_sp := Up_Frame.prev_sp;
- Frame.cur_rls := Up_Frame.prev_rls;
- Frame.cur_rlo := Up_Frame.prev_rlo;
- Frame.cur_dp := Up_Frame.prev_dp;
- Frame.cur_r19 := Up_Frame.prev_r19;
- Frame.top_r3 := Up_Frame.top_r3;
- Frame.top_r4 := Up_Frame.top_r4;
-
- return True;
- end Pop_Frame;
-
- ---------------------------------
- -- Prepare_State_For_Unwind_Of --
- ---------------------------------
-
- function Prepare_For_Unwind_Of (Frame : access CFD) return Boolean
- is
- Caller_UWD : UWD_Ptr;
- FP_Adjustment : Integer;
-
- begin
- -- No need to bother doing anything if the stack is already fully
- -- unwound.
-
- if Frame.cur_rlo = 0 then
- return False;
- end if;
-
- -- When ALLOCA_FRAME is set in an unwind descriptor, the unwinder
- -- uses the value provided in current.top_r3 or current.top_r4 as
- -- a frame pointer to compute the size of the frame. What decides
- -- between r3 or r4 is the unwind descriptor LARGE_FRAME bit, with
- -- r4 chosen if the bit is set.
-
- -- The size computed by the unwinder is STATIC_PART + (SP - FP),
- -- which is correct with HP's frame pointer convention, but not
- -- with GCC's one since we end up with the static part accounted
- -- for twice.
-
- -- We have to compute r4 when it is required because the unwinder
- -- has looked for it at a place where it was not if we went through
- -- GCC frames.
-
- -- The size of the static part of a frame can be found in the
- -- associated unwind descriptor.
-
- Caller_UWD := UWD_For_Caller_Of (Frame);
-
- -- If we cannot get it, we are unable to compute the potentially
- -- necessary adjustments. We'd better not try to go on then.
-
- if Caller_UWD = null then
- return False;
- end if;
-
- -- If the caller frame is a GCC one, r3 is its frame pointer and
- -- points to the bottom of the frame. The value to provide for r4
- -- can then be computed directly from the one of r3, compensating
- -- for the static part of the frame.
-
- -- If the caller frame is an HP one, r3 is used to locate the
- -- previous frame marker, that is it also points to the bottom of
- -- the frame (this is why r3 cannot be used as the frame pointer in
- -- the HP sense for large frames). The value to provide for r4 can
- -- then also be computed from the one of r3 with the compensation
- -- for the static part of the frame.
-
- FP_Adjustment := Integer (Caller_UWD.frame_size * 8);
- Frame.top_r4 := Address (Integer (Frame.top_r3) + FP_Adjustment);
-
- return True;
- end Prepare_For_Unwind_Of;
-
- -----------------------
- -- UWD_For_Caller_Of --
- -----------------------
-
- function UWD_For_Caller_Of (Frame : access CFD) return UWD_Ptr
- is
- UWD_Access : UWD_Ptr;
-
- begin
- -- First try the most direct path, using the return location data
- -- associated with the frame.
-
- UWD_Access := UWD_For_RLO_Of (Frame);
-
- if UWD_Access /= null then
- return UWD_Access;
- end if;
-
- -- If we did not get a result, we might face an in-stub return
- -- address. In this case U_get_previous_frame can tell us what the
- -- first not-in-stub return point is. We cannot call it directly,
- -- though, because we haven't computed the potentially necessary
- -- frame pointer adjustments, which might lead to SEGV in some
- -- circumstances. Instead, we directly call the libcl routine which
- -- is called by U_get_previous_frame and which only requires few
- -- information. Take care, however, that the information is provided
- -- in the "current" argument, so we need to work on a copy to avoid
- -- disturbing our caller.
-
- declare
- U_Current : aliased CFD := Frame.all;
- U_Previous : aliased PFD;
-
- begin
- U_Previous.prev_dp := U_Current.cur_dp;
- U_Previous.prev_rls := U_Current.cur_rls;
- U_Previous.prev_sp := U_Current.cur_sp - U_Current.cur_fsz;
-
- if U_get_u_rlo (U_Current'Access, U_Previous'Access) /= -1 then
- UWD_Access := UWD_For_RLO_Of (U_Current'Access);
- end if;
- end;
-
- return UWD_Access;
- end UWD_For_Caller_Of;
-
- --------------------
- -- UWD_For_RLO_Of --
- --------------------
-
- function UWD_For_RLO_Of (Frame : access CFD) return UWD_Ptr
- is
- UWD_Address : Address;
-
- -- The addresses returned by the library point to full descriptors
- -- including the frame information bits but also the applicable PC
- -- range. We need to account for this.
-
- Frame_Info_Offset : constant := 8;
-
- begin
- -- First try to locate the descriptor in the program's unwind table.
-
- UWD_Address := U_get_unwind_entry (Frame.cur_rlo,
- Frame.cur_rls,
- Program_UWT.Table_Start,
- Program_UWT.Table_End);
-
- -- If we did not get it, we might have a frame from code in a
- -- stub or shared library. For code in stub we would have to
- -- compute the first non-stub return location but this is not
- -- the role of this subprogram, so let's just try to see if we
- -- can get a result from the tables in shared libraries.
-
- if UWD_Address = -1
- and then U_is_shared_pc (Frame.cur_rlo, Frame.cur_r19) /= 0
- then
- declare
- Shlib_UWT : UWT := U_get_shLib_unwind_table (Frame.cur_r19);
- Shlib_Start : Address := U_get_shLib_text_addr (Frame.cur_r19);
- Rlo_Offset : Address := Frame.cur_rlo - Shlib_Start;
-
- begin
- UWD_Address := U_get_unwind_entry (Rlo_Offset,
- Frame.cur_rls,
- Shlib_UWT.Table_Start,
- Shlib_UWT.Table_End);
- end;
- end if;
-
- if UWD_Address /= -1 then
- return To_UWD_Access (UWD_Address + Frame_Info_Offset);
- else
- return null;
- end if;
- end UWD_For_RLO_Of;
-
- -- Start of processing for Call_Chain
-
- begin
- -- Fetch the state for this subprogram's frame and pop it so that the
- -- backtrace starts at the right point for our caller, that is at its
- -- own frame.
-
- U_init_frame_record (Frame'Access);
- Frame.top_sr0 := 0;
- Frame.top_sr4 := 0;
-
- U_prep_frame_rec_for_unwind (Frame'Access);
-
- Pop_Success := Pop_Frame (Frame'Access);
-
- -- Loop popping frames and storing locations until either a problem
- -- occurs, or the top of the call chain is reached, or the provided
- -- array is full.
-
- loop
- -- We have to test some conditions against the return location
- -- as it is returned, so get it as is first.
-
- Code := Frame.out_rlo;
-
- exit when not Pop_Success or else Code = 0 or else J = Max_Len + 1;
-
- -- Compute the call point from the retrieved return location :
- -- Mask the privilege bits and account for the delta between the
- -- call site and the return point.
-
- Code := (Code and not Priv_Mask) - Rlo_Offset;
-
- if Code < Exclude_Min or else Code > Exclude_Max then
- Trace (J) := Code;
- J := J + 1;
- end if;
-
- Pop_Success := Pop_Frame (Frame'Access);
- end loop;
-
- Len := J - 1;
- end Call_Chain;
-
-end System.Traceback;
-
projects / msp430-gcc.git / blobdiff