| Description | When debugging a bytecode program that calls Unix.fork(), ocamlrun
and ocamldebug usually crash immediately after the fork operation.
1. Create a program called "test.ml", containing the following:
let _ =
Printf.printf "process %n starting\n" (Unix.getpid ());
flush stdout;
let _ = Unix.fork () in
Printf.printf "process %n ending\n" (Unix.getpid ());
2. Compile the program:
"ocamlc -custom -g unix.cma test.ml -o test.exe".
3. Start the debugger, specifying the location of "unix.ml" and an
explicit socket:
"ocamldebug -I <path-to-unix> -s <socket-name> test.exe"
4. Issue the following commands to ocamldebug:
"set loadingmode manual"
"goto 0"
5. Manually load the program (possibly on another machine):
"CAML_DEBUG_SOCKET=<socket-name> ./test.exe"
6. Repeatedly issue the "step" command to ocamldebug.
At the point just after the call to Unix.fork(), ocamldebug usually
terminates with an error message of the form:
(ocd) Garbage data from process <n>
>> Fatal error: Debugcom.do_go
Uncaught exception: Misc.Fatal_error
Ocamlrun usually also terminates itself at this point.
This appears to be happening because ocamldebug is receiving unexpected
data from ocamlrun, presumably because the forked ocamlrun processes are
competing with one another to send data along the same connection to
ocamldebug.
Occasionally, though, ocamldebug doesn't crash, but continues to report
data from both parent and child ocamlrun processes. Issuing further step
commands to ocamldebug causes the forked processes to repond in a round-
robin style. Presumably this is because the forked ocamlrun processes
are still competing with one another to read data from the same shared
connection to ocamlbug, and are picking up commands alternately, one
after the other.
The current behaviour is making it difficult for us to debug programs
that launch other processes using the traditional "fork-exec" sequence,
since debugged programs have a very good chance of crashing immediately
after they call Unix.fork().
I'm wondering, is it possible to make ocamlrun aware of Unix.fork(),
so that a child ocamlrun process doesn't attempt to communicate with
ocamldebug through the same socket as its parent process?
Thanks for your help
Jonathan
---
Jonathan Knowles
Citrix Systems Research & Development |
| Attached Files |  fork.patch [^] (7,723 bytes) 2009-10-21 00:33 [Show Content] [Hide Content]diff -Nur ocaml-3.11.1.orig/asmrun/fakedebug.c ocaml-3.11.1.fork/asmrun/fakedebug.c
--- ocaml-3.11.1.orig/asmrun/fakedebug.c 1970-01-01 01:00:00.000000000 +0100
+++ ocaml-3.11.1.fork/asmrun/fakedebug.c 2009-10-17 22:13:49.000000000 +0100
@@ -0,0 +1,9 @@
+/* Dummy bytecode debugger values for libraries to use. */
+
+int caml_debugger_in_use = 0;
+int caml_debugger_fork_mode = 1;
+
+void caml_debugger_cleanup_fork(void)
+{
+}
+
diff -Nur ocaml-3.11.1.orig/asmrun/Makefile ocaml-3.11.1.fork/asmrun/Makefile
--- ocaml-3.11.1.orig/asmrun/Makefile 2007-11-15 13:21:15.000000000 +0000
+++ ocaml-3.11.1.fork/asmrun/Makefile 2009-10-17 21:40:41.000000000 +0100
@@ -26,7 +26,7 @@
misc.o freelist.o major_gc.o minor_gc.o memory.o alloc.o compare.o ints.o \
floats.o str.o array.o io.o extern.o intern.o hash.o sys.o parsing.o \
gc_ctrl.o terminfo.o md5.o obj.o lexing.o printexc.o callback.o weak.o \
- compact.o finalise.o custom.o unix.o backtrace.o natdynlink.o
+ compact.o finalise.o custom.o unix.o backtrace.o natdynlink.o fakedebug.o
ASMOBJS=$(ARCH).o
diff -Nur ocaml-3.11.1.orig/byterun/debugger.c ocaml-3.11.1.fork/byterun/debugger.c
--- ocaml-3.11.1.orig/byterun/debugger.c 2008-07-29 09:31:41.000000000 +0100
+++ ocaml-3.11.1.fork/byterun/debugger.c 2009-10-16 11:23:50.000000000 +0100
@@ -35,6 +35,7 @@
int caml_debugger_in_use = 0;
uintnat caml_event_count;
+int caml_debugger_fork_mode = 1; /* parent by default */
#if !defined(HAS_SOCKETS)
@@ -46,6 +47,10 @@
{
}
+void caml_debugger_cleanup_fork(void)
+{
+}
+
#else
#ifdef HAS_UNISTD
@@ -412,8 +417,19 @@
caml_putword(dbg_out, (Code_val(val)-caml_start_code) * sizeof(opcode_t));
caml_flush(dbg_out);
break;
+ case REQ_SET_FORK_MODE:
+ caml_debugger_fork_mode = caml_getword(dbg_in);
+ break;
}
}
}
+void caml_debugger_cleanup_fork(void)
+{
+ /* We could remove all of the breakpoints, but closing the connection
+ * means that they'll just be skipped anyway. */
+ close_connection();
+ caml_debugger_in_use = 0;
+}
+
#endif
diff -Nur ocaml-3.11.1.orig/byterun/debugger.h ocaml-3.11.1.fork/byterun/debugger.h
--- ocaml-3.11.1.orig/byterun/debugger.h 2005-09-22 15:21:50.000000000 +0100
+++ ocaml-3.11.1.fork/byterun/debugger.h 2009-10-16 11:23:50.000000000 +0100
@@ -24,6 +24,7 @@
extern int caml_debugger_in_use;
extern int running;
extern uintnat caml_event_count;
+extern int caml_debugger_fork_mode; /* non-zero for parent */
enum event_kind {
EVENT_COUNT, BREAKPOINT, PROGRAM_START, PROGRAM_EXIT,
@@ -32,6 +33,7 @@
void caml_debugger_init (void);
void caml_debugger (enum event_kind event);
+void caml_debugger_cleanup_fork (void);
/* Communication protocol */
@@ -84,9 +86,11 @@
REQ_MARSHAL_OBJ = 'M', /* mlvalue v */
/* Send a copy of the data structure rooted at v, using the same
format as [caml_output_value]. */
- REQ_GET_CLOSURE_CODE = 'C' /* mlvalue v */
+ REQ_GET_CLOSURE_CODE = 'C', /* mlvalue v */
/* Send the code address of the given closure.
Reply is one uint32. */
+ REQ_SET_FORK_MODE = 'K' /* uint32 m */
+ /* Set whether to follow the child (m=0) or the parent on fork. */
};
/* Replies to a REQ_GO request. All replies are followed by three uint32:
diff -Nur ocaml-3.11.1.orig/debugger/command_line.ml ocaml-3.11.1.fork/debugger/command_line.ml
--- ocaml-3.11.1.orig/debugger/command_line.ml 2009-04-02 10:44:21.000000000 +0100
+++ ocaml-3.11.1.fork/debugger/command_line.ml 2009-10-16 11:23:50.000000000 +0100
@@ -803,6 +803,22 @@
find loading_modes;
fprintf ppf "@."
+let follow_fork_variable =
+ (function lexbuf ->
+ let mode =
+ match identifier_eol Lexer.lexeme lexbuf with
+ | "child" -> Fork_child
+ | "parent" -> Fork_parent
+ | _ -> error "Syntax error."
+ in
+ fork_mode := mode;
+ if !loaded then update_follow_fork_mode ()),
+ function ppf ->
+ fprintf ppf "%s@."
+ (match !fork_mode with
+ Fork_child -> "child"
+ | Fork_parent -> "parent")
+
(** Infos. **)
let pr_modules ppf mods =
@@ -1094,7 +1110,14 @@
var_action = integer_variable false 1 "Must be at least 1"
max_printer_steps;
var_help =
-"maximal number of value nodes printed." }];
+"maximal number of value nodes printed." };
+ { var_name = "follow_fork_mode";
+ var_action = follow_fork_variable;
+ var_help =
+"process to follow after forking.\n\
+It can be either :
+ child : the newly created process.\n\
+ parent : the process that called fork.\n" }];
info_list :=
(* info name, function, help *)
diff -Nur ocaml-3.11.1.orig/debugger/debugcom.ml ocaml-3.11.1.fork/debugger/debugcom.ml
--- ocaml-3.11.1.orig/debugger/debugcom.ml 2008-07-29 09:31:41.000000000 +0100
+++ ocaml-3.11.1.fork/debugger/debugcom.ml 2009-10-16 11:23:50.000000000 +0100
@@ -22,8 +22,25 @@
let conn = ref Primitives.std_io
+(* Set which process the debugger follows on fork. *)
+
+type follow_fork_mode =
+ Fork_child
+ | Fork_parent
+
+let fork_mode = ref Fork_parent
+
+let update_follow_fork_mode () =
+ let a = match !fork_mode with Fork_child -> 0 | Fork_parent -> 1 in
+ output_char !conn.io_out 'K';
+ output_binary_int !conn.io_out a
+
+(* Set the current connection, and update the fork mode in case it has
+ * changed. *)
+
let set_current_connection io_chan =
- conn := io_chan
+ conn := io_chan;
+ update_follow_fork_mode ()
(* Modify the program code *)
diff -Nur ocaml-3.11.1.orig/debugger/debugcom.mli ocaml-3.11.1.fork/debugger/debugcom.mli
--- ocaml-3.11.1.orig/debugger/debugcom.mli 2002-10-29 17:53:23.000000000 +0000
+++ ocaml-3.11.1.fork/debugger/debugcom.mli 2009-10-16 11:23:50.000000000 +0100
@@ -32,6 +32,10 @@
Checkpoint_done of int
| Checkpoint_failed
+type follow_fork_mode =
+ Fork_child
+ | Fork_parent
+
(* Set the current connection with the debuggee *)
val set_current_connection : Primitives.io_channel -> unit
@@ -76,6 +80,10 @@
(* Set the trap barrier to given stack position. *)
val set_trap_barrier : int -> unit
+(* Set whether the debugger follow the child or the parent process on fork *)
+val fork_mode : follow_fork_mode ref
+val update_follow_fork_mode : unit -> unit
+
(* Handling of remote values *)
exception Marshalling_error
diff -Nur ocaml-3.11.1.orig/Makefile ocaml-3.11.1.fork/Makefile
--- ocaml-3.11.1.orig/Makefile 2009-05-19 15:46:13.000000000 +0100
+++ ocaml-3.11.1.fork/Makefile 2009-10-18 18:41:55.000000000 +0100
@@ -434,7 +434,7 @@
cd asmrun; $(MAKE) meta.o dynlink.o
$(CAMLOPT) $(LINKFLAGS) -ccopt "$(BYTECCLINKOPTS)" -o ocamlc.opt \
$(COMPOBJS:.cmo=.cmx) \
- asmrun/meta.o asmrun/dynlink.o -cclib "$(BYTECCLIBS)"
+ asmrun/meta.o asmrun/dynlink.o asmrun/fakedebug.o -cclib "$(BYTECCLIBS)"
@sed -e 's|@compiler@|$$topdir/ocamlc.opt|' \
driver/ocamlcomp.sh.in > ocamlcomp.sh
@chmod +x ocamlcomp.sh
diff -Nur ocaml-3.11.1.orig/otherlibs/unix/fork.c ocaml-3.11.1.fork/otherlibs/unix/fork.c
--- ocaml-3.11.1.orig/otherlibs/unix/fork.c 2001-12-07 13:40:28.000000000 +0000
+++ ocaml-3.11.1.fork/otherlibs/unix/fork.c 2009-10-17 22:12:30.000000000 +0100
@@ -14,6 +14,7 @@
/* $Id: fork.c,v 1.8 2001/12/07 13:40:28 xleroy Exp $ */
#include <mlvalues.h>
+#include <debugger.h>
#include "unixsupport.h"
CAMLprim value unix_fork(value unit)
@@ -21,6 +22,10 @@
int ret;
ret = fork();
if (ret == -1) uerror("fork", Nothing);
+ if (caml_debugger_in_use)
+ if ((caml_debugger_fork_mode && ret == 0) ||
+ (!caml_debugger_fork_mode && ret != 0))
+ caml_debugger_cleanup_fork();
return Val_int(ret);
}
|
Relationships 
Relationships 