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(* Manage the loading of the program *) 18 19open Int64ops 20open Unix 21open Unix_tools 22open Debugger_config 23open Primitives 24open Parameters 25open Input_handling 26open Question 27open Program_loading 28open Time_travel 29 30(*** Connection opening and control. ***) 31 32(* Name of the file if the socket is in the unix domain.*) 33let file_name = ref (None : string option) 34 35(* Default connection handler. *) 36let buffer = Bytes.create 1024 37let control_connection pid fd = 38 if (read fd.io_fd buffer 0 1024) = 0 then 39 forget_process fd pid 40 else begin 41 prerr_string "Garbage data from process "; 42 prerr_int pid; 43 prerr_endline "" 44 end 45 46(* Accept a connection from another process. *) 47let accept_connection continue fd = 48 let (sock, _) = accept fd.io_fd in 49 let io_chan = io_channel_of_descr sock in 50 let pid = input_binary_int io_chan.io_in in 51 if pid = -1 then begin 52 let pid' = input_binary_int io_chan.io_in in 53 new_checkpoint pid' io_chan; 54 Input_handling.add_file io_chan (control_connection pid'); 55 continue () 56 end 57 else begin 58 if set_file_descriptor pid io_chan then 59 Input_handling.add_file io_chan (control_connection pid) 60 end 61 62(* Initialize the socket. *) 63let open_connection address continue = 64 try 65 let (sock_domain, sock_address) = convert_address address in 66 file_name := 67 (match sock_address with 68 ADDR_UNIX file -> 69 Some file 70 | _ -> 71 None); 72 let sock = socket sock_domain SOCK_STREAM 0 in 73 (try 74 bind sock sock_address; 75 setsockopt sock SO_REUSEADDR true; 76 listen sock 3; 77 connection := io_channel_of_descr sock; 78 Input_handling.add_file !connection (accept_connection continue); 79 connection_opened := true 80 with x -> close sock; raise x) 81 with 82 Failure _ -> raise Toplevel 83 | (Unix_error _) as err -> report_error err; raise Toplevel 84 85(* Close the socket. *) 86let close_connection () = 87 if !connection_opened then begin 88 connection_opened := false; 89 Input_handling.remove_file !connection; 90 close_io !connection; 91 match !file_name with 92 Some file -> 93 unlink file 94 | None -> 95 () 96 end 97 98(*** Kill program. ***) 99let loaded = ref false 100 101let kill_program () = 102 Breakpoints.remove_all_breakpoints (); 103 History.empty_history (); 104 kill_all_checkpoints (); 105 loaded := false; 106 close_connection () 107 108let ask_kill_program () = 109 if not !loaded then 110 true 111 else 112 let answer = yes_or_no "A program is being debugged already. Kill it" in 113 if answer then 114 kill_program (); 115 answer 116 117(*** Program loading and initializations. ***) 118 119let initialize_loading () = 120 if !debug_loading then begin 121 prerr_endline "Loading debugging information..."; 122 Printf.fprintf Pervasives.stderr "\tProgram: [%s]\n%!" !program_name; 123 end; 124 begin try access !program_name [F_OK] 125 with Unix_error _ -> 126 prerr_endline "Program not found."; 127 raise Toplevel; 128 end; 129 Symbols.read_symbols !program_name; 130 Config.load_path := !Config.load_path @ !Symbols.program_source_dirs; 131 Envaux.reset_cache (); 132 if !debug_loading then 133 prerr_endline "Opening a socket..."; 134 open_connection !socket_name 135 (function () -> 136 go_to _0; 137 Symbols.set_all_events(); 138 exit_main_loop ()) 139 140(* Ensure the program is already loaded. *) 141let ensure_loaded () = 142 if not !loaded then begin 143 print_string "Loading program... "; 144 flush Pervasives.stdout; 145 if !program_name = "" then begin 146 prerr_endline "No program specified."; 147 raise Toplevel 148 end; 149 try 150 initialize_loading(); 151 !launching_func (); 152 if !debug_loading then 153 prerr_endline "Waiting for connection..."; 154 main_loop (); 155 loaded := true; 156 prerr_endline "done." 157 with 158 x -> 159 kill_program(); 160 raise x 161 end 162