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