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
129
130
|
(**************************************************************************)
(* *)
(* OCaml *)
(* *)
(* Jerome Vouillon, projet Cristal, INRIA Rocquencourt *)
(* OCaml 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 GNU Lesser General Public License version 2.1, with the *)
(* special exception on linking described in the file LICENSE. *)
(* *)
(**************************************************************************)
(***************************** Frames **********************************)
open Instruct
open Debugcom
open Events
open Symbols
(* Current frame number *)
let current_frame = ref 0
(* Event at selected position *)
let selected_event = ref (None : code_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_ev=ev} ->
(ev.ev_module,
(Events.get_pos ev).Lexing.pos_lnum,
(Events.get_pos ev).Lexing.pos_cnum - (Events.get_pos ev).Lexing.pos_bol)
let selected_event_is_before () =
match !selected_event with
None ->
raise Not_found
| Some {ev_ev={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_ev.ev_stacksize in
if sp = Sp.null 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 =
if frame_number < 0 then raise Not_found;
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 ev ->
let (initial_sp, _) = get_frame() in
set_initial_frame();
let event = ref ev in
begin try
while action (Some !event) do
let (sp, pc) = up_frame !event.ev_ev.ev_stacksize in
if sp = Sp.null 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
|
