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 Primitives
|
|
|
|
open Misc
|
|
|
|
open Input_handling
|
1997-05-08 11:00:18 -07:00
|
|
|
open Command_line
|
1996-11-29 08:55:09 -08:00
|
|
|
open Debugger_config
|
|
|
|
open Checkpoints
|
|
|
|
open Time_travel
|
|
|
|
open Parameters
|
|
|
|
open Program_management
|
|
|
|
open Frames
|
|
|
|
open Show_information
|
2000-03-21 07:16:28 -08:00
|
|
|
open Format
|
1996-11-29 08:55:09 -08:00
|
|
|
|
1997-03-22 15:28:07 -08:00
|
|
|
let line_buffer = Lexing.from_function read_user_input
|
|
|
|
|
2000-03-07 10:22:19 -08:00
|
|
|
let rec loop ppf =
|
|
|
|
line_loop ppf line_buffer;
|
|
|
|
if !loaded && (not (yes_or_no "The program is running. Quit anyway")) then
|
|
|
|
loop ppf
|
1997-03-22 15:28:07 -08:00
|
|
|
|
2000-03-07 10:22:19 -08:00
|
|
|
let rec protect ppf cont =
|
1997-03-22 15:28:07 -08:00
|
|
|
try
|
2000-03-07 10:22:19 -08:00
|
|
|
cont ppf
|
1997-03-22 15:28:07 -08:00
|
|
|
with
|
2000-03-07 10:22:19 -08:00
|
|
|
| End_of_file ->
|
|
|
|
protect ppf (function ppf ->
|
1997-03-22 15:28:07 -08:00
|
|
|
forget_process
|
|
|
|
!current_checkpoint.c_fd
|
|
|
|
!current_checkpoint.c_pid;
|
2000-03-21 07:16:28 -08:00
|
|
|
pp_print_flush ppf ();
|
1997-03-22 15:28:07 -08:00
|
|
|
stop_user_input ();
|
2000-03-07 10:22:19 -08:00
|
|
|
loop ppf)
|
1997-03-22 15:28:07 -08:00
|
|
|
| Toplevel ->
|
2000-03-07 10:22:19 -08:00
|
|
|
protect ppf (function ppf ->
|
2000-03-21 07:16:28 -08:00
|
|
|
pp_print_flush ppf ();
|
1997-03-22 15:28:07 -08:00
|
|
|
stop_user_input ();
|
2000-03-07 10:22:19 -08:00
|
|
|
loop ppf)
|
1997-03-22 15:28:07 -08:00
|
|
|
| Sys.Break ->
|
2000-03-07 10:22:19 -08:00
|
|
|
protect ppf (function ppf ->
|
2000-03-21 07:16:28 -08:00
|
|
|
fprintf ppf "Interrupted.@.";
|
1997-11-13 01:04:16 -08:00
|
|
|
Exec.protect (function () ->
|
1996-11-29 08:55:09 -08:00
|
|
|
stop_user_input ();
|
1997-03-22 15:28:07 -08:00
|
|
|
if !loaded then begin
|
|
|
|
try_select_frame 0;
|
2000-03-07 10:22:19 -08:00
|
|
|
show_current_event ppf;
|
1997-03-22 15:28:07 -08:00
|
|
|
end);
|
2000-03-07 10:22:19 -08:00
|
|
|
loop ppf)
|
1997-03-22 15:28:07 -08:00
|
|
|
| Current_checkpoint_lost ->
|
2000-03-07 10:22:19 -08:00
|
|
|
protect ppf (function ppf ->
|
2000-03-21 07:16:28 -08:00
|
|
|
fprintf ppf "Trying to recover...@.";
|
1997-03-22 15:28:07 -08:00
|
|
|
stop_user_input ();
|
|
|
|
recover ();
|
|
|
|
try_select_frame 0;
|
2000-03-07 10:22:19 -08:00
|
|
|
show_current_event ppf;
|
|
|
|
loop ppf)
|
1997-03-22 15:28:07 -08:00
|
|
|
| x ->
|
|
|
|
kill_program ();
|
|
|
|
raise x
|
|
|
|
|
2000-03-07 10:22:19 -08:00
|
|
|
let toplevel_loop () = protect Format.std_formatter loop
|
1996-11-29 08:55:09 -08:00
|
|
|
|
1997-06-13 08:50:32 -07:00
|
|
|
(* Parsing of command-line arguments *)
|
|
|
|
|
|
|
|
exception Found_program_name
|
|
|
|
|
1996-11-29 08:55:09 -08:00
|
|
|
let anonymous s =
|
1997-06-13 08:50:32 -07:00
|
|
|
program_name := s; raise Found_program_name
|
1996-11-29 08:55:09 -08:00
|
|
|
let add_include d =
|
|
|
|
default_load_path := d :: !default_load_path
|
|
|
|
let set_socket s =
|
|
|
|
socket_name := s
|
|
|
|
let set_checkpoints n =
|
|
|
|
checkpoint_max_count := n
|
|
|
|
let set_directory dir =
|
|
|
|
Sys.chdir dir
|
|
|
|
let set_emacs () =
|
|
|
|
emacs := true
|
|
|
|
|
1997-06-13 08:50:32 -07:00
|
|
|
let speclist =
|
|
|
|
["-I", Arg.String add_include,
|
|
|
|
"<dir> Add <dir> to the list of include directories";
|
|
|
|
"-s", Arg.String set_socket,
|
|
|
|
"<filename> Set the name of the communication socket";
|
|
|
|
"-c", Arg.Int set_checkpoints,
|
|
|
|
"<count> Set max number of checkpoints kept";
|
|
|
|
"-cd", Arg.String set_directory,
|
|
|
|
"<dir> Change working directory";
|
|
|
|
"-emacs", Arg.Unit set_emacs,
|
|
|
|
"For running the debugger under emacs"]
|
|
|
|
|
1996-11-29 08:55:09 -08:00
|
|
|
let main () =
|
|
|
|
try
|
|
|
|
socket_name := "/tmp/camldebug" ^ (string_of_int (Unix.getpid ()));
|
1997-06-13 08:50:32 -07:00
|
|
|
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 ->
|
1997-07-03 07:31:28 -07:00
|
|
|
for j = !Arg.current + 1 to Array.length Sys.argv - 1 do
|
1997-06-13 08:50:32 -07:00
|
|
|
arguments := Printf.sprintf "%s '%s'" !arguments Sys.argv.(j)
|
|
|
|
done
|
|
|
|
end;
|
1996-11-29 08:55:09 -08:00
|
|
|
current_prompt := debugger_prompt;
|
2000-03-21 07:16:28 -08:00
|
|
|
printf "\tObjective Caml Debugger version %s@.@." Config.version;
|
1996-11-29 08:55:09 -08:00
|
|
|
Config.load_path := !default_load_path;
|
1997-03-22 15:28:07 -08:00
|
|
|
toplevel_loop (); (* Toplevel. *)
|
1996-11-29 08:55:09 -08:00
|
|
|
kill_program ();
|
|
|
|
exit 0
|
|
|
|
with Toplevel ->
|
|
|
|
exit 2
|
|
|
|
|
|
|
|
let _ =
|
|
|
|
Printexc.catch (Unix.handle_unix_error main) ()
|