package / ocaml-base-compiler.4.10.0 / debugger / show_information.ml
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 open Instruct
18 open Format
19 open Debugcom
20 open Checkpoints
21 open Events
22 open Symbols
23 open Frames
24 open Source
25 open Show_source
26 open Breakpoints
27 open Parameters
28
29 (* Display information about the current event. *)
30 let show_current_event ppf =
31 if !Parameters.time then begin
32 fprintf ppf "Time: %Li" (current_time ());
33 (match current_pc () with
34 | Some pc ->
35 fprintf ppf " - pc: %i:%i" pc.frag pc.pos
36 | _ -> ());
37 end;
38 update_current_event ();
39 reset_frame ();
40 match current_report () with
41 | None ->
42 if !Parameters.time then fprintf ppf "@.";
43 fprintf ppf "Beginning of program.@.";
44 show_no_point ()
45 | Some {rep_type = (Event | Breakpoint); rep_program_pointer = pc} ->
46 let ev = (get_current_event ()).ev_ev in
47 if !Parameters.time then fprintf ppf " - module %s@." ev.ev_module;
48 (match breakpoints_at_pc pc with
49 | [] ->
50 ()
51 | [breakpoint] ->
52 fprintf ppf "Breakpoint: %i@." breakpoint
53 | breakpoints ->
54 fprintf ppf "Breakpoints: %a@."
55 (fun ppf l ->
56 List.iter
57 (function x -> fprintf ppf "%i " x) l)
58 (List.sort compare breakpoints));
59 show_point ev true
60 | Some {rep_type = Exited} ->
61 if !Parameters.time then fprintf ppf "@.";
62 fprintf ppf "Program exit.@.";
63 show_no_point ()
64 | Some {rep_type = Uncaught_exc} ->
65 if !Parameters.time then fprintf ppf "@.";
66 fprintf ppf
67 "Program end.@.\
68 @[Uncaught exception:@ %a@]@."
69 Printval.print_exception (Debugcom.Remote_value.accu ());
70 show_no_point ()
71 | Some {rep_type = Code_loaded frag} ->
72 let mds = String.concat ", " (Symbols.modules_in_code_fragment frag) in
73 fprintf ppf "@.Module(s) %s loaded.@." mds;
74 show_no_point ()
75 | Some {rep_type = Trap_barrier}
76 | Some {rep_type = Debug_info _}
77 | Some {rep_type = Code_unloaded _} ->
78 (* Not visible outside *)
79 (* of module `time_travel'. *)
80 if !Parameters.time then fprintf ppf "@.";
81 Misc.fatal_error "Show_information.show_current_event"
82
83 (* Display short information about one frame. *)
84
85 let show_one_frame framenum ppf ev =
86 let pos = Events.get_pos ev.ev_ev in
87 let cnum =
88 try
89 let buffer = get_buffer pos ev.ev_ev.ev_module in
90 snd (start_and_cnum buffer pos)
91 with _ -> pos.Lexing.pos_cnum in
92 if !machine_readable then
93 fprintf ppf "#%i Pc: %i:%i %s char %i@."
94 framenum ev.ev_frag ev.ev_ev.ev_pos ev.ev_ev.ev_module
95 cnum
96 else
97 fprintf ppf "#%i %s %s:%i:%i@."
98 framenum ev.ev_ev.ev_module
99 pos.Lexing.pos_fname pos.Lexing.pos_lnum
100 (pos.Lexing.pos_cnum - pos.Lexing.pos_bol + 1)
101
102 (* Display information about the current frame. *)
103 (* --- `select frame' must have succeeded before calling this function. *)
104 let show_current_frame ppf selected =
105 match !selected_event with
106 | None ->
107 fprintf ppf "@.No frame selected.@."
108 | Some sel_ev ->
109 show_one_frame !current_frame ppf sel_ev;
110 begin match breakpoints_at_pc
111 {frag=sel_ev.ev_frag; pos = sel_ev.ev_ev.ev_pos} with
112 | [] -> ()
113 | [breakpoint] ->
114 fprintf ppf "Breakpoint: %i@." breakpoint
115 | breakpoints ->
116 fprintf ppf "Breakpoints: %a@."
117 (fun ppf l ->
118 List.iter (function x -> fprintf ppf "%i " x) l)
119 (List.sort compare breakpoints);
120 end;
121 show_point sel_ev.ev_ev selected
122