1 ------------------------------------------------------------------------------
3 -- GNAT COMPILER COMPONENTS --
5 -- S Y S T E M . T R A C E B A C K --
10 -- Copyright (C) 1999-2005, AdaCore --
12 -- GNAT is free software; you can redistribute it and/or modify it under --
13 -- terms of the GNU General Public License as published by the Free Soft- --
14 -- ware Foundation; either version 2, or (at your option) any later ver- --
15 -- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
16 -- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
17 -- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License --
18 -- for more details. You should have received a copy of the GNU General --
19 -- Public License distributed with GNAT; see file COPYING. If not, write --
20 -- to the Free Software Foundation, 51 Franklin Street, Fifth Floor, --
21 -- Boston, MA 02110-1301, USA. --
23 -- As a special exception, if other files instantiate generics from this --
24 -- unit, or you link this unit with other files to produce an executable, --
25 -- this unit does not by itself cause the resulting executable to be --
26 -- covered by the GNU General Public License. This exception does not --
27 -- however invalidate any other reasons why the executable file might be --
28 -- covered by the GNU Public License. --
30 -- GNAT was originally developed by the GNAT team at New York University. --
31 -- Extensive contributions were provided by Ada Core Technologies Inc. --
33 ------------------------------------------------------------------------------
35 with Ada
.Unchecked_Conversion
;
37 package body System
.Traceback
is
39 -- This package implements the backtracing facility by way of a dedicated
40 -- HP library for stack unwinding described in the "Runtime Architecture
43 pragma Linker_Options
("/usr/lib/libcl.a");
45 -- The library basically offers services to fetch information about a
46 -- "previous" frame based on information about a "current" one.
48 type Current_Frame_Descriptor
is record
49 cur_fsz
: Address
; -- Frame size of current routine.
50 cur_sp
: Address
; -- The current value of stack pointer.
51 cur_rls
: Address
; -- PC-space of the caller.
52 cur_rlo
: Address
; -- PC-offset of the caller.
53 cur_dp
: Address
; -- Data Pointer of the current routine.
54 top_rp
: Address
; -- Initial value of RP.
55 top_mrp
: Address
; -- Initial value of MRP.
56 top_sr0
: Address
; -- Initial value of sr0.
57 top_sr4
: Address
; -- Initial value of sr4.
58 top_r3
: Address
; -- Initial value of gr3.
59 cur_r19
: Address
; -- GR19 value of the calling routine.
60 top_r4
: Address
; -- Initial value of gr4.
61 dummy
: Address
; -- Reserved.
62 out_rlo
: Address
; -- PC-offset of the caller after get_previous.
65 type Previous_Frame_Descriptor
is record
66 prev_fsz
: Address
; -- frame size of calling routine.
67 prev_sp
: Address
; -- SP of calling routine.
68 prev_rls
: Address
; -- PC_space of calling routine's caller.
69 prev_rlo
: Address
; -- PC_offset of calling routine's caller.
70 prev_dp
: Address
; -- DP of calling routine.
71 udescr0
: Address
; -- low word of calling routine's unwind desc.
72 udescr1
: Address
; -- high word of calling routine's unwind desc.
73 ustart
: Address
; -- start of the unwind region.
74 uend
: Address
; -- end of the unwind region.
75 uw_index
: Address
; -- index into the unwind table.
76 prev_r19
: Address
; -- GR19 value of the caller's caller.
77 top_r3
: Address
; -- Caller's initial gr3.
78 top_r4
: Address
; -- Caller's initial gr4.
81 -- Provide useful shortcuts for the names
83 subtype CFD
is Current_Frame_Descriptor
;
84 subtype PFD
is Previous_Frame_Descriptor
;
86 -- Frames with dynamic stack allocation are handled using the associated
87 -- frame pointer, but HP compilers and GCC setup this pointer differently.
88 -- HP compilers set it to point at the top (highest address) of the static
89 -- part of the frame, wheras GCC sets it to point at the bottom of this
90 -- region. We have to fake the unwinder to compensate for this difference,
91 -- for which we'll need to access some subprograms unwind descriptors.
93 type Bits_2_Value
is mod 2 ** 2;
94 for Bits_2_Value
'Size use 2;
96 type Bits_4_Value
is mod 2 ** 4;
97 for Bits_4_Value
'Size use 4;
99 type Bits_5_Value
is mod 2 ** 5;
100 for Bits_5_Value
'Size use 5;
102 type Bits_27_Value
is mod 2 ** 27;
103 for Bits_27_Value
'Size use 27;
105 type Unwind_Descriptor
is record
106 cannot_unwind
: Boolean;
108 mcode_save_restore
: Boolean;
109 region_desc
: Bits_2_Value
;
112 entry_fr
: Bits_4_Value
;
113 entry_gr
: Bits_5_Value
;
115 args_stored
: Boolean;
116 variable_frame
: Boolean;
117 separate_package_body
: Boolean;
118 frame_extension_mcode
: Boolean;
120 stack_overflow_check
: Boolean;
121 two_steps_sp_adjust
: Boolean;
122 sr4_export
: Boolean;
125 cxx_try_catch
: Boolean;
126 sched_entry_seq
: Boolean;
135 hpe_interrupt_marker
: Boolean;
136 hpux_interrupt_marker
: Boolean;
137 large_frame
: Boolean;
138 alloca_frame
: Boolean;
141 frame_size
: Bits_27_Value
;
144 for Unwind_Descriptor
'Size use 64;
146 for Unwind_Descriptor
use record
147 cannot_unwind
at 0 range 0 .. 0;
148 mcode
at 0 range 1 .. 1;
149 mcode_save_restore
at 0 range 2 .. 2;
150 region_desc
at 0 range 3 .. 4;
151 reserved0
at 0 range 5 .. 5;
152 entry_sr
at 0 range 6 .. 6;
153 entry_fr
at 0 range 7 .. 10;
155 entry_gr
at 1 range 3 .. 7;
157 args_stored
at 2 range 0 .. 0;
158 variable_frame
at 2 range 1 .. 1;
159 separate_package_body
at 2 range 2 .. 2;
160 frame_extension_mcode
at 2 range 3 .. 3;
161 stack_overflow_check
at 2 range 4 .. 4;
162 two_steps_sp_adjust
at 2 range 5 .. 5;
163 sr4_export
at 2 range 6 .. 6;
164 cxx_info
at 2 range 7 .. 7;
166 cxx_try_catch
at 3 range 0 .. 0;
167 sched_entry_seq
at 3 range 1 .. 1;
168 reserved1
at 3 range 2 .. 2;
169 save_sp
at 3 range 3 .. 3;
170 save_rp
at 3 range 4 .. 4;
171 save_mrp
at 3 range 5 .. 5;
172 save_r19
at 3 range 6 .. 6;
173 cleanups
at 3 range 7 .. 7;
175 hpe_interrupt_marker
at 4 range 0 .. 0;
176 hpux_interrupt_marker
at 4 range 1 .. 1;
177 large_frame
at 4 range 2 .. 2;
178 alloca_frame
at 4 range 3 .. 3;
180 reserved2
at 4 range 4 .. 4;
181 frame_size
at 4 range 5 .. 31;
184 subtype UWD
is Unwind_Descriptor
;
185 type UWD_Ptr
is access all UWD
;
187 function To_UWD_Access
is new Ada
.Unchecked_Conversion
(Address
, UWD_Ptr
);
189 -- The descriptor associated with a given code location is retrieved
190 -- using functions imported from the HP library, requiring the definition
191 -- of additional structures.
193 type Unwind_Table_Region
is record
194 Table_Start
: Address
;
197 -- An Unwind Table region, which is a memory area containing Unwind
200 subtype UWT
is Unwind_Table_Region
;
202 -- The subprograms imported below are provided by the HP library
204 function U_get_unwind_table
return UWT
;
205 pragma Import
(C
, U_get_unwind_table
, "U_get_unwind_table");
206 -- Get the unwind table region associated with the current executable.
207 -- This function is actually documented as having an argument, but which
208 -- is only used for the MPE/iX targets.
210 function U_get_shLib_unwind_table
(r19
: Address
) return UWT
;
211 pragma Import
(C
, U_get_shLib_unwind_table
, "U_get_shLib_unw_tbl");
212 -- Return the unwind table region associated with a possible shared
213 -- library, as determined by the provided r19 value.
215 function U_get_shLib_text_addr
(r19
: Address
) return Address
;
216 pragma Import
(C
, U_get_shLib_text_addr
, "U_get_shLib_text_addr");
217 -- Return the address at which the code for a shared library begins, or
218 -- -1 if the value provided for r19 does not identify shared library code.
220 function U_get_unwind_entry
223 Table_Start
: Address
;
224 Table_End
: Address
) return Address
;
225 pragma Import
(C
, U_get_unwind_entry
, "U_get_unwind_entry");
226 -- Given the bounds of an unwind table, return the address of the
227 -- unwind descriptor associated with a code location/space. In the case
228 -- of shared library code, the offset from the beginning of the library
229 -- is expected as Pc.
231 procedure U_init_frame_record
(Frame
: access CFD
);
232 pragma Import
(C
, U_init_frame_record
, "U_init_frame_record");
234 procedure U_prep_frame_rec_for_unwind
(Frame
: access CFD
);
235 pragma Import
(C
, U_prep_frame_rec_for_unwind
,
236 "U_prep_frame_rec_for_unwind");
238 -- Fetch the description data of the frame in which these two procedures
241 function U_get_u_rlo
(Cur
: access CFD
; Prev
: access PFD
) return Integer;
242 pragma Import
(C
, U_get_u_rlo
, "U_IS_STUB_OR_CALLX");
243 -- From a complete current frame with a return location possibly located
244 -- into a linker generated stub, and basic information about the previous
245 -- frame, place the first non stub return location into the current frame.
246 -- Return -1 if something went wrong during the computation.
248 function U_is_shared_pc
(rlo
: Address
; r19
: Address
) return Address
;
249 pragma Import
(C
, U_is_shared_pc
, "U_is_shared_pc");
250 -- Return 0 if the provided return location does not correspond to code
251 -- in a shared library, or something non null otherwise.
253 function U_get_previous_frame_x
254 (current_frame
: access CFD
;
255 previous_frame
: access PFD
;
256 previous_size
: Integer) return Integer;
257 pragma Import
(C
, U_get_previous_frame_x
, "U_get_previous_frame_x");
258 -- Fetch the data describing the "previous" frame relatively to the
259 -- "current" one. "previous_size" should be the size of the "previous"
260 -- frame descriptor provided.
262 -- The library provides a simpler interface without the size parameter
263 -- but it is not usable when frames with dynamically allocated space are
270 function C_Call_Chain
271 (Traceback
: System
.Address
;
272 Max_Len
: Natural) return Natural
277 Call_Chain
(Traceback
, Max_Len
, Val
);
286 (Traceback
: System
.Address
;
289 Exclude_Min
: System
.Address
:= System
.Null_Address
;
290 Exclude_Max
: System
.Address
:= System
.Null_Address
;
291 Skip_Frames
: Natural := 1)
293 type Tracebacks_Array
is array (1 .. Max_Len
) of System
.Address
;
294 pragma Suppress_Initialization
(Tracebacks_Array
);
296 -- The code location returned by the unwinder is a return location but
297 -- what we need is a call point. Under HP-UX call instructions are 4
298 -- bytes long and the return point they specify is 4 bytes beyond the
299 -- next instruction because of the delay slot.
301 Call_Size
: constant := 4;
302 DSlot_Size
: constant := 4;
303 Rlo_Offset
: constant := Call_Size
+ DSlot_Size
;
305 -- Moreover, the return point is passed via a register which two least
306 -- significant bits specify a privilege level that we will have to mask.
308 Priv_Mask
: constant := 16#
00000003#
;
311 Code
: System
.Address
;
313 Pop_Success
: Boolean;
314 Trace
: Tracebacks_Array
;
315 for Trace
'Address use Traceback
;
317 -- The backtracing process needs a set of subprograms :
319 function UWD_For_RLO_Of
(Frame
: access CFD
) return UWD_Ptr
;
320 -- Return an access to the unwind descriptor for the caller of
321 -- a given frame, using only the provided return location.
323 function UWD_For_Caller_Of
(Frame
: access CFD
) return UWD_Ptr
;
324 -- Return an access to the unwind descriptor for the user code caller
325 -- of a given frame, or null if the information is not available.
327 function Pop_Frame
(Frame
: access CFD
) return Boolean;
328 -- Update the provided machine state structure so that it reflects
329 -- the state one call frame "above" the initial one.
331 -- Return True if the operation has been successful, False otherwise.
332 -- Failure typically occurs when the top of the call stack has been
335 function Prepare_For_Unwind_Of
(Frame
: access CFD
) return Boolean;
336 -- Perform the necessary adaptations to the machine state before
337 -- calling the unwinder. Currently used for the specific case of
338 -- dynamically sized previous frames.
340 -- Return True if everything went fine, or False otherwise.
342 Program_UWT
: constant UWT
:= U_get_unwind_table
;
348 function Pop_Frame
(Frame
: access CFD
) return Boolean is
349 Up_Frame
: aliased PFD
;
350 State_Ready
: Boolean;
353 -- Check/adapt the state before calling the unwinder and return
354 -- if anything went wrong.
356 State_Ready
:= Prepare_For_Unwind_Of
(Frame
);
358 if not State_Ready
then
362 -- Now, safely call the unwinder and use the results
364 if U_get_previous_frame_x
(Frame
,
371 -- In case a stub is on the way, the usual previous return location
372 -- (the one in prev_rlo) is the one in the stub and the "real" one
373 -- is placed in the "current" record, so let's take this one into
376 Frame
.out_rlo
:= Frame
.cur_rlo
;
378 Frame
.cur_fsz
:= Up_Frame
.prev_fsz
;
379 Frame
.cur_sp
:= Up_Frame
.prev_sp
;
380 Frame
.cur_rls
:= Up_Frame
.prev_rls
;
381 Frame
.cur_rlo
:= Up_Frame
.prev_rlo
;
382 Frame
.cur_dp
:= Up_Frame
.prev_dp
;
383 Frame
.cur_r19
:= Up_Frame
.prev_r19
;
384 Frame
.top_r3
:= Up_Frame
.top_r3
;
385 Frame
.top_r4
:= Up_Frame
.top_r4
;
390 ---------------------------------
391 -- Prepare_State_For_Unwind_Of --
392 ---------------------------------
394 function Prepare_For_Unwind_Of
(Frame
: access CFD
) return Boolean
396 Caller_UWD
: UWD_Ptr
;
397 FP_Adjustment
: Integer;
400 -- No need to bother doing anything if the stack is already fully
403 if Frame
.cur_rlo
= 0 then
407 -- When ALLOCA_FRAME is set in an unwind descriptor, the unwinder
408 -- uses the value provided in current.top_r3 or current.top_r4 as
409 -- a frame pointer to compute the size of the frame. What decides
410 -- between r3 or r4 is the unwind descriptor LARGE_FRAME bit, with
411 -- r4 chosen if the bit is set.
413 -- The size computed by the unwinder is STATIC_PART + (SP - FP),
414 -- which is correct with HP's frame pointer convention, but not
415 -- with GCC's one since we end up with the static part accounted
418 -- We have to compute r4 when it is required because the unwinder
419 -- has looked for it at a place where it was not if we went through
422 -- The size of the static part of a frame can be found in the
423 -- associated unwind descriptor.
425 Caller_UWD
:= UWD_For_Caller_Of
(Frame
);
427 -- If we cannot get it, we are unable to compute the potentially
428 -- necessary adjustments. We'd better not try to go on then.
430 if Caller_UWD
= null then
434 -- If the caller frame is a GCC one, r3 is its frame pointer and
435 -- points to the bottom of the frame. The value to provide for r4
436 -- can then be computed directly from the one of r3, compensating
437 -- for the static part of the frame.
439 -- If the caller frame is an HP one, r3 is used to locate the
440 -- previous frame marker, that is it also points to the bottom of
441 -- the frame (this is why r3 cannot be used as the frame pointer in
442 -- the HP sense for large frames). The value to provide for r4 can
443 -- then also be computed from the one of r3 with the compensation
444 -- for the static part of the frame.
446 FP_Adjustment
:= Integer (Caller_UWD
.frame_size
* 8);
447 Frame
.top_r4
:= Address
(Integer (Frame
.top_r3
) + FP_Adjustment
);
450 end Prepare_For_Unwind_Of
;
452 -----------------------
453 -- UWD_For_Caller_Of --
454 -----------------------
456 function UWD_For_Caller_Of
(Frame
: access CFD
) return UWD_Ptr
458 UWD_Access
: UWD_Ptr
;
461 -- First try the most direct path, using the return location data
462 -- associated with the frame.
464 UWD_Access
:= UWD_For_RLO_Of
(Frame
);
466 if UWD_Access
/= null then
470 -- If we did not get a result, we might face an in-stub return
471 -- address. In this case U_get_previous_frame can tell us what the
472 -- first not-in-stub return point is. We cannot call it directly,
473 -- though, because we haven't computed the potentially necessary
474 -- frame pointer adjustments, which might lead to SEGV in some
475 -- circumstances. Instead, we directly call the libcl routine which
476 -- is called by U_get_previous_frame and which only requires few
477 -- information. Take care, however, that the information is provided
478 -- in the "current" argument, so we need to work on a copy to avoid
479 -- disturbing our caller.
482 U_Current
: aliased CFD
:= Frame
.all;
483 U_Previous
: aliased PFD
;
486 U_Previous
.prev_dp
:= U_Current
.cur_dp
;
487 U_Previous
.prev_rls
:= U_Current
.cur_rls
;
488 U_Previous
.prev_sp
:= U_Current
.cur_sp
- U_Current
.cur_fsz
;
490 if U_get_u_rlo
(U_Current
'Access, U_Previous
'Access) /= -1 then
491 UWD_Access
:= UWD_For_RLO_Of
(U_Current
'Access);
496 end UWD_For_Caller_Of
;
502 function UWD_For_RLO_Of
(Frame
: access CFD
) return UWD_Ptr
504 UWD_Address
: Address
;
506 -- The addresses returned by the library point to full descriptors
507 -- including the frame information bits but also the applicable PC
508 -- range. We need to account for this.
510 Frame_Info_Offset
: constant := 8;
513 -- First try to locate the descriptor in the program's unwind table
515 UWD_Address
:= U_get_unwind_entry
(Frame
.cur_rlo
,
517 Program_UWT
.Table_Start
,
518 Program_UWT
.Table_End
);
520 -- If we did not get it, we might have a frame from code in a
521 -- stub or shared library. For code in stub we would have to
522 -- compute the first non-stub return location but this is not
523 -- the role of this subprogram, so let's just try to see if we
524 -- can get a result from the tables in shared libraries.
527 and then U_is_shared_pc
(Frame
.cur_rlo
, Frame
.cur_r19
) /= 0
530 Shlib_UWT
: constant UWT
:=
531 U_get_shLib_unwind_table
(Frame
.cur_r19
);
532 Shlib_Start
: constant Address
:=
533 U_get_shLib_text_addr
(Frame
.cur_r19
);
534 Rlo_Offset
: constant Address
:=
535 Frame
.cur_rlo
- Shlib_Start
;
537 UWD_Address
:= U_get_unwind_entry
(Rlo_Offset
,
539 Shlib_UWT
.Table_Start
,
540 Shlib_UWT
.Table_End
);
544 if UWD_Address
/= -1 then
545 return To_UWD_Access
(UWD_Address
+ Frame_Info_Offset
);
551 -- Start of processing for Call_Chain
554 -- Fetch the state for this subprogram's frame and pop it so that we
555 -- start with an initial out_rlo "here".
557 U_init_frame_record
(Frame
'Access);
561 U_prep_frame_rec_for_unwind
(Frame
'Access);
563 Pop_Success
:= Pop_Frame
(Frame
'Access);
565 -- Skip the requested number of frames
567 for I
in 1 .. Skip_Frames
loop
568 Pop_Success
:= Pop_Frame
(Frame
'Access);
571 -- Loop popping frames and storing locations until either a problem
572 -- occurs, or the top of the call chain is reached, or the provided
576 -- We have to test some conditions against the return location
577 -- as it is returned, so get it as is first.
579 Code
:= Frame
.out_rlo
;
581 exit when not Pop_Success
or else Code
= 0 or else J
= Max_Len
+ 1;
583 -- Compute the call point from the retrieved return location :
584 -- Mask the privilege bits and account for the delta between the
585 -- call site and the return point.
587 Code
:= (Code
and not Priv_Mask
) - Rlo_Offset
;
589 if Code
< Exclude_Min
or else Code
> Exclude_Max
then
594 Pop_Success
:= Pop_Frame
(Frame
'Access);
600 end System
.Traceback
;