blob: f68f1b6b96ff1ab6ad9a5e49d5258dc39062b2f0 (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
|
(***********************************************************************)
(* *)
(* Objective Caml *)
(* *)
(* Jerome Vouillon, projet Cristal, INRIA Rocquencourt *)
(* Objective Caml port by John Malecki and Xavier Leroy *)
(* *)
(* Copyright 1996 Institut National de Recherche en Informatique et *)
(* en Automatique. All rights reserved. This file is distributed *)
(* under the terms of the Q Public License version 1.0. *)
(* *)
(***********************************************************************)
(* $Id$ *)
(***************************** Frames **********************************)
open Instruct
open Primitives
open Debugcom
open Checkpoints
open Events
open Symbols
(* Current frame number *)
let current_frame = ref 0
(* Event at selected position *)
let selected_event = ref (None : debug_event option)
(* Selected position in source. *)
(* Raise `Not_found' if not on an event. *)
let selected_point () =
match !selected_event with
None ->
raise Not_found
| Some {ev_char = point; ev_module = mdle} ->
(mdle, point)
let selected_event_is_before () =
match !selected_event with
None ->
raise Not_found
| Some {ev_kind = Event_before} ->
true
| _ ->
false
(* Move up `frame_count' frames, assuming current frame pointer
corresponds to event `event'. Return event of final frame. *)
let rec move_up frame_count event =
if frame_count <= 0 then event else begin
let (sp, pc) = up_frame event.ev_stacksize in
if sp < 0 then raise Not_found;
move_up (frame_count - 1) (any_event_at_pc pc)
end
(* Select a frame. *)
(* Raise `Not_found' if no such frame. *)
(* --- Assume the current events have already been updated. *)
let select_frame frame_number =
let (initial_sp, _) = get_frame() in
try
match !current_event with
None ->
raise Not_found
| Some curr_event ->
match !selected_event with
Some sel_event when frame_number >= !current_frame ->
selected_event :=
Some(move_up (frame_number - !current_frame) sel_event);
current_frame := frame_number
| _ ->
set_initial_frame();
selected_event := Some(move_up frame_number curr_event);
current_frame := frame_number
with Not_found ->
set_frame initial_sp;
raise Not_found
(* Select a frame. *)
(* Same as `select_frame' but raise no exception if the frame is not found. *)
(* --- Assume the currents events have already been updated. *)
let try_select_frame frame_number =
try
select_frame frame_number
with
Not_found ->
()
(* Return to default frame (frame 0). *)
let reset_frame () =
set_initial_frame();
selected_event := !current_event;
current_frame := 0
(* Perform a stack backtrace.
Call the given function with the events for each stack frame,
or None if we've encountered a stack frame with no debugging info
attached. Stop when the function returns false, or frame with no
debugging info reached, or top of stack reached. *)
let do_backtrace action =
match !current_event with
None -> Misc.fatal_error "Frames.do_backtrace"
| Some curr_ev ->
let (initial_sp, _) = get_frame() in
set_initial_frame();
let event = ref curr_ev in
begin try
while action (Some !event) do
let (sp, pc) = up_frame !event.ev_stacksize in
if sp < 0 then raise Exit;
event := any_event_at_pc pc
done
with Exit -> ()
| Not_found -> ignore (action None)
end;
set_frame initial_sp
(* Return the number of frames in the stack *)
let stack_depth () =
let num_frames = ref 0 in
do_backtrace (function Some ev -> incr num_frames; true
| None -> num_frames := -1; false);
!num_frames
|
