|
111
|
1 ------------------------------------------------------------------------------
|
|
|
2 -- --
|
|
|
3 -- GNAT COMPILER COMPONENTS --
|
|
|
4 -- --
|
|
|
5 -- S Y S T E M . T R A C E B A C K --
|
|
|
6 -- (HP/UX Version) --
|
|
|
7 -- --
|
|
|
8 -- B o d y --
|
|
|
9 -- --
|
|
145
|
10 -- Copyright (C) 2009-2019, Free Software Foundation, Inc. --
|
|
111
|
11 -- --
|
|
|
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 3, 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. --
|
|
|
18 -- --
|
|
|
19 -- As a special exception under Section 7 of GPL version 3, you are granted --
|
|
|
20 -- additional permissions described in the GCC Runtime Library Exception, --
|
|
|
21 -- version 3.1, as published by the Free Software Foundation. --
|
|
|
22 -- --
|
|
|
23 -- You should have received a copy of the GNU General Public License and --
|
|
|
24 -- a copy of the GCC Runtime Library Exception along with this program; --
|
|
|
25 -- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
|
|
|
26 -- <http://www.gnu.org/licenses/>. --
|
|
|
27 -- --
|
|
|
28 -- GNAT was originally developed by the GNAT team at New York University. --
|
|
|
29 -- Extensive contributions were provided by Ada Core Technologies Inc. --
|
|
|
30 -- --
|
|
|
31 ------------------------------------------------------------------------------
|
|
|
32
|
|
|
33 with Ada.Unchecked_Conversion;
|
|
|
34
|
|
|
35 package body System.Traceback is
|
|
|
36
|
|
|
37 -- This package implements the backtracing facility by way of a dedicated
|
|
|
38 -- HP library for stack unwinding described in the "Runtime Architecture
|
|
|
39 -- Document".
|
|
|
40
|
|
|
41 pragma Linker_Options ("/usr/lib/libcl.a");
|
|
|
42
|
|
|
43 -- The library basically offers services to fetch information about a
|
|
|
44 -- "previous" frame based on information about a "current" one.
|
|
|
45
|
|
|
46 type Current_Frame_Descriptor is record
|
|
|
47 cur_fsz : Address; -- Frame size of current routine.
|
|
|
48 cur_sp : Address; -- The current value of stack pointer.
|
|
|
49 cur_rls : Address; -- PC-space of the caller.
|
|
|
50 cur_rlo : Address; -- PC-offset of the caller.
|
|
|
51 cur_dp : Address; -- Data Pointer of the current routine.
|
|
|
52 top_rp : Address; -- Initial value of RP.
|
|
|
53 top_mrp : Address; -- Initial value of MRP.
|
|
|
54 top_sr0 : Address; -- Initial value of sr0.
|
|
|
55 top_sr4 : Address; -- Initial value of sr4.
|
|
|
56 top_r3 : Address; -- Initial value of gr3.
|
|
|
57 cur_r19 : Address; -- GR19 value of the calling routine.
|
|
|
58 top_r4 : Address; -- Initial value of gr4.
|
|
|
59 dummy : Address; -- Reserved.
|
|
|
60 out_rlo : Address; -- PC-offset of the caller after get_previous.
|
|
|
61 end record;
|
|
|
62
|
|
|
63 type Previous_Frame_Descriptor is record
|
|
|
64 prev_fsz : Address; -- frame size of calling routine.
|
|
|
65 prev_sp : Address; -- SP of calling routine.
|
|
|
66 prev_rls : Address; -- PC_space of calling routine's caller.
|
|
|
67 prev_rlo : Address; -- PC_offset of calling routine's caller.
|
|
|
68 prev_dp : Address; -- DP of calling routine.
|
|
|
69 udescr0 : Address; -- low word of calling routine's unwind desc.
|
|
|
70 udescr1 : Address; -- high word of calling routine's unwind desc.
|
|
|
71 ustart : Address; -- start of the unwind region.
|
|
|
72 uend : Address; -- end of the unwind region.
|
|
|
73 uw_index : Address; -- index into the unwind table.
|
|
|
74 prev_r19 : Address; -- GR19 value of the caller's caller.
|
|
|
75 top_r3 : Address; -- Caller's initial gr3.
|
|
|
76 top_r4 : Address; -- Caller's initial gr4.
|
|
|
77 end record;
|
|
|
78
|
|
|
79 -- Provide useful shortcuts for the names
|
|
|
80
|
|
|
81 subtype CFD is Current_Frame_Descriptor;
|
|
|
82 subtype PFD is Previous_Frame_Descriptor;
|
|
|
83
|
|
|
84 -- Frames with dynamic stack allocation are handled using the associated
|
|
|
85 -- frame pointer, but HP compilers and GCC setup this pointer differently.
|
|
|
86 -- HP compilers set it to point at the top (highest address) of the static
|
|
|
87 -- part of the frame, whereas GCC sets it to point at the bottom of this
|
|
|
88 -- region. We have to fake the unwinder to compensate for this difference,
|
|
|
89 -- for which we'll need to access some subprograms unwind descriptors.
|
|
|
90
|
|
|
91 type Bits_2_Value is mod 2 ** 2;
|
|
|
92 for Bits_2_Value'Size use 2;
|
|
|
93
|
|
|
94 type Bits_4_Value is mod 2 ** 4;
|
|
|
95 for Bits_4_Value'Size use 4;
|
|
|
96
|
|
|
97 type Bits_5_Value is mod 2 ** 5;
|
|
|
98 for Bits_5_Value'Size use 5;
|
|
|
99
|
|
|
100 type Bits_27_Value is mod 2 ** 27;
|
|
|
101 for Bits_27_Value'Size use 27;
|
|
|
102
|
|
|
103 type Unwind_Descriptor is record
|
|
|
104 cannot_unwind : Boolean;
|
|
|
105 mcode : Boolean;
|
|
|
106 mcode_save_restore : Boolean;
|
|
|
107 region_desc : Bits_2_Value;
|
|
|
108 reserved0 : Boolean;
|
|
|
109 entry_sr : Boolean;
|
|
|
110 entry_fr : Bits_4_Value;
|
|
|
111 entry_gr : Bits_5_Value;
|
|
|
112
|
|
|
113 args_stored : Boolean;
|
|
|
114 variable_frame : Boolean;
|
|
|
115 separate_package_body : Boolean;
|
|
|
116 frame_extension_mcode : Boolean;
|
|
|
117
|
|
|
118 stack_overflow_check : Boolean;
|
|
|
119 two_steps_sp_adjust : Boolean;
|
|
|
120 sr4_export : Boolean;
|
|
|
121 cxx_info : Boolean;
|
|
|
122
|
|
|
123 cxx_try_catch : Boolean;
|
|
|
124 sched_entry_seq : Boolean;
|
|
|
125 reserved1 : Boolean;
|
|
|
126 save_sp : Boolean;
|
|
|
127
|
|
|
128 save_rp : Boolean;
|
|
|
129 save_mrp : Boolean;
|
|
|
130 save_r19 : Boolean;
|
|
|
131 cleanups : Boolean;
|
|
|
132
|
|
|
133 hpe_interrupt_marker : Boolean;
|
|
|
134 hpux_interrupt_marker : Boolean;
|
|
|
135 large_frame : Boolean;
|
|
|
136 alloca_frame : Boolean;
|
|
|
137
|
|
|
138 reserved2 : Boolean;
|
|
|
139 frame_size : Bits_27_Value;
|
|
|
140 end record;
|
|
|
141
|
|
|
142 for Unwind_Descriptor'Size use 64;
|
|
|
143
|
|
|
144 for Unwind_Descriptor use record
|
|
|
145 cannot_unwind at 0 range 0 .. 0;
|
|
|
146 mcode at 0 range 1 .. 1;
|
|
|
147 mcode_save_restore at 0 range 2 .. 2;
|
|
|
148 region_desc at 0 range 3 .. 4;
|
|
|
149 reserved0 at 0 range 5 .. 5;
|
|
|
150 entry_sr at 0 range 6 .. 6;
|
|
|
151 entry_fr at 0 range 7 .. 10;
|
|
|
152
|
|
|
153 entry_gr at 1 range 3 .. 7;
|
|
|
154
|
|
|
155 args_stored at 2 range 0 .. 0;
|
|
|
156 variable_frame at 2 range 1 .. 1;
|
|
|
157 separate_package_body at 2 range 2 .. 2;
|
|
|
158 frame_extension_mcode at 2 range 3 .. 3;
|
|
|
159 stack_overflow_check at 2 range 4 .. 4;
|
|
|
160 two_steps_sp_adjust at 2 range 5 .. 5;
|
|
|
161 sr4_export at 2 range 6 .. 6;
|
|
|
162 cxx_info at 2 range 7 .. 7;
|
|
|
163
|
|
|
164 cxx_try_catch at 3 range 0 .. 0;
|
|
|
165 sched_entry_seq at 3 range 1 .. 1;
|
|
|
166 reserved1 at 3 range 2 .. 2;
|
|
|
167 save_sp at 3 range 3 .. 3;
|
|
|
168 save_rp at 3 range 4 .. 4;
|
|
|
169 save_mrp at 3 range 5 .. 5;
|
|
|
170 save_r19 at 3 range 6 .. 6;
|
|
|
171 cleanups at 3 range 7 .. 7;
|
|
|
172
|
|
|
173 hpe_interrupt_marker at 4 range 0 .. 0;
|
|
|
174 hpux_interrupt_marker at 4 range 1 .. 1;
|
|
|
175 large_frame at 4 range 2 .. 2;
|
|
|
176 alloca_frame at 4 range 3 .. 3;
|
|
|
177
|
|
|
178 reserved2 at 4 range 4 .. 4;
|
|
|
179 frame_size at 4 range 5 .. 31;
|
|
|
180 end record;
|
|
|
181
|
|
|
182 subtype UWD is Unwind_Descriptor;
|
|
|
183 type UWD_Ptr is access all UWD;
|
|
|
184
|
|
|
185 function To_UWD_Access is new Ada.Unchecked_Conversion (Address, UWD_Ptr);
|
|
|
186
|
|
|
187 -- The descriptor associated with a given code location is retrieved
|
|
|
188 -- using functions imported from the HP library, requiring the definition
|
|
|
189 -- of additional structures.
|
|
|
190
|
|
|
191 type Unwind_Table_Region is record
|
|
|
192 Table_Start : Address;
|
|
|
193 Table_End : Address;
|
|
|
194 end record;
|
|
|
195 -- An Unwind Table region, which is a memory area containing Unwind
|
|
|
196 -- Descriptors.
|
|
|
197
|
|
|
198 subtype UWT is Unwind_Table_Region;
|
|
|
199
|
|
|
200 -- The subprograms imported below are provided by the HP library
|
|
|
201
|
|
|
202 function U_get_unwind_table return UWT;
|
|
|
203 pragma Import (C, U_get_unwind_table, "U_get_unwind_table");
|
|
|
204 -- Get the unwind table region associated with the current executable.
|
|
|
205 -- This function is actually documented as having an argument, but which
|
|
|
206 -- is only used for the MPE/iX targets.
|
|
|
207
|
|
|
208 function U_get_shLib_unwind_table (r19 : Address) return UWT;
|
|
|
209 pragma Import (C, U_get_shLib_unwind_table, "U_get_shLib_unw_tbl");
|
|
|
210 -- Return the unwind table region associated with a possible shared
|
|
|
211 -- library, as determined by the provided r19 value.
|
|
|
212
|
|
|
213 function U_get_shLib_text_addr (r19 : Address) return Address;
|
|
|
214 pragma Import (C, U_get_shLib_text_addr, "U_get_shLib_text_addr");
|
|
|
215 -- Return the address at which the code for a shared library begins, or
|
|
|
216 -- -1 if the value provided for r19 does not identify shared library code.
|
|
|
217
|
|
|
218 function U_get_unwind_entry
|
|
|
219 (Pc : Address;
|
|
|
220 Space : Address;
|
|
|
221 Table_Start : Address;
|
|
|
222 Table_End : Address) return Address;
|
|
|
223 pragma Import (C, U_get_unwind_entry, "U_get_unwind_entry");
|
|
|
224 -- Given the bounds of an unwind table, return the address of the
|
|
|
225 -- unwind descriptor associated with a code location/space. In the case
|
|
|
226 -- of shared library code, the offset from the beginning of the library
|
|
|
227 -- is expected as Pc.
|
|
|
228
|
|
|
229 procedure U_init_frame_record (Frame : not null access CFD);
|
|
|
230 pragma Import (C, U_init_frame_record, "U_init_frame_record");
|
|
|
231
|
|
|
232 procedure U_prep_frame_rec_for_unwind (Frame : not null access CFD);
|
|
|
233 pragma Import (C, U_prep_frame_rec_for_unwind,
|
|
|
234 "U_prep_frame_rec_for_unwind");
|
|
|
235
|
|
|
236 -- Fetch the description data of the frame in which these two procedures
|
|
|
237 -- are called.
|
|
|
238
|
|
|
239 function U_get_u_rlo
|
|
|
240 (Cur : not null access CFD; Prev : not null access PFD) return Integer;
|
|
|
241 pragma Import (C, U_get_u_rlo, "U_IS_STUB_OR_CALLX");
|
|
|
242 -- From a complete current frame with a return location possibly located
|
|
|
243 -- into a linker generated stub, and basic information about the previous
|
|
|
244 -- frame, place the first non stub return location into the current frame.
|
|
|
245 -- Return -1 if something went wrong during the computation.
|
|
|
246
|
|
|
247 function U_is_shared_pc (rlo : Address; r19 : Address) return Address;
|
|
|
248 pragma Import (C, U_is_shared_pc, "U_is_shared_pc");
|
|
|
249 -- Return 0 if the provided return location does not correspond to code
|
|
|
250 -- in a shared library, or something non null otherwise.
|
|
|
251
|
|
|
252 function U_get_previous_frame_x
|
|
|
253 (current_frame : not null access CFD;
|
|
|
254 previous_frame : not null access PFD;
|
|
|
255 previous_size : Integer) return Integer;
|
|
|
256 pragma Import (C, U_get_previous_frame_x, "U_get_previous_frame_x");
|
|
|
257 -- Fetch the data describing the "previous" frame relatively to the
|
|
|
258 -- "current" one. "previous_size" should be the size of the "previous"
|
|
|
259 -- frame descriptor provided.
|
|
|
260 --
|
|
|
261 -- The library provides a simpler interface without the size parameter
|
|
|
262 -- but it is not usable when frames with dynamically allocated space are
|
|
|
263 -- on the way.
|
|
|
264
|
|
|
265 procedure Call_Chain
|
|
|
266 (Traceback : System.Address;
|
|
|
267 Max_Len : Natural;
|
|
|
268 Len : out Natural;
|
|
|
269 Exclude_Min : System.Address := System.Null_Address;
|
|
|
270 Exclude_Max : System.Address := System.Null_Address;
|
|
|
271 Skip_Frames : Natural := 1);
|
|
|
272 -- Same as the exported version, but takes Traceback as an Address
|
|
|
273
|
|
|
274 ------------------
|
|
|
275 -- C_Call_Chain --
|
|
|
276 ------------------
|
|
|
277
|
|
|
278 function C_Call_Chain
|
|
|
279 (Traceback : System.Address;
|
|
|
280 Max_Len : Natural) return Natural
|
|
|
281 is
|
|
|
282 Val : Natural;
|
|
|
283 begin
|
|
|
284 Call_Chain (Traceback, Max_Len, Val);
|
|
|
285 return Val;
|
|
|
286 end C_Call_Chain;
|
|
|
287
|
|
|
288 ----------------
|
|
|
289 -- Call_Chain --
|
|
|
290 ----------------
|
|
|
291
|
|
|
292 procedure Call_Chain
|
|
|
293 (Traceback : System.Address;
|
|
|
294 Max_Len : Natural;
|
|
|
295 Len : out Natural;
|
|
|
296 Exclude_Min : System.Address := System.Null_Address;
|
|
|
297 Exclude_Max : System.Address := System.Null_Address;
|
|
|
298 Skip_Frames : Natural := 1)
|
|
|
299 is
|
|
|
300 type Tracebacks_Array is array (1 .. Max_Len) of System.Address;
|
|
|
301 pragma Suppress_Initialization (Tracebacks_Array);
|
|
|
302
|
|
|
303 -- The code location returned by the unwinder is a return location but
|
|
|
304 -- what we need is a call point. Under HP-UX call instructions are 4
|
|
|
305 -- bytes long and the return point they specify is 4 bytes beyond the
|
|
|
306 -- next instruction because of the delay slot.
|
|
|
307
|
|
|
308 Call_Size : constant := 4;
|
|
|
309 DSlot_Size : constant := 4;
|
|
|
310 Rlo_Offset : constant := Call_Size + DSlot_Size;
|
|
|
311
|
|
|
312 -- Moreover, the return point is passed via a register which two least
|
|
|
313 -- significant bits specify a privilege level that we will have to mask.
|
|
|
314
|
|
|
315 Priv_Mask : constant := 16#00000003#;
|
|
|
316
|
|
|
317 Frame : aliased CFD;
|
|
|
318 Code : System.Address;
|
|
|
319 J : Natural := 1;
|
|
|
320 Pop_Success : Boolean;
|
|
|
321 Trace : Tracebacks_Array;
|
|
|
322 for Trace'Address use Traceback;
|
|
|
323
|
|
|
324 -- The backtracing process needs a set of subprograms :
|
|
|
325
|
|
|
326 function UWD_For_RLO_Of (Frame : not null access CFD) return UWD_Ptr;
|
|
|
327 -- Return an access to the unwind descriptor for the caller of
|
|
|
328 -- a given frame, using only the provided return location.
|
|
|
329
|
|
|
330 function UWD_For_Caller_Of (Frame : not null access CFD) return UWD_Ptr;
|
|
|
331 -- Return an access to the unwind descriptor for the user code caller
|
|
|
332 -- of a given frame, or null if the information is not available.
|
|
|
333
|
|
|
334 function Pop_Frame (Frame : not null access CFD) return Boolean;
|
|
|
335 -- Update the provided machine state structure so that it reflects
|
|
|
336 -- the state one call frame "above" the initial one.
|
|
|
337 --
|
|
|
338 -- Return True if the operation has been successful, False otherwise.
|
|
|
339 -- Failure typically occurs when the top of the call stack has been
|
|
|
340 -- reached.
|
|
|
341
|
|
|
342 function Prepare_For_Unwind_Of
|
|
|
343 (Frame : not null access CFD) return Boolean;
|
|
|
344 -- Perform the necessary adaptations to the machine state before
|
|
|
345 -- calling the unwinder. Currently used for the specific case of
|
|
|
346 -- dynamically sized previous frames.
|
|
|
347 --
|
|
|
348 -- Return True if everything went fine, or False otherwise.
|
|
|
349
|
|
|
350 Program_UWT : constant UWT := U_get_unwind_table;
|
|
|
351
|
|
|
352 ---------------
|
|
|
353 -- Pop_Frame --
|
|
|
354 ---------------
|
|
|
355
|
|
|
356 function Pop_Frame (Frame : not null access CFD) return Boolean is
|
|
|
357 Up_Frame : aliased PFD;
|
|
|
358 State_Ready : Boolean;
|
|
|
359
|
|
|
360 begin
|
|
|
361 -- Check/adapt the state before calling the unwinder and return
|
|
|
362 -- if anything went wrong.
|
|
|
363
|
|
|
364 State_Ready := Prepare_For_Unwind_Of (Frame);
|
|
|
365
|
|
|
366 if not State_Ready then
|
|
|
367 return False;
|
|
|
368 end if;
|
|
|
369
|
|
|
370 -- Now, safely call the unwinder and use the results
|
|
|
371
|
|
|
372 if U_get_previous_frame_x (Frame,
|
|
|
373 Up_Frame'Access,
|
|
|
374 Up_Frame'Size) /= 0
|
|
|
375 then
|
|
|
376 return False;
|
|
|
377 end if;
|
|
|
378
|
|
|
379 -- In case a stub is on the way, the usual previous return location
|
|
|
380 -- (the one in prev_rlo) is the one in the stub and the "real" one
|
|
|
381 -- is placed in the "current" record, so let's take this one into
|
|
|
382 -- account.
|
|
|
383
|
|
|
384 Frame.out_rlo := Frame.cur_rlo;
|
|
|
385
|
|
|
386 Frame.cur_fsz := Up_Frame.prev_fsz;
|
|
|
387 Frame.cur_sp := Up_Frame.prev_sp;
|
|
|
388 Frame.cur_rls := Up_Frame.prev_rls;
|
|
|
389 Frame.cur_rlo := Up_Frame.prev_rlo;
|
|
|
390 Frame.cur_dp := Up_Frame.prev_dp;
|
|
|
391 Frame.cur_r19 := Up_Frame.prev_r19;
|
|
|
392 Frame.top_r3 := Up_Frame.top_r3;
|
|
|
393 Frame.top_r4 := Up_Frame.top_r4;
|
|
|
394
|
|
|
395 return True;
|
|
|
396 end Pop_Frame;
|
|
|
397
|
|
131
|
398 ---------------------------
|
|
|
399 -- Prepare_For_Unwind_Of --
|
|
|
400 ---------------------------
|
|
111
|
401
|
|
|
402 function Prepare_For_Unwind_Of
|
|
|
403 (Frame : not null access CFD) return Boolean
|
|
|
404 is
|
|
|
405 Caller_UWD : UWD_Ptr;
|
|
|
406 FP_Adjustment : Integer;
|
|
|
407
|
|
|
408 begin
|
|
|
409 -- No need to bother doing anything if the stack is already fully
|
|
|
410 -- unwound.
|
|
|
411
|
|
|
412 if Frame.cur_rlo = 0 then
|
|
|
413 return False;
|
|
|
414 end if;
|
|
|
415
|
|
|
416 -- When ALLOCA_FRAME is set in an unwind descriptor, the unwinder
|
|
|
417 -- uses the value provided in current.top_r3 or current.top_r4 as
|
|
|
418 -- a frame pointer to compute the size of the frame. What decides
|
|
|
419 -- between r3 or r4 is the unwind descriptor LARGE_FRAME bit, with
|
|
|
420 -- r4 chosen if the bit is set.
|
|
|
421
|
|
|
422 -- The size computed by the unwinder is STATIC_PART + (SP - FP),
|
|
|
423 -- which is correct with HP's frame pointer convention, but not
|
|
|
424 -- with GCC's one since we end up with the static part accounted
|
|
|
425 -- for twice.
|
|
|
426
|
|
|
427 -- We have to compute r4 when it is required because the unwinder
|
|
|
428 -- has looked for it at a place where it was not if we went through
|
|
|
429 -- GCC frames.
|
|
|
430
|
|
|
431 -- The size of the static part of a frame can be found in the
|
|
|
432 -- associated unwind descriptor.
|
|
|
433
|
|
|
434 Caller_UWD := UWD_For_Caller_Of (Frame);
|
|
|
435
|
|
|
436 -- If we cannot get it, we are unable to compute the potentially
|
|
|
437 -- necessary adjustments. We'd better not try to go on then.
|
|
|
438
|
|
|
439 if Caller_UWD = null then
|
|
|
440 return False;
|
|
|
441 end if;
|
|
|
442
|
|
|
443 -- If the caller frame is a GCC one, r3 is its frame pointer and
|
|
|
444 -- points to the bottom of the frame. The value to provide for r4
|
|
|
445 -- can then be computed directly from the one of r3, compensating
|
|
|
446 -- for the static part of the frame.
|
|
|
447
|
|
|
448 -- If the caller frame is an HP one, r3 is used to locate the
|
|
|
449 -- previous frame marker, that is it also points to the bottom of
|
|
|
450 -- the frame (this is why r3 cannot be used as the frame pointer in
|
|
|
451 -- the HP sense for large frames). The value to provide for r4 can
|
|
|
452 -- then also be computed from the one of r3 with the compensation
|
|
|
453 -- for the static part of the frame.
|
|
|
454
|
|
|
455 FP_Adjustment := Integer (Caller_UWD.frame_size * 8);
|
|
|
456 Frame.top_r4 := Address (Integer (Frame.top_r3) + FP_Adjustment);
|
|
|
457
|
|
|
458 return True;
|
|
|
459 end Prepare_For_Unwind_Of;
|
|
|
460
|
|
|
461 -----------------------
|
|
|
462 -- UWD_For_Caller_Of --
|
|
|
463 -----------------------
|
|
|
464
|
|
|
465 function UWD_For_Caller_Of (Frame : not null access CFD) return UWD_Ptr
|
|
|
466 is
|
|
|
467 UWD_Access : UWD_Ptr;
|
|
|
468
|
|
|
469 begin
|
|
|
470 -- First try the most direct path, using the return location data
|
|
|
471 -- associated with the frame.
|
|
|
472
|
|
|
473 UWD_Access := UWD_For_RLO_Of (Frame);
|
|
|
474
|
|
|
475 if UWD_Access /= null then
|
|
|
476 return UWD_Access;
|
|
|
477 end if;
|
|
|
478
|
|
|
479 -- If we did not get a result, we might face an in-stub return
|
|
|
480 -- address. In this case U_get_previous_frame can tell us what the
|
|
|
481 -- first not-in-stub return point is. We cannot call it directly,
|
|
|
482 -- though, because we haven't computed the potentially necessary
|
|
|
483 -- frame pointer adjustments, which might lead to SEGV in some
|
|
|
484 -- circumstances. Instead, we directly call the libcl routine which
|
|
|
485 -- is called by U_get_previous_frame and which only requires few
|
|
|
486 -- information. Take care, however, that the information is provided
|
|
|
487 -- in the "current" argument, so we need to work on a copy to avoid
|
|
|
488 -- disturbing our caller.
|
|
|
489
|
|
|
490 declare
|
|
|
491 U_Current : aliased CFD := Frame.all;
|
|
|
492 U_Previous : aliased PFD;
|
|
|
493
|
|
|
494 begin
|
|
|
495 U_Previous.prev_dp := U_Current.cur_dp;
|
|
|
496 U_Previous.prev_rls := U_Current.cur_rls;
|
|
|
497 U_Previous.prev_sp := U_Current.cur_sp - U_Current.cur_fsz;
|
|
|
498
|
|
|
499 if U_get_u_rlo (U_Current'Access, U_Previous'Access) /= -1 then
|
|
|
500 UWD_Access := UWD_For_RLO_Of (U_Current'Access);
|
|
|
501 end if;
|
|
|
502 end;
|
|
|
503
|
|
|
504 return UWD_Access;
|
|
|
505 end UWD_For_Caller_Of;
|
|
|
506
|
|
|
507 --------------------
|
|
|
508 -- UWD_For_RLO_Of --
|
|
|
509 --------------------
|
|
|
510
|
|
|
511 function UWD_For_RLO_Of (Frame : not null access CFD) return UWD_Ptr
|
|
|
512 is
|
|
|
513 UWD_Address : Address;
|
|
|
514
|
|
|
515 -- The addresses returned by the library point to full descriptors
|
|
|
516 -- including the frame information bits but also the applicable PC
|
|
|
517 -- range. We need to account for this.
|
|
|
518
|
|
|
519 Frame_Info_Offset : constant := 8;
|
|
|
520
|
|
|
521 begin
|
|
|
522 -- First try to locate the descriptor in the program's unwind table
|
|
|
523
|
|
|
524 UWD_Address := U_get_unwind_entry (Frame.cur_rlo,
|
|
|
525 Frame.cur_rls,
|
|
|
526 Program_UWT.Table_Start,
|
|
|
527 Program_UWT.Table_End);
|
|
|
528
|
|
|
529 -- If we did not get it, we might have a frame from code in a
|
|
|
530 -- stub or shared library. For code in stub we would have to
|
|
|
531 -- compute the first non-stub return location but this is not
|
|
|
532 -- the role of this subprogram, so let's just try to see if we
|
|
|
533 -- can get a result from the tables in shared libraries.
|
|
|
534
|
|
|
535 if UWD_Address = -1
|
|
|
536 and then U_is_shared_pc (Frame.cur_rlo, Frame.cur_r19) /= 0
|
|
|
537 then
|
|
|
538 declare
|
|
|
539 Shlib_UWT : constant UWT :=
|
|
|
540 U_get_shLib_unwind_table (Frame.cur_r19);
|
|
|
541 Shlib_Start : constant Address :=
|
|
|
542 U_get_shLib_text_addr (Frame.cur_r19);
|
|
|
543 Rlo_Offset : constant Address :=
|
|
|
544 Frame.cur_rlo - Shlib_Start;
|
|
|
545 begin
|
|
|
546 UWD_Address := U_get_unwind_entry (Rlo_Offset,
|
|
|
547 Frame.cur_rls,
|
|
|
548 Shlib_UWT.Table_Start,
|
|
|
549 Shlib_UWT.Table_End);
|
|
|
550 end;
|
|
|
551 end if;
|
|
|
552
|
|
|
553 if UWD_Address /= -1 then
|
|
|
554 return To_UWD_Access (UWD_Address + Frame_Info_Offset);
|
|
|
555 else
|
|
|
556 return null;
|
|
|
557 end if;
|
|
|
558 end UWD_For_RLO_Of;
|
|
|
559
|
|
|
560 -- Start of processing for Call_Chain
|
|
|
561
|
|
|
562 begin
|
|
|
563 -- Fetch the state for this subprogram's frame and pop it so that we
|
|
|
564 -- start with an initial out_rlo "here".
|
|
|
565
|
|
|
566 U_init_frame_record (Frame'Access);
|
|
|
567 Frame.top_sr0 := 0;
|
|
|
568 Frame.top_sr4 := 0;
|
|
|
569
|
|
|
570 U_prep_frame_rec_for_unwind (Frame'Access);
|
|
|
571
|
|
|
572 Pop_Success := Pop_Frame (Frame'Access);
|
|
|
573
|
|
|
574 -- Skip the requested number of frames
|
|
|
575
|
|
|
576 for I in 1 .. Skip_Frames loop
|
|
|
577 Pop_Success := Pop_Frame (Frame'Access);
|
|
|
578 end loop;
|
|
|
579
|
|
|
580 -- Loop popping frames and storing locations until either a problem
|
|
|
581 -- occurs, or the top of the call chain is reached, or the provided
|
|
|
582 -- array is full.
|
|
|
583
|
|
|
584 loop
|
|
|
585 -- We have to test some conditions against the return location
|
|
|
586 -- as it is returned, so get it as is first.
|
|
|
587
|
|
|
588 Code := Frame.out_rlo;
|
|
|
589
|
|
|
590 exit when not Pop_Success or else Code = 0 or else J = Max_Len + 1;
|
|
|
591
|
|
|
592 -- Compute the call point from the retrieved return location :
|
|
|
593 -- Mask the privilege bits and account for the delta between the
|
|
|
594 -- call site and the return point.
|
|
|
595
|
|
|
596 Code := (Code and not Priv_Mask) - Rlo_Offset;
|
|
|
597
|
|
|
598 if Code < Exclude_Min or else Code > Exclude_Max then
|
|
|
599 Trace (J) := Code;
|
|
|
600 J := J + 1;
|
|
|
601 end if;
|
|
|
602
|
|
|
603 Pop_Success := Pop_Frame (Frame'Access);
|
|
|
604 end loop;
|
|
|
605
|
|
|
606 Len := J - 1;
|
|
|
607 end Call_Chain;
|
|
|
608
|
|
|
609 procedure Call_Chain
|
|
|
610 (Traceback : in out System.Traceback_Entries.Tracebacks_Array;
|
|
|
611 Max_Len : Natural;
|
|
|
612 Len : out Natural;
|
|
|
613 Exclude_Min : System.Address := System.Null_Address;
|
|
|
614 Exclude_Max : System.Address := System.Null_Address;
|
|
|
615 Skip_Frames : Natural := 1)
|
|
|
616 is
|
|
|
617 begin
|
|
|
618 Call_Chain
|
|
|
619 (Traceback'Address, Max_Len, Len,
|
|
|
620 Exclude_Min, Exclude_Max,
|
|
|
621
|
|
|
622 -- Skip one extra frame to skip the other Call_Chain entry as well
|
|
|
623
|
|
|
624 Skip_Frames => Skip_Frames + 1);
|
|
|
625 end Call_Chain;
|
|
|
626
|
|
|
627 end System.Traceback;
|
