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 Input_handling
18 open Question
19 open Command_line
20 open Debugger_config
21 open Checkpoints
22 open Time_travel
23 open Parameters
24 open Program_management
25 open Frames
26 open Show_information
27 open Format
28 open Primitives
29
30 let line_buffer = Lexing.from_function read_user_input
31
32 let loop ppf = line_loop ppf line_buffer
33
34 let current_duration = ref (-1L)
35
36 let rec protect ppf restart loop =
37 try
38 loop ppf
39 with
40 | End_of_file ->
41 protect ppf restart (function ppf ->
42 forget_process
43 !current_checkpoint.c_fd
44 !current_checkpoint.c_pid;
45 pp_print_flush ppf ();
46 stop_user_input ();
47 restart ppf)
48 | Toplevel ->
49 protect ppf restart (function ppf ->
50 pp_print_flush ppf ();
51 stop_user_input ();
52 restart ppf)
53 | Sys.Break ->
54 protect ppf restart (function ppf ->
55 fprintf ppf "Interrupted.@.";
56 Exec.protect (function () ->
57 stop_user_input ();
58 if !loaded then begin
59 try_select_frame 0;
60 show_current_event ppf;
61 end);
62 restart ppf)
63 | Current_checkpoint_lost ->
64 protect ppf restart (function ppf ->
65 fprintf ppf "Trying to recover...@.";
66 stop_user_input ();
67 recover ();
68 try_select_frame 0;
69 show_current_event ppf;
70 restart ppf)
71 | Current_checkpoint_lost_start_at (time, init_duration) ->
72 protect ppf restart (function ppf ->
73 let b =
74 if !current_duration = -1L then begin
75 let msg = sprintf "Restart from time %Ld and try to get \
76 closer of the problem" time in
77 stop_user_input ();
78 if yes_or_no msg then
79 (current_duration := init_duration; true)
80 else
81 false
82 end
83 else
84 true in
85 if b then
86 begin
87 go_to time;
88 current_duration := Int64.div !current_duration 10L;
89 if !current_duration > 0L then
90 while true do
91 step !current_duration
92 done
93 else begin
94 current_duration := -1L;
95 stop_user_input ();
96 show_current_event ppf;
97 restart ppf;
98 end
99 end
100 else
101 begin
102 recover ();
103 show_current_event ppf;
104 restart ppf
105 end)
106 | x ->
107 kill_program ();
108 raise x
109
110 let execute_file_if_any () =
111 let buffer = Buffer.create 128 in
112 begin
113 try
114 let base = ".ocamldebug" in
115 let file =
116 if Sys.file_exists base then
117 base
118 else
119 Filename.concat (Sys.getenv "HOME") base in
120 let ch = open_in file in
121 fprintf Format.std_formatter "Executing file %s@." file;
122 while true do
123 let line = string_trim (input_line ch) in
124 if line <> "" && line.[0] <> '#' then begin
125 Buffer.add_string buffer line;
126 Buffer.add_char buffer '\n'
127 end
128 done;
129 with _ -> ()
130 end;
131 let len = Buffer.length buffer in
132 if len > 0 then
133 let commands = Buffer.sub buffer 0 (pred len) in
134 line_loop Format.std_formatter (Lexing.from_string commands)
135
136 let toplevel_loop () =
137 interactif := false;
138 current_prompt := "";
139 execute_file_if_any ();
140 interactif := true;
141 current_prompt := debugger_prompt;
142 protect Format.std_formatter loop loop
143
144 (* Parsing of command-line arguments *)
145
146 exception Found_program_name
147
148 let anonymous s =
149 program_name := Unix_tools.make_absolute s; raise Found_program_name
150 let add_include d =
151 default_load_path :=
152 Misc.expand_directory Config.standard_library d :: !default_load_path
153 let set_socket s =
154 socket_name := s
155 let set_topdirs_path s =
156 topdirs_path := s
157 let set_checkpoints n =
158 checkpoint_max_count := n
159 let set_directory dir =
160 Sys.chdir dir
161 let print_version () =
162 printf "The OCaml debugger, version %s@." Sys.ocaml_version;
163 exit 0;
164 ;;
165 let print_version_num () =
166 printf "%s@." Sys.ocaml_version;
167 exit 0;
168 ;;
169
170 let speclist = [
171 "-c", Arg.Int set_checkpoints,
172 "<count> Set max number of checkpoints kept";
173 "-cd", Arg.String set_directory,
174 "<dir> Change working directory";
175 "-emacs", Arg.Tuple [Arg.Set emacs; Arg.Set machine_readable],
176 "For running the debugger under emacs; implies -machine-readable";
177 "-I", Arg.String add_include,
178 "<dir> Add <dir> to the list of include directories";
179 "-machine-readable", Arg.Set machine_readable,
180 "Print information in a format more suitable for machines";
181 "-s", Arg.String set_socket,
182 "<filename> Set the name of the communication socket";
183 "-version", Arg.Unit print_version,
184 " Print version and exit";
185 "-vnum", Arg.Unit print_version_num,
186 " Print version number and exit";
187 "-no-version", Arg.Clear Parameters.version,
188 " Do not print version at startup";
189 "-no-prompt", Arg.Clear Parameters.prompt,
190 " Suppress all prompts";
191 "-no-time", Arg.Clear Parameters.time,
192 " Do not print times";
193 "-no-breakpoint-message", Arg.Clear Parameters.breakpoint,
194 " Do not print message at breakpoint setup and removal";
195 "-topdirs-path", Arg.String set_topdirs_path,
196 " Set path to the directory containing topdirs.cmi";
197 ]
198
199 let function_placeholder () =
200 raise Not_found
201
202 let report report_error error =
203 eprintf "Debugger [version %s] environment error:@ @[@;%a@]@.;"
204 Config.version report_error error
205
206 let main () =
207 Callback.register "Debugger.function_placeholder" function_placeholder;
208 try
209 socket_name :=
210 (match Sys.os_type with
211 "Win32" ->
212 (Unix.string_of_inet_addr Unix.inet_addr_loopback)^
213 ":"^
214 (Int.to_string (10000 + ((Unix.getpid ()) mod 10000)))
215 | _ -> Filename.concat (Filename.get_temp_dir_name ())
216 ("camldebug" ^ (Int.to_string (Unix.getpid ())))
217 );
218 begin try
219 Arg.parse speclist anonymous "";
220 Arg.usage speclist
221 "No program name specified\n\
222 Usage: ocamldebug [options] <program> [arguments]\n\
223 Options are:";
224 exit 2
225 with Found_program_name ->
226 for j = !Arg.current + 1 to Array.length Sys.argv - 1 do
227 arguments := !arguments ^ " " ^ (Filename.quote Sys.argv.(j))
228 done
229 end;
230 if !Parameters.version
231 then printf "\tOCaml Debugger version %s@.@." Config.version;
232 Loadprinter.init();
233 Load_path.init !default_load_path;
234 Clflags.recursive_types := true; (* Allow recursive types. *)
235 toplevel_loop (); (* Toplevel. *)
236 kill_program ();
237 exit 0
238 with
239 | Toplevel ->
240 exit 2
241 | Persistent_env.Error e ->
242 report Persistent_env.report_error e;
243 exit 2
244 | Cmi_format.Error e ->
245 report Cmi_format.report_error e;
246 exit 2
247
248 let _ =
249 Printexc.catch (Unix.handle_unix_error main) ()
250