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
17open Input_handling
18open Question
19open Command_line
20open Debugger_config
21open Checkpoints
22open Time_travel
23open Parameters
24open Program_management
25open Frames
26open Show_information
27open Format
28open Primitives
29
30let line_buffer = Lexing.from_function read_user_input
31
32let loop ppf = line_loop ppf line_buffer
33
34let current_duration = ref (-1L)
35
36let 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
110let 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
136let 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
146exception Found_program_name
147
148let anonymous s =
149  program_name := Unix_tools.make_absolute s; raise Found_program_name
150let add_include d =
151  default_load_path :=
152    Misc.expand_directory Config.standard_library d :: !default_load_path
153let set_socket s =
154  socket_name := s
155let set_checkpoints n =
156  checkpoint_max_count := n
157let set_directory dir =
158  Sys.chdir dir
159let print_version () =
160  printf "The OCaml debugger, version %s@." Sys.ocaml_version;
161  exit 0;
162;;
163let print_version_num () =
164  printf "%s@." Sys.ocaml_version;
165  exit 0;
166;;
167
168let speclist = [
169   "-c", Arg.Int set_checkpoints,
170      "<count>  Set max number of checkpoints kept";
171   "-cd", Arg.String set_directory,
172      "<dir>  Change working directory";
173   "-emacs", Arg.Tuple [Arg.Set emacs; Arg.Set machine_readable],
174      "For running the debugger under emacs; implies -machine-readable";
175   "-I", Arg.String add_include,
176      "<dir>  Add <dir> to the list of include directories";
177   "-machine-readable", Arg.Set machine_readable,
178      "Print information in a format more suitable for machines";
179   "-s", Arg.String set_socket,
180      "<filename>  Set the name of the communication socket";
181   "-version", Arg.Unit print_version,
182      " Print version and exit";
183   "-vnum", Arg.Unit print_version_num,
184      " Print version number and exit";
185   ]
186
187let function_placeholder () =
188  raise Not_found
189
190let main () =
191  Callback.register "Debugger.function_placeholder" function_placeholder;
192  try
193    socket_name :=
194      (match Sys.os_type with
195        "Win32" ->
196          (Unix.string_of_inet_addr Unix.inet_addr_loopback)^
197          ":"^
198          (string_of_int (10000 + ((Unix.getpid ()) mod 10000)))
199      | _ -> Filename.concat (Filename.get_temp_dir_name ())
200                                ("camldebug" ^ (string_of_int (Unix.getpid ())))
201      );
202    begin try
203      Arg.parse speclist anonymous "";
204      Arg.usage speclist
205        "No program name specified\n\
206         Usage: ocamldebug [options] <program> [arguments]\n\
207         Options are:";
208      exit 2
209    with Found_program_name ->
210      for j = !Arg.current + 1 to Array.length Sys.argv - 1 do
211        arguments := !arguments ^ " " ^ (Filename.quote Sys.argv.(j))
212      done
213    end;
214    printf "\tOCaml Debugger version %s@.@." Config.version;
215    Config.load_path := !default_load_path;
216    Clflags.recursive_types := true;    (* Allow recursive types. *)
217    toplevel_loop ();                   (* Toplevel. *)
218    kill_program ();
219    exit 0
220  with
221    Toplevel ->
222      exit 2
223  | Env.Error e ->
224      eprintf "Debugger [version %s] environment error:@ @[@;" Config.version;
225      Env.report_error err_formatter e;
226      eprintf "@]@.";
227      exit 2
228  | Cmi_format.Error e ->
229      eprintf "Debugger [version %s] environment error:@ @[@;" Config.version;
230      Cmi_format.report_error err_formatter e;
231      eprintf "@]@.";
232      exit 2
233
234let _ =
235  Printexc.catch (Unix.handle_unix_error main) ()
236