PR#4541 make debugger compatible with fork()
git-svn-id: http://caml.inria.fr/svn/ocaml/trunk@10287 f963ae5c-01c2-4b8c-9fe0-0dff7051ff02master
parent
a274b01b55
commit
674da0324d
|
@ -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)
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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:
|
||||
|
|
|
@ -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 *)
|
||||
|
|
|
@ -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 *)
|
||||
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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);
|
||||
}
|
||||
|
|
Loading…
Reference in New Issue