Interface avec le debugger
git-svn-id: http://caml.inria.fr/svn/ocaml/trunk@1212 f963ae5c-01c2-4b8c-9fe0-0dff7051ff02master
Xavier Leroy
parent
3b92524aa9
commit
3eb8f1b467
|
|
@ -0,0 +1,315 @@
|
|||
/***********************************************************************/
|
||||
/* */
|
||||
/* Objective Caml */
|
||||
/* */
|
||||
/* Xavier Leroy, projet Cristal, INRIA Rocquencourt */
|
||||
/* */
|
||||
/* Copyright 1996 Institut National de Recherche en Informatique et */
|
||||
/* Automatique. Distributed only by permission. */
|
||||
/* */
|
||||
/***********************************************************************/
|
||||
|
||||
/* $Id$ */
|
||||
|
||||
/* Interface with the debugger */
|
||||
|
||||
#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 debugger_in_use = 0;
|
||||
unsigned long event_count;
|
||||
|
||||
#ifndef HAS_SOCKETS
|
||||
|
||||
void debugger_init()
|
||||
char * address;
|
||||
{
|
||||
}
|
||||
|
||||
void debugger(event)
|
||||
enum event_kind event;
|
||||
{
|
||||
}
|
||||
|
||||
#else
|
||||
|
||||
#include <string.h>
|
||||
#ifdef HAS_UNISTD
|
||||
#include <unistd.h>
|
||||
#endif
|
||||
#include <sys/types.h>
|
||||
#include <sys/wait.h>
|
||||
#include <sys/types.h>
|
||||
#include <sys/socket.h>
|
||||
#include <sys/un.h>
|
||||
#include <netinet/in.h>
|
||||
#include <arpa/inet.h>
|
||||
#include <netdb.h>
|
||||
|
||||
static int sock_domain; /* Socket domain for the debugger */
|
||||
static union { /* Socket address for the debugger */
|
||||
struct sockaddr s_gen;
|
||||
struct sockaddr_un s_unix;
|
||||
struct sockaddr_in s_inet;
|
||||
} sock_addr;
|
||||
static int sock_addr_len; /* Length of sock_addr */
|
||||
|
||||
static int dbg_socket = -1; /* The socket connected to the debugger */
|
||||
static struct channel * dbg_in; /* Input channel on the socket */
|
||||
static struct channel * dbg_out;/* Output channel on the socket */
|
||||
|
||||
static void open_connection()
|
||||
{
|
||||
dbg_socket = socket(sock_domain, SOCK_STREAM, 0);
|
||||
if (dbg_socket == -1 ||
|
||||
connect(dbg_socket, &sock_addr.s_gen, sock_addr_len) == -1)
|
||||
fatal_error("cannot connect to debugger");
|
||||
dbg_in = open_descr(dbg_socket);
|
||||
if (!debugger_in_use) register_global_root((value *) &dbg_in);
|
||||
dbg_out = open_descr(dbg_socket);
|
||||
if (!debugger_in_use) register_global_root((value *) &dbg_out);
|
||||
putword(dbg_out, getpid());
|
||||
flush(dbg_out);
|
||||
}
|
||||
|
||||
static void close_connection()
|
||||
{
|
||||
close_channel(dbg_in);
|
||||
close_channel(dbg_out);
|
||||
dbg_socket = -1; /* was closed by close_channel */
|
||||
}
|
||||
|
||||
void debugger_init()
|
||||
{
|
||||
char * address;
|
||||
char * port, * p;
|
||||
struct hostent * host;
|
||||
int n;
|
||||
|
||||
address = getenv("CAML_DEBUG_SOCKET");
|
||||
if (address == NULL) return;
|
||||
|
||||
/* Parse the address */
|
||||
port = NULL;
|
||||
for (p = address; *p != 0; p++) {
|
||||
if (*p == ':') { *p = 0; port = p+1; break; }
|
||||
}
|
||||
if (port == NULL) {
|
||||
/* Unix domain */
|
||||
sock_domain = PF_UNIX;
|
||||
sock_addr.s_unix.sun_family = AF_UNIX;
|
||||
strncpy(sock_addr.s_unix.sun_path, address,
|
||||
sizeof(sock_addr.s_unix.sun_path));
|
||||
sock_addr_len =
|
||||
((char *)&(sock_addr.s_unix.sun_path) - (char *)&(sock_addr.s_unix))
|
||||
+ strlen(address);
|
||||
} else {
|
||||
/* Internet domain */
|
||||
sock_domain = PF_INET;
|
||||
for (p = (char *) &sock_addr.s_inet, n = sizeof(sock_addr.s_inet);
|
||||
n > 0; n--) *p++ = 0;
|
||||
sock_addr.s_inet.sin_family = AF_INET;
|
||||
sock_addr.s_inet.sin_addr.s_addr = inet_addr(address);
|
||||
if (sock_addr.s_inet.sin_addr.s_addr == -1) {
|
||||
host = gethostbyname(address);
|
||||
if (host == NULL)
|
||||
fatal_error_arg("Unknown debugging host %s\n", address);
|
||||
bcopy(host->h_addr, &sock_addr.s_inet.sin_addr, host->h_length);
|
||||
}
|
||||
sock_addr.s_inet.sin_port = htons(atoi(port));
|
||||
sock_addr_len = sizeof(sock_addr.s_inet);
|
||||
}
|
||||
open_connection();
|
||||
debugger_in_use = 1;
|
||||
trap_barrier = stack_high;
|
||||
}
|
||||
|
||||
static value getval(chan)
|
||||
struct channel * chan;
|
||||
{
|
||||
value res;
|
||||
if (really_getblock(chan, (char *) &res, sizeof(res)) == 0)
|
||||
raise_end_of_file(); /* Bad, but consistent with getword */
|
||||
return res;
|
||||
}
|
||||
|
||||
static void putval(chan, val)
|
||||
struct channel * chan;
|
||||
value val;
|
||||
{
|
||||
really_putblock(chan, (char *) &val, sizeof(val));
|
||||
}
|
||||
|
||||
#define Pc(sp) ((code_t)(sp[0]))
|
||||
#define Env(sp) (sp[1])
|
||||
#define Locals(sp) (sp + 3)
|
||||
|
||||
void debugger(event)
|
||||
enum event_kind event;
|
||||
{
|
||||
int frame_number;
|
||||
value * frame;
|
||||
long i, pos;
|
||||
mlsize_t size;
|
||||
value val;
|
||||
value * p;
|
||||
|
||||
if (dbg_socket == -1) return; /* Not connected to a debugger. */
|
||||
|
||||
/* Reset current frame */
|
||||
frame_number = 0;
|
||||
frame = extern_sp + 1;
|
||||
|
||||
/* Report the event to the debugger */
|
||||
switch(event) {
|
||||
case PROGRAM_START: /* Nothing to report */
|
||||
goto command_loop;
|
||||
case EVENT_COUNT:
|
||||
putch(dbg_out, REP_EVENT);
|
||||
break;
|
||||
case BREAKPOINT:
|
||||
putch(dbg_out, REP_BREAKPOINT);
|
||||
break;
|
||||
case PROGRAM_EXIT:
|
||||
putch(dbg_out, REP_EXITED);
|
||||
break;
|
||||
case TRAP_BARRIER:
|
||||
putch(dbg_out, REP_TRAP);
|
||||
break;
|
||||
case UNCAUGHT_EXC:
|
||||
putch(dbg_out, REP_UNCAUGHT_EXC);
|
||||
break;
|
||||
}
|
||||
putword(dbg_out, event_count);
|
||||
putword(dbg_out, stack_high - frame);
|
||||
putword(dbg_out, (Pc(frame) - start_code) * sizeof(opcode_t));
|
||||
flush(dbg_out);
|
||||
|
||||
command_loop:
|
||||
|
||||
/* Read and execute the commands sent by the debugger */
|
||||
while(1) {
|
||||
switch(getch(dbg_in)) {
|
||||
case REQ_SET_EVENT:
|
||||
pos = getword(dbg_in);
|
||||
Assert(pos >= 0 && pos < code_size);
|
||||
set_instruction(start_code + pos / sizeof(opcode_t), EVENT);
|
||||
break;
|
||||
case REQ_SET_BREAKPOINT:
|
||||
pos = getword(dbg_in);
|
||||
Assert(pos >= 0 && pos < code_size);
|
||||
set_instruction(start_code + pos / sizeof(opcode_t), BREAK);
|
||||
break;
|
||||
case REQ_RESET_INSTR:
|
||||
pos = getword(dbg_in);
|
||||
Assert(pos >= 0 && pos < code_size);
|
||||
pos = pos / sizeof(opcode_t);
|
||||
set_instruction(start_code + pos, saved_code[pos]);
|
||||
break;
|
||||
case REQ_CHECKPOINT:
|
||||
i = fork();
|
||||
if (i == 0) {
|
||||
close_connection(); /* Close parent connection. */
|
||||
open_connection(); /* Open new connection with debugger */
|
||||
} else {
|
||||
putword(dbg_out, i);
|
||||
flush(dbg_out);
|
||||
}
|
||||
break;
|
||||
case REQ_GO:
|
||||
event_count = getword(dbg_in);
|
||||
return;
|
||||
case REQ_STOP:
|
||||
exit(0);
|
||||
break;
|
||||
case REQ_WAIT:
|
||||
wait(NULL);
|
||||
break;
|
||||
case REQ_INITIAL_FRAME:
|
||||
frame = extern_sp + 1;
|
||||
/* Fall through */
|
||||
case REQ_GET_FRAME:
|
||||
putword(dbg_out, stack_high - frame);
|
||||
putword(dbg_out, (Pc(frame) - start_code) * sizeof(opcode_t));
|
||||
flush(dbg_out);
|
||||
break;
|
||||
case REQ_SET_FRAME:
|
||||
i = getword(dbg_in);
|
||||
frame = stack_high - i;
|
||||
break;
|
||||
case REQ_UP_FRAME:
|
||||
i = getword(dbg_in);
|
||||
if (frame + i + 3 >= stack_high) {
|
||||
putword(dbg_out, -1);
|
||||
} else {
|
||||
frame += i + 3;
|
||||
putword(dbg_out, stack_high - frame);
|
||||
putword(dbg_out, (Pc(frame) - start_code) * sizeof(opcode_t));
|
||||
}
|
||||
flush(dbg_out);
|
||||
break;
|
||||
case REQ_SET_TRAP_BARRIER:
|
||||
i = getword(dbg_in);
|
||||
trap_barrier = stack_high - i;
|
||||
break;
|
||||
case REQ_GET_LOCAL:
|
||||
i = getch(dbg_in);
|
||||
putval(dbg_out, Locals(frame)[i]);
|
||||
flush(dbg_out);
|
||||
break;
|
||||
case REQ_GET_ENVIRONMENT:
|
||||
i = getch(dbg_in);
|
||||
putval(dbg_out, Field(Env(frame), i));
|
||||
flush(dbg_out);
|
||||
break;
|
||||
case REQ_GET_GLOBAL:
|
||||
i = getword(dbg_in);
|
||||
putval(dbg_out, Field(global_data, i));
|
||||
flush(dbg_out);
|
||||
break;
|
||||
case REQ_GET_ACCU:
|
||||
putval(dbg_out, *extern_sp);
|
||||
flush(dbg_out);
|
||||
break;
|
||||
case REQ_GET_OBJ:
|
||||
val = getval(dbg_in);
|
||||
putword(dbg_out, Hd_val(val));
|
||||
for (size = Wosize_val(val), p = &Field(val, 0); size > 0; size--, p++)
|
||||
putval(dbg_out, *p);
|
||||
flush(dbg_out);
|
||||
break;
|
||||
case REQ_GET_HEADER:
|
||||
val = getval(dbg_in);
|
||||
putword(dbg_out, Hd_val(val));
|
||||
flush(dbg_out);
|
||||
break;
|
||||
case REQ_GET_FIELD:
|
||||
val = getval(dbg_in);
|
||||
i = getword(dbg_in);
|
||||
putval(dbg_out, Field(val, i));
|
||||
flush(dbg_out);
|
||||
break;
|
||||
case REQ_MARSHAL_OBJ:
|
||||
val = getval(dbg_in);
|
||||
output_value(dbg_out, val);
|
||||
flush(dbg_out);
|
||||
break;
|
||||
case REQ_GET_CLOSURE_CODE:
|
||||
val = getval(dbg_in);
|
||||
putword(dbg_out, (Code_val(val) - start_code) * sizeof(opcode_t));
|
||||
flush(dbg_out);
|
||||
break;
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
#endif
|
||||
|
|
@ -0,0 +1,111 @@
|
|||
/***********************************************************************/
|
||||
/* */
|
||||
/* Objective Caml */
|
||||
/* */
|
||||
/* Xavier Leroy, projet Cristal, INRIA Rocquencourt */
|
||||
/* */
|
||||
/* Copyright 1996 Institut National de Recherche en Informatique et */
|
||||
/* Automatique. Distributed only by permission. */
|
||||
/* */
|
||||
/***********************************************************************/
|
||||
|
||||
/* $Id$ */
|
||||
|
||||
/* Interface with the debugger */
|
||||
|
||||
#ifndef _debugger_
|
||||
#define _debugger_
|
||||
|
||||
#include "misc.h"
|
||||
#include "mlvalues.h"
|
||||
|
||||
extern int debugger_in_use;
|
||||
extern unsigned long event_count;
|
||||
|
||||
enum event_kind {
|
||||
EVENT_COUNT, BREAKPOINT, PROGRAM_START, PROGRAM_EXIT,
|
||||
TRAP_BARRIER, UNCAUGHT_EXC
|
||||
};
|
||||
|
||||
void debugger_init P((void));
|
||||
void debugger P((enum event_kind event));
|
||||
|
||||
/* Communication protocol */
|
||||
|
||||
/* Requests from the debugger to the runtime system */
|
||||
|
||||
enum debugger_request {
|
||||
REQ_SET_EVENT = 'e', /* uint32 pos */
|
||||
/* Set an event on the instruction at position pos */
|
||||
REQ_SET_BREAKPOINT = 'B', /* uint32 pos */
|
||||
/* Set a breakpoint at position pos */
|
||||
REQ_RESET_INSTR = 'i', /* uint32 pos */
|
||||
/* Clear an event or breapoint at position pos, restores initial instr. */
|
||||
REQ_CHECKPOINT = 'c', /* no args */
|
||||
/* Checkpoint the runtime system by forking a child process.
|
||||
Reply is pid of child process or -1 if checkpoint failed. */
|
||||
REQ_GO = 'g', /* uint32 n */
|
||||
/* Run the program for n events.
|
||||
Reply is one of debugger_reply described below. */
|
||||
REQ_STOP = 's', /* no args */
|
||||
/* Terminate the runtime system */
|
||||
REQ_WAIT = 'w', /* no args */
|
||||
/* Reap one dead child (a discarded checkpoint). */
|
||||
REQ_INITIAL_FRAME = '0', /* no args */
|
||||
/* Set current frame to bottom frame (the one currently executing).
|
||||
Reply is stack offset and current pc. */
|
||||
REQ_GET_FRAME = 'f', /* no args */
|
||||
/* Return current frame location (stack offset + current pc). */
|
||||
REQ_SET_FRAME = 'S', /* uint32 stack_offset */
|
||||
/* Set current frame to given stack offset. No reply. */
|
||||
REQ_UP_FRAME = 'U', /* uint32 n */
|
||||
/* Move one frame up. Argument n is size of current frame (in words).
|
||||
Reply is stack offset and current pc, or -1 if top of stack reached. */
|
||||
REQ_SET_TRAP_BARRIER = 'b', /* uint32 offset */
|
||||
/* Set the trap barrier at the given offset. */
|
||||
REQ_GET_LOCAL = 'L', /* uint32 slot_number */
|
||||
/* Return the local variable at the given slot in the current frame.
|
||||
Reply is one value. */
|
||||
REQ_GET_ENVIRONMENT = 'E', /* uint32 slot_number */
|
||||
/* Return the local variable at the given slot in the heap environment
|
||||
of the current frame. Reply is one value. */
|
||||
REQ_GET_GLOBAL = 'G', /* uint32 global_number */
|
||||
/* Return the specified global variable. Reply is one value. */
|
||||
REQ_GET_ACCU = 'A', /* no args */
|
||||
/* Return the current contents of the accumulator. Reply is one value. */
|
||||
REQ_GET_OBJ = 'O', /* mlvalue v */
|
||||
/* Send the contents of the given value v.
|
||||
Reply is one uint32 for the header, then N values for the fields. */
|
||||
REQ_GET_HEADER = 'H', /* mlvalue v */
|
||||
/* As REQ_GET_OBJ, but sends only the header. */
|
||||
REQ_GET_FIELD = 'F', /* mlvalue v, uint32 fieldnum */
|
||||
/* As REQ_GET_OBJ, but sends only one field. */
|
||||
REQ_MARSHAL_OBJ = 'M', /* mlvalue v */
|
||||
/* Send a copy of the data structure rooted at v, using the same
|
||||
format as output_value. */
|
||||
REQ_GET_CLOSURE_CODE = 'C' /* mlvalue v */
|
||||
/* Send the code address of the given closure.
|
||||
Reply is one uint32. */
|
||||
};
|
||||
|
||||
/* Replies to a REQ_GO request. All replies are followed by three uint32:
|
||||
- the value of the event counter
|
||||
- the position of the stack
|
||||
- the current pc. */
|
||||
|
||||
enum debugger_reply {
|
||||
REP_EVENT = 'e',
|
||||
/* Event counter reached 0. */
|
||||
REP_BREAKPOINT = 'b',
|
||||
/* Breakpoint hit. */
|
||||
REP_EXITED = 'x',
|
||||
/* Program exited by calling exit or reaching the end of the source. */
|
||||
REP_TRAP = 's',
|
||||
/* Trap barrier crossed. */
|
||||
REP_UNCAUGHT_EXC = 'u'
|
||||
/* Program exited due to a stray exception. */
|
||||
};
|
||||
|
||||
#endif
|
||||
|
||||
|
||||
Loading…
Reference in New Issue