diff options
Diffstat (limited to 'gcc-4.2.1/gcc/ada/s-traceb-hpux.adb')
| -rw-r--r-- | gcc-4.2.1/gcc/ada/s-traceb-hpux.adb | 600 |
1 files changed, 0 insertions, 600 deletions
diff --git a/gcc-4.2.1/gcc/ada/s-traceb-hpux.adb b/gcc-4.2.1/gcc/ada/s-traceb-hpux.adb deleted file mode 100644 index 5457cb1d0..000000000 --- a/gcc-4.2.1/gcc/ada/s-traceb-hpux.adb +++ /dev/null @@ -1,600 +0,0 @@ ------------------------------------------------------------------------------- --- -- --- 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 -- --- -- --- Copyright (C) 1999-2005, AdaCore -- --- -- --- 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, 51 Franklin Street, Fifth Floor, -- --- Boston, MA 02110-1301, 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. -- --- Extensive contributions were provided by Ada Core Technologies Inc. -- --- -- ------------------------------------------------------------------------------- - -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; - - -- 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; - Skip_Frames : Natural := 1) - 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 : constant UWT := - U_get_shLib_unwind_table (Frame.cur_r19); - Shlib_Start : constant Address := - U_get_shLib_text_addr (Frame.cur_r19); - Rlo_Offset : constant 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 we - -- start with an initial out_rlo "here". - - 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); - - -- Skip the requested number of frames - - for I in 1 .. Skip_Frames loop - Pop_Success := Pop_Frame (Frame'Access); - end loop; - - -- 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; |