blob: 88b5128c49e7fb83aaaacc0bb3067fda1ed84220 (
plain)
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
|
(***********************************************************************)
(* *)
(* 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. Distributed only by permission. *)
(* *)
(***********************************************************************)
(* $Id$ *)
(* Program loading *)
open Unix
open Misc
open Debugger_config
open Parameters
open Input_handling
(*** Debugging. ***)
let debug_loading = ref false
(*** Load a program. ***)
(* Function used for launching the program. *)
let launching_func = ref (function () -> ())
let load_program () =
!launching_func ();
main_loop ()
(*** Launching functions. ***)
(* A generic function for launching the program *)
let generic_exec cmdline = function () ->
if !debug_loading then
prerr_endline "Launching program...";
let child =
try
fork ()
with x ->
Unix_tools.report_error x;
raise Toplevel in
match child with
0 ->
begin try
match fork () with
0 -> (* Try to detach the process from the controlling terminal,
so that it does not receive SIGINT on ctrl-C. *)
begin try let _ = setsid() in ()
with Invalid_argument _ -> () end;
execv shell [| shell; "-c"; cmdline() |]
| _ -> exit 0
with x ->
Unix_tools.report_error x;
exit 1
end
| _ ->
match wait () with
(_, WEXITED 0) -> ()
| _ -> raise Toplevel
(* Execute the program by calling the runtime explicitely *)
let exec_with_runtime =
generic_exec
(function () ->
Printf.sprintf "CAML_DEBUG_SOCKET=%s %s %s %s"
!socket_name
runtime_program
!program_name
!arguments)
(* Excute the program directly *)
let exec_direct =
generic_exec
(function () ->
Printf.sprintf "CAML_DEBUG_SOCKET=%s %s %s"
!socket_name
!program_name
!arguments)
(* Ask the user. *)
let exec_manual =
function () ->
print_newline ();
print_string "Waiting for connection...";
print_string ("(the socket is " ^ !socket_name ^ ")");
print_newline ()
(*** Selection of the launching function. ***)
type launching_function = (unit -> unit)
let loading_modes =
["direct", exec_direct;
"runtime", exec_with_runtime;
"manual", exec_manual]
let set_launching_function func =
launching_func := func
(* Initialization *)
let _ =
set_launching_function exec_direct
(*** Connection. ***)
let connection = ref Primitives.std_io
let connection_opened = ref false
|
