250 lines
7.9 KiB
OCaml
250 lines
7.9 KiB
OCaml
(**************************************************************************)
|
|
(* *)
|
|
(* 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. *)
|
|
(* *)
|
|
(**************************************************************************)
|
|
|
|
open Input_handling
|
|
open Question
|
|
open Command_line
|
|
open Debugger_config
|
|
open Checkpoints
|
|
open Time_travel
|
|
open Parameters
|
|
open Program_management
|
|
open Frames
|
|
open Show_information
|
|
open Format
|
|
open Primitives
|
|
|
|
let line_buffer = Lexing.from_function read_user_input
|
|
|
|
let loop ppf = line_loop ppf line_buffer; stop_user_input ()
|
|
|
|
let current_duration = ref (-1L)
|
|
|
|
let rec protect ppf restart loop =
|
|
try
|
|
loop ppf
|
|
with
|
|
| End_of_file ->
|
|
protect ppf restart (function ppf ->
|
|
forget_process
|
|
!current_checkpoint.c_fd
|
|
!current_checkpoint.c_pid;
|
|
pp_print_flush ppf ();
|
|
stop_user_input ();
|
|
restart ppf)
|
|
| Toplevel ->
|
|
protect ppf restart (function ppf ->
|
|
pp_print_flush ppf ();
|
|
stop_user_input ();
|
|
restart ppf)
|
|
| Sys.Break ->
|
|
protect ppf restart (function ppf ->
|
|
fprintf ppf "Interrupted.@.";
|
|
Exec.protect (function () ->
|
|
stop_user_input ();
|
|
if !loaded then begin
|
|
try_select_frame 0;
|
|
show_current_event ppf;
|
|
end);
|
|
restart ppf)
|
|
| Current_checkpoint_lost ->
|
|
protect ppf restart (function ppf ->
|
|
fprintf ppf "Trying to recover...@.";
|
|
stop_user_input ();
|
|
recover ();
|
|
try_select_frame 0;
|
|
show_current_event ppf;
|
|
restart ppf)
|
|
| Current_checkpoint_lost_start_at (time, init_duration) ->
|
|
protect ppf restart (function ppf ->
|
|
let b =
|
|
if !current_duration = -1L then begin
|
|
let msg = sprintf "Restart from time %Ld and try to get \
|
|
closer of the problem" time in
|
|
stop_user_input ();
|
|
if yes_or_no msg then
|
|
(current_duration := init_duration; true)
|
|
else
|
|
false
|
|
end
|
|
else
|
|
true in
|
|
if b then
|
|
begin
|
|
go_to time;
|
|
current_duration := Int64.div !current_duration 10L;
|
|
if !current_duration > 0L then
|
|
while true do
|
|
step !current_duration
|
|
done
|
|
else begin
|
|
current_duration := -1L;
|
|
stop_user_input ();
|
|
show_current_event ppf;
|
|
restart ppf;
|
|
end
|
|
end
|
|
else
|
|
begin
|
|
recover ();
|
|
show_current_event ppf;
|
|
restart ppf
|
|
end)
|
|
| x ->
|
|
cleanup x kill_program
|
|
|
|
let execute_file_if_any () =
|
|
let buffer = Buffer.create 128 in
|
|
begin
|
|
try
|
|
let base = ".ocamldebug" in
|
|
let file =
|
|
if Sys.file_exists base then
|
|
base
|
|
else
|
|
Filename.concat (Sys.getenv "HOME") base in
|
|
let ch = open_in file in
|
|
fprintf Format.std_formatter "Executing file %s@." file;
|
|
while true do
|
|
let line = string_trim (input_line ch) in
|
|
if line <> "" && line.[0] <> '#' then begin
|
|
Buffer.add_string buffer line;
|
|
Buffer.add_char buffer '\n'
|
|
end
|
|
done;
|
|
with _ -> ()
|
|
end;
|
|
let len = Buffer.length buffer in
|
|
if len > 0 then
|
|
let commands = Buffer.sub buffer 0 (pred len) in
|
|
line_loop Format.std_formatter (Lexing.from_string commands);
|
|
stop_user_input ()
|
|
|
|
let toplevel_loop () =
|
|
interactif := false;
|
|
current_prompt := "";
|
|
execute_file_if_any ();
|
|
interactif := true;
|
|
current_prompt := debugger_prompt;
|
|
protect Format.std_formatter loop loop
|
|
|
|
(* Parsing of command-line arguments *)
|
|
|
|
exception Found_program_name
|
|
|
|
let anonymous s =
|
|
program_name := Unix_tools.make_absolute s; raise Found_program_name
|
|
let add_include d =
|
|
default_load_path :=
|
|
Misc.expand_directory Config.standard_library d :: !default_load_path
|
|
let set_socket s =
|
|
socket_name := s
|
|
let set_topdirs_path s =
|
|
topdirs_path := s
|
|
let set_checkpoints n =
|
|
checkpoint_max_count := n
|
|
let set_directory dir =
|
|
Sys.chdir dir
|
|
let print_version () =
|
|
printf "The OCaml debugger, version %s@." Sys.ocaml_version;
|
|
exit 0;
|
|
;;
|
|
let print_version_num () =
|
|
printf "%s@." Sys.ocaml_version;
|
|
exit 0;
|
|
;;
|
|
|
|
let speclist = [
|
|
"-c", Arg.Int set_checkpoints,
|
|
"<count> Set max number of checkpoints kept";
|
|
"-cd", Arg.String set_directory,
|
|
"<dir> Change working directory";
|
|
"-emacs", Arg.Tuple [Arg.Set emacs; Arg.Set machine_readable],
|
|
"For running the debugger under emacs; implies -machine-readable";
|
|
"-I", Arg.String add_include,
|
|
"<dir> Add <dir> to the list of include directories";
|
|
"-machine-readable", Arg.Set machine_readable,
|
|
"Print information in a format more suitable for machines";
|
|
"-s", Arg.String set_socket,
|
|
"<filename> Set the name of the communication socket";
|
|
"-version", Arg.Unit print_version,
|
|
" Print version and exit";
|
|
"-vnum", Arg.Unit print_version_num,
|
|
" Print version number and exit";
|
|
"-no-version", Arg.Clear Parameters.version,
|
|
" Do not print version at startup";
|
|
"-no-prompt", Arg.Clear Parameters.prompt,
|
|
" Suppress all prompts";
|
|
"-no-time", Arg.Clear Parameters.time,
|
|
" Do not print times";
|
|
"-no-breakpoint-message", Arg.Clear Parameters.breakpoint,
|
|
" Do not print message at breakpoint setup and removal";
|
|
"-topdirs-path", Arg.String set_topdirs_path,
|
|
" Set path to the directory containing topdirs.cmi";
|
|
]
|
|
|
|
let function_placeholder () =
|
|
raise Not_found
|
|
|
|
let report report_error error =
|
|
eprintf "Debugger [version %s] environment error:@ @[@;%a@]@.;"
|
|
Config.version report_error error
|
|
|
|
let main () =
|
|
Callback.register "Debugger.function_placeholder" function_placeholder;
|
|
try
|
|
socket_name :=
|
|
(match Sys.os_type with
|
|
"Win32" ->
|
|
(Unix.string_of_inet_addr Unix.inet_addr_loopback)^
|
|
":"^
|
|
(Int.to_string (10000 + ((Unix.getpid ()) mod 10000)))
|
|
| _ -> Filename.concat (Filename.get_temp_dir_name ())
|
|
("camldebug" ^ (Int.to_string (Unix.getpid ())))
|
|
);
|
|
begin try
|
|
Arg.parse speclist anonymous "";
|
|
Arg.usage speclist
|
|
"No program name specified\n\
|
|
Usage: ocamldebug [options] <program> [arguments]\n\
|
|
Options are:";
|
|
exit 2
|
|
with Found_program_name ->
|
|
for j = !Arg.current + 1 to Array.length Sys.argv - 1 do
|
|
arguments := !arguments ^ " " ^ (Filename.quote Sys.argv.(j))
|
|
done
|
|
end;
|
|
if !Parameters.version
|
|
then printf "\tOCaml Debugger version %s@.@." Config.version;
|
|
Loadprinter.init();
|
|
Load_path.init !default_load_path;
|
|
Clflags.recursive_types := true; (* Allow recursive types. *)
|
|
toplevel_loop (); (* Toplevel. *)
|
|
kill_program ();
|
|
exit 0
|
|
with
|
|
| Toplevel ->
|
|
exit 2
|
|
| Persistent_env.Error e ->
|
|
report Persistent_env.report_error e;
|
|
exit 2
|
|
| Cmi_format.Error e ->
|
|
report Cmi_format.report_error e;
|
|
exit 2
|
|
|
|
let _ =
|
|
Unix.handle_unix_error main ()
|