PR#4541 make debugger compatible with fork()

git-svn-id: http://caml.inria.fr/svn/ocaml/trunk@10287 f963ae5c-01c2-4b8c-9fe0-0dff7051ff02
master
Damien Doligez 2010-04-20 15:47:15 +00:00
parent a274b01b55
commit 674da0324d
8 changed files with 94 additions and 19 deletions

View File

@ -26,7 +26,7 @@ COBJS=startup.o main.o fail.o roots.o globroots.o signals.o signals_asm.o \
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 debugger.o
ASMOBJS=$(ARCH).o
@ -142,12 +142,14 @@ dynlink.c: ../byterun/dynlink.c
ln -s ../byterun/dynlink.c dynlink.c
signals.c: ../byterun/signals.c
ln -s ../byterun/signals.c signals.c
debugger.c: ../byterun/debugger.c
ln -s ../byterun/debugger.c debugger.c
LINKEDFILES=misc.c freelist.c major_gc.c minor_gc.c memory.c alloc.c array.c \
compare.c ints.c floats.c str.c io.c extern.c intern.c hash.c sys.c \
parsing.c gc_ctrl.c terminfo.c md5.c obj.c lexing.c printexc.c callback.c \
weak.c compact.c finalise.c meta.c custom.c main.c globroots.c unix.c \
dynlink.c signals.c
dynlink.c signals.c debugger.c
clean::
rm -f $(LINKEDFILES)

View File

@ -30,7 +30,7 @@ LINKEDFILES=misc.c freelist.c major_gc.c minor_gc.c memory.c alloc.c array.c \
compare.c ints.c floats.c str.c io.c extern.c intern.c hash.c sys.c \
parsing.c gc_ctrl.c terminfo.c md5.c obj.c lexing.c printexc.c callback.c \
weak.c compact.c meta.c finalise.c custom.c main.c globroots.c \
dynlink.c signals.c
dynlink.c signals.c debugger.c
ifeq ($(TOOLCHAIN),mingw)
ASMOBJS=$(ARCH).o

View File

@ -13,7 +13,7 @@
/* $Id$ */
/* Interface with the debugger */
/* Interface with the byte-code debugger */
#ifdef _WIN32
#include <io.h>
@ -23,20 +23,13 @@
#include "config.h"
#include "debugger.h"
#include "fail.h"
#include "fix_code.h"
#include "instruct.h"
#include "intext.h"
#include "io.h"
#include "misc.h"
#include "mlvalues.h"
#include "stacks.h"
#include "sys.h"
int caml_debugger_in_use = 0;
uintnat caml_event_count;
int caml_debugger_fork_mode = 1; /* parent by default */
#if !defined(HAS_SOCKETS)
#if !defined(HAS_SOCKETS) || defined(NATIVE_CODE)
void caml_debugger_init(void)
{
@ -46,6 +39,10 @@ void caml_debugger(enum event_kind event)
{
}
void caml_debugger_cleanup_fork(void)
{
}
#else
#ifdef HAS_UNISTD
@ -67,6 +64,15 @@ void caml_debugger(enum event_kind event)
#include <process.h>
#endif
#include "fail.h"
#include "fix_code.h"
#include "instruct.h"
#include "intext.h"
#include "io.h"
#include "mlvalues.h"
#include "stacks.h"
#include "sys.h"
static int sock_domain; /* Socket domain for the debugger */
static union { /* Socket address for the debugger */
struct sockaddr s_gen;
@ -109,7 +115,7 @@ static void open_connection(void)
#endif
if (dbg_socket == -1 ||
connect(dbg_socket, &sock_addr.s_gen, sock_addr_len) == -1){
caml_fatal_error_arg2 ("cannot connect to debugger at %s", dbg_addr,
caml_fatal_error_arg2 ("cannot connect to debugger at %s\n", dbg_addr,
"error: %s\n", strerror (errno));
}
#ifdef _WIN32
@ -412,8 +418,19 @@ void caml_debugger(enum event_kind event)
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

View File

@ -21,8 +21,8 @@
#include "misc.h"
#include "mlvalues.h"
extern int caml_debugger_in_use;
extern int running;
CAMLextern int caml_debugger_in_use;
CAMLextern int caml_debugger_fork_mode; /* non-zero for parent */
extern uintnat caml_event_count;
enum event_kind {
@ -32,6 +32,7 @@ enum event_kind {
void caml_debugger_init (void);
void caml_debugger (enum event_kind event);
void caml_debugger_cleanup_fork (void);
/* Communication protocol */
@ -84,9 +85,11 @@ enum debugger_request {
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:

View File

@ -807,6 +807,22 @@ let loading_mode_variable ppf =
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 =
@ -1106,7 +1122,14 @@ It can be either :\n\
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 *)

View File

@ -22,8 +22,25 @@ open Primitives
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 *)

View File

@ -32,6 +32,10 @@ type checkpoint_report =
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 @@ val up_frame : int -> int * int
(* 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

View File

@ -14,6 +14,7 @@
/* $Id$ */
#include <mlvalues.h>
#include <debugger.h>
#include "unixsupport.h"
CAMLprim value unix_fork(value unit)
@ -21,5 +22,9 @@ CAMLprim value unix_fork(value unit)
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);
}