From 3eb8f1b4670e3e95b7b4f305efcad03eeb637c11 Mon Sep 17 00:00:00 2001 From: Xavier Leroy Date: Tue, 3 Dec 1996 13:40:28 +0000 Subject: [PATCH] Interface avec le debugger git-svn-id: http://caml.inria.fr/svn/ocaml/trunk@1212 f963ae5c-01c2-4b8c-9fe0-0dff7051ff02 --- byterun/debugger.c | 315 +++++++++++++++++++++++++++++++++++++++++++++ byterun/debugger.h | 111 ++++++++++++++++ 2 files changed, 426 insertions(+) create mode 100644 byterun/debugger.c create mode 100644 byterun/debugger.h diff --git a/byterun/debugger.c b/byterun/debugger.c new file mode 100644 index 000000000..18cfc54eb --- /dev/null +++ b/byterun/debugger.c @@ -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 +#ifdef HAS_UNISTD +#include +#endif +#include +#include +#include +#include +#include +#include +#include +#include + +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 diff --git a/byterun/debugger.h b/byterun/debugger.h new file mode 100644 index 000000000..3d2146111 --- /dev/null +++ b/byterun/debugger.h @@ -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 + +