1996-11-29 08:55:09 -08:00
|
|
|
(***********************************************************************)
|
|
|
|
(* *)
|
|
|
|
(* 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 *)
|
1999-11-17 10:59:06 -08:00
|
|
|
(* en Automatique. All rights reserved. This file is distributed *)
|
|
|
|
(* under the terms of the Q Public License version 1.0. *)
|
1996-11-29 08:55:09 -08:00
|
|
|
(* *)
|
|
|
|
(***********************************************************************)
|
|
|
|
|
|
|
|
(* $Id$ *)
|
|
|
|
|
|
|
|
open Instruct
|
1999-11-08 09:06:33 -08:00
|
|
|
open Formatmsg
|
1996-11-29 08:55:09 -08:00
|
|
|
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
|
1997-05-19 08:42:21 -07:00
|
|
|
print_string (" - module " ^ mdle);
|
|
|
|
print_newline ();
|
|
|
|
(match breakpoints_at_pc pc with
|
|
|
|
[] ->
|
|
|
|
()
|
|
|
|
| [breakpoint] ->
|
|
|
|
print_string "Breakpoint : "; print_int breakpoint;
|
1996-11-29 08:55:09 -08:00
|
|
|
print_newline ()
|
1997-05-19 08:42:21 -07:00
|
|
|
| breakpoints ->
|
|
|
|
print_string "Breakpoints : ";
|
|
|
|
List.iter
|
1997-03-23 07:23:31 -08:00
|
|
|
(function x -> print_int x; print_string " ")
|
1997-03-27 13:08:52 -08:00
|
|
|
(Sort.list (<) breakpoints);
|
1997-05-19 08:42:21 -07:00
|
|
|
print_newline ());
|
1996-11-29 08:55:09 -08:00
|
|
|
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} ->
|
2000-02-08 12:00:06 -08:00
|
|
|
printf "@.Program end.@.";
|
|
|
|
printf "@[Uncaught exception:@ ";
|
1997-03-23 07:23:31 -08:00
|
|
|
Printval.print_exception (Debugcom.Remote_value.accu ());
|
2000-02-08 12:00:06 -08:00
|
|
|
printf"@]@.";
|
1996-11-29 08:55:09 -08:00
|
|
|
show_no_point ()
|
|
|
|
| Some {rep_type = Trap_barrier} ->
|
1997-05-19 08:42:21 -07:00
|
|
|
(* Trap_barrier not visible outside *)
|
|
|
|
(* of module `time_travel'. *)
|
1996-11-29 08:55:09 -08:00
|
|
|
Misc.fatal_error "Show_information.show_current_event"
|
|
|
|
|
|
|
|
(* Display short information about one frame. *)
|
|
|
|
|
|
|
|
let show_one_frame framenum event =
|
2000-02-08 12:00:06 -08:00
|
|
|
printf "#%i Pc : %i %s char %i@."
|
|
|
|
framenum event.ev_pos event.ev_module event.ev_char
|
1996-11-29 08:55:09 -08:00
|
|
|
|
|
|
|
(* 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 ->
|
2000-02-08 12:00:06 -08:00
|
|
|
printf "@.No frame selected.@."
|
1996-11-29 08:55:09 -08:00
|
|
|
| Some sel_ev ->
|
|
|
|
show_one_frame !current_frame sel_ev;
|
|
|
|
begin match breakpoints_at_pc sel_ev.ev_pos with
|
|
|
|
[] ->
|
|
|
|
()
|
|
|
|
| [breakpoint] ->
|
2000-02-08 12:00:06 -08:00
|
|
|
printf "Breakpoint : %i@." breakpoint
|
1996-11-29 08:55:09 -08:00
|
|
|
| breakpoints ->
|
2000-02-08 12:00:06 -08:00
|
|
|
printf "Breakpoints : ";
|
|
|
|
List.iter (function x -> printf "%i " x) (Sort.list (<) breakpoints);
|
1996-11-29 08:55:09 -08:00
|
|
|
print_newline ()
|
|
|
|
end;
|
1997-02-19 08:09:23 -08:00
|
|
|
show_point sel_ev.ev_module sel_ev.ev_char
|
1996-11-29 08:55:09 -08:00
|
|
|
(selected_event_is_before ()) selected
|