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
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
|
(***********************************************************************)
(* *)
(* 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 *)
(* en Automatique. All rights reserved. This file is distributed *)
(* under the terms of the Q Public License version 1.0. *)
(* *)
(***********************************************************************)
(* $Id$ *)
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
let line_buffer = Lexing.from_function read_user_input
let rec loop ppf =
line_loop ppf line_buffer;
if !loaded && (not (yes_or_no "The program is running. Quit anyway")) then
loop ppf
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 ->
kill_program ();
raise x
let toplevel_loop () = 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_checkpoints n =
checkpoint_max_count := n
let set_directory dir =
Sys.chdir dir
let print_version () =
printf "The Objective Caml debugger, version %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.Set emacs,
"For running the debugger under emacs";
"-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";
"-version", Arg.Unit print_version,
" Print version and exit";
]
let main () =
try
socket_name :=
(match Sys.os_type with
"Win32" ->
(Unix.string_of_inet_addr Unix.inet_addr_loopback)^
":"^
(string_of_int (10000 + ((Unix.getpid ()) mod 10000)))
| _ -> Filename.concat Filename.temp_dir_name
("camldebug" ^ (string_of_int (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;
current_prompt := debugger_prompt;
printf "\tObjective Caml Debugger version %s@.@." Config.version;
Config.load_path := !default_load_path;
Clflags.recursive_types := true; (* Allow recursive types. *)
toplevel_loop (); (* Toplevel. *)
kill_program ();
exit 0
with
Toplevel ->
exit 2
| Env.Error e ->
eprintf "Debugger [version %s] environment error:@ @[@;" Config.version;
Env.report_error err_formatter e;
eprintf "@]@.";
exit 2
let _ =
Printexc.catch (Unix.handle_unix_error main) ()
|
