blob: 487fdacb55cfb90c081277dea1e1a3e50434e6e3 (
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
|
(***********************************************************************)
(* *)
(* 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 *)
(* Automatique. Distributed only by permission. *)
(* *)
(***********************************************************************)
(* $Id$ *)
open Instruct
open Formatmsg
open Primitives
open Debugcom
open Checkpoints
open Events
open Symbols
open Frames
open Show_source
open Breakpoints
(* Display information about the current event. *)
let show_current_event () =
print_string "Time : "; print_int (current_time ());
(match current_pc () with
Some pc ->
print_string " - pc : "; print_int pc
| _ -> ());
update_current_event ();
reset_frame ();
match current_report () with
None ->
print_newline ();
print_string "Beginning of program."; print_newline ();
show_no_point ()
| Some {rep_type = (Event | Breakpoint); rep_program_pointer = pc} ->
let (mdle, point) = current_point () in
print_string (" - module " ^ mdle);
print_newline ();
(match breakpoints_at_pc pc with
[] ->
()
| [breakpoint] ->
print_string "Breakpoint : "; print_int breakpoint;
print_newline ()
| breakpoints ->
print_string "Breakpoints : ";
List.iter
(function x -> print_int x; print_string " ")
(Sort.list (<) breakpoints);
print_newline ());
show_point mdle point (current_event_is_before ()) true
| Some {rep_type = Exited} ->
print_newline (); print_string "Program exit."; print_newline ();
show_no_point ()
| Some {rep_type = Uncaught_exc} ->
print_newline ();
print_string "Program end.";
print_newline ();
open_box 0;
print_string "Uncaught exception:"; print_space();
Printval.print_exception (Debugcom.Remote_value.accu ());
close_box();
print_newline();
show_no_point ()
| Some {rep_type = Trap_barrier} ->
(* Trap_barrier not visible outside *)
(* of module `time_travel'. *)
Misc.fatal_error "Show_information.show_current_event"
(* Display short information about one frame. *)
let show_one_frame framenum event =
print_string "#";
print_int framenum;
print_string " Pc : ";
print_int event.ev_pos;
print_string " ";
print_string event.ev_module;
print_string " char ";
print_int event.ev_char;
print_newline ()
(* Display information about the current frame. *)
(* --- `select frame' must have succeded before calling this function. *)
let show_current_frame selected =
match !selected_event with
None ->
print_newline ();
print_string "No frame selected.";
print_newline ()
| Some sel_ev ->
show_one_frame !current_frame sel_ev;
begin match breakpoints_at_pc sel_ev.ev_pos with
[] ->
()
| [breakpoint] ->
print_string "Breakpoint : "; print_int breakpoint; print_newline ()
| breakpoints ->
print_string "Breakpoints : ";
List.iter (function x -> print_int x; print_string " ")
(Sort.list (<) breakpoints);
print_newline ()
end;
show_point sel_ev.ev_module sel_ev.ev_char
(selected_event_is_before ()) selected
|
