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