Ekdohibs
/
ocaml
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

ocamldebug under Win32 (S. Le Gall, Lexifi) 

git-svn-id: http://caml.inria.fr/svn/ocaml/trunk@8955 f963ae5c-01c2-4b8c-9fe0-0dff7051ff02
master
Xavier Leroy 2008-07-29 08:31:41 +00:00
parent df023f535b
commit 776ae225a0
24 changed files with 1360 additions and 212 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

13
Makefile.nt
View File

@ -120,7 +120,7 @@ defaultentry:
@echo "Please refer to the installation instructions in file README.win32."
# Recompile the system using the bootstrap compiler
all: runtime ocamlc ocamllex ocamlyacc ocamltools library ocaml otherlibraries ocamldoc.byte ocamlbuild.byte camlp4out win32gui
all: runtime ocamlc ocamllex ocamlyacc ocamltools library ocaml otherlibraries ocamldoc.byte ocamlbuild.byte camlp4out $(DEBUGGER) win32gui
# The compilation of ocaml will fail if the runtime has changed.
# Never mind, just do make bootstrap to reach fixpoint again.
@ -232,6 +232,8 @@ installbyt:
cd ocamldoc ; $(MAKEREC) install
mkdir -p $(STUBLIBDIR)
for i in $(OTHERLIBRARIES); do $(MAKEREC) -C otherlibs/$$i install; done
if test -f debugger/ocamldebug.exe; then (cd debugger; $(MAKEREC) install); \
else :; fi
cd win32caml ; $(MAKE) install
./build/partial-install.sh
cp config/Makefile $(LIBDIR)/Makefile.config
@ -581,6 +583,15 @@ clean::
alldepend::
for i in $(OTHERLIBRARIES); do $(MAKEREC) -C otherlibs/$$i depend; done
# The replay debugger
ocamldebugger: ocamlc ocamlyacc ocamllex
cd debugger; $(MAKEREC) all
partialclean::
cd debugger; $(MAKEREC) clean
alldepend::
cd debugger; $(MAKEREC) depend
# Camlp4
camlp4out: ocamlc otherlibraries ocamlbuild-partial-boot ocamlbuild.byte

9
README.win32
View File

@ -22,7 +22,7 @@ Third-party software required
Speed of bytecode interpreter 70% 100% 100%
Replay debugger no no yes
Replay debugger yes (**) yes (**) yes
The Unix library partial partial full
@ -37,6 +37,9 @@ the GPL. Thus, these .exe files can only be distributed under a license
that is compatible with the GPL. Executables generated by MSVC or by
MinGW have no such restrictions.
(**) The debugger is supported but the "replay" function of it are not enabled.
Other functions are available (step, goto, run...).
The remainder of this document gives more information on each port.
------------------------------------------------------------------------------
@ -150,7 +153,7 @@ Unix/GCC or Cygwin or Mingw on similar hardware.
* Libraries available in this port: "num", "str", "threads", "graphics",
"labltk", and large parts of "unix".
* The replay debugger is not supported.
* The replay debugger is partially supported.
CREDITS:
@ -247,7 +250,7 @@ NOTES:
* Libraries available in this port: "num", "str", "threads", "graphics",
"labltk", and large parts of "unix".
* The replay debugger is not supported.
* The replay debugger is partially supported.
------------------------------------------------------------------------------

4
byterun/Makefile.nt
View File

@ -22,10 +22,10 @@ OBJS=$(COMMONOBJS:.o=.$(O)) win32.$(O) main.$(O)
DOBJS=$(OBJS:.$(O)=.$(DBGO)) instrtrace.$(DBGO)
ocamlrun$(EXE): libcamlrun.$(A) prims.$(O)
$(MKEXE) -o ocamlrun$(EXE) prims.$(O) libcamlrun.$(A)
$(MKEXE) -o ocamlrun$(EXE) prims.$(O) $(call SYSLIB,ws2_32) libcamlrun.$(A)
ocamlrund$(EXE): libcamlrund.$(A) prims.$(O) main.$(O)
$(MKEXE) -o ocamlrun$(EXE) $(BYTECCDBGCOMPOPTS) prims.$(O) libcamlrund.$(A)
$(MKEXE) -o ocamlrun$(EXE) $(BYTECCDBGCOMPOPTS) prims.$(O) $(call SYSLIB,ws2_32) libcamlrund.$(A)
libcamlrun.$(A): $(OBJS)
$(call MKLIB,libcamlrun.$(A),$(OBJS))

77
byterun/debugger.c
View File

@ -15,6 +15,10 @@
/* Interface with the debugger */
#ifdef _WIN32
#include <io.h>
#endif /* _WIN32 */
#include <string.h>
#include "config.h"
@ -32,7 +36,7 @@
int caml_debugger_in_use = 0;
uintnat caml_event_count;
#if !defined(HAS_SOCKETS) || defined(_WIN32)
#if !defined(HAS_SOCKETS)
void caml_debugger_init(void)
{
@ -49,17 +53,26 @@ void caml_debugger(enum event_kind event)
#endif
#include <errno.h>
#include <sys/types.h>
#ifndef _WIN32
#include <sys/wait.h>
#include <sys/socket.h>
#include <sys/un.h>
#include <netinet/in.h>
#include <arpa/inet.h>
#include <netdb.h>
#else
#define ATOM ATOM_WS
#include <winsock.h>
#undef ATOM
#include <process.h>
#endif
static int sock_domain; /* Socket domain for the debugger */
static union { /* Socket address for the debugger */
struct sockaddr s_gen;
#ifndef _WIN32
struct sockaddr_un s_unix;
#endif
struct sockaddr_in s_inet;
} sock_addr;
static int sock_addr_len; /* Length of sock_addr */
@ -72,16 +85,46 @@ static char *dbg_addr = "(none)";
static void open_connection(void)
{
#ifdef _WIN32
/* Set socket to synchronous mode so that file descriptor-oriented
functions (read()/write() etc.) can be used */
int oldvalue, oldvaluelen, newvalue, retcode;
oldvaluelen = sizeof(oldvalue);
retcode = getsockopt(INVALID_SOCKET, SOL_SOCKET, SO_OPENTYPE,
(char *) &oldvalue, &oldvaluelen);
if (retcode == 0) {
newvalue = SO_SYNCHRONOUS_NONALERT;
setsockopt(INVALID_SOCKET, SOL_SOCKET, SO_OPENTYPE,
(char *) &newvalue, sizeof(newvalue));
}
#endif
dbg_socket = socket(sock_domain, SOCK_STREAM, 0);
#ifdef _WIN32
if (retcode == 0) {
/* Restore initial mode */
setsockopt(INVALID_SOCKET, SOL_SOCKET, SO_OPENTYPE,
(char *) &oldvalue, oldvaluelen);
}
#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,
"error: %s\n", strerror (errno));
}
#ifdef _WIN32
dbg_socket = _open_osfhandle(dbg_socket, 0);
if (dbg_socket == -1)
caml_fatal_error("_open_osfhandle failed");
#endif
dbg_in = caml_open_descriptor_in(dbg_socket);
dbg_out = caml_open_descriptor_out(dbg_socket);
if (!caml_debugger_in_use) caml_putword(dbg_out, -1); /* first connection */
#ifdef _WIN32
caml_putword(dbg_out, _getpid());
#else
caml_putword(dbg_out, getpid());
#endif
caml_flush(dbg_out);
}
@ -92,6 +135,20 @@ static void close_connection(void)
dbg_socket = -1; /* was closed by caml_close_channel */
}
#ifdef _WIN32
static void winsock_startup(void)
{
WSADATA wsaData;
int err = WSAStartup(MAKEWORD(2, 0), &wsaData);
if (err) caml_fatal_error("WSAStartup failed");
}
static void winsock_cleanup(void)
{
WSACleanup();
}
#endif
void caml_debugger_init(void)
{
char * address;
@ -103,12 +160,17 @@ void caml_debugger_init(void)
if (address == NULL) return;
dbg_addr = address;
#ifdef _WIN32
winsock_startup();
(void)atexit(winsock_cleanup);
#endif
/* Parse the address */
port = NULL;
for (p = address; *p != 0; p++) {
if (*p == ':') { *p = 0; port = p+1; break; }
}
if (port == NULL) {
#ifndef _WIN32
/* Unix domain */
sock_domain = PF_UNIX;
sock_addr.s_unix.sun_family = AF_UNIX;
@ -117,6 +179,9 @@ void caml_debugger_init(void)
sock_addr_len =
((char *)&(sock_addr.s_unix.sun_path) - (char *)&(sock_addr.s_unix))
+ strlen(address);
#else
caml_fatal_error("Unix sockets not supported");
#endif
} else {
/* Internet domain */
sock_domain = PF_INET;
@ -241,6 +306,7 @@ void caml_debugger(enum event_kind event)
caml_set_instruction(caml_start_code + pos, caml_saved_code[pos]);
break;
case REQ_CHECKPOINT:
#ifndef _WIN32
i = fork();
if (i == 0) {
close_connection(); /* Close parent connection. */
@ -249,6 +315,10 @@ void caml_debugger(enum event_kind event)
caml_putword(dbg_out, i);
caml_flush(dbg_out);
}
#else
caml_fatal_error("error: REQ_CHECKPOINT command");
exit(-1);
#endif
break;
case REQ_GO:
caml_event_count = caml_getword(dbg_in);
@ -257,7 +327,12 @@ void caml_debugger(enum event_kind event)
exit(0);
break;
case REQ_WAIT:
#ifndef _WIN32
wait(NULL);
#else
caml_fatal_error("Fatal error: REQ_WAIT command");
exit(-1);
#endif
break;
case REQ_INITIAL_FRAME:
frame = caml_extern_sp + 1;

10
config/Makefile.mingw
View File

@ -66,7 +66,7 @@ ASPP=gcc
ASPPPROFFLAGS=
PROFILING=noprof
DYNLINKOPTS=
DEBUGGER=
DEBUGGER=ocamldebugger
CC_PROFILE=
SYSTHREAD_SUPPORT=true
EXTRALIBS=
@ -87,8 +87,8 @@ BYTECCLINKOPTS=
DLLCCCOMPOPTS=-O -mms-bitfields -Wall -Wno-unused -DCAML_DLL
### Libraries needed
BYTECCLIBS=
NATIVECCLIBS=
BYTECCLIBS=-lws2_32
NATIVECCLIBS=-lws2_32
### How to invoke the C preprocessor
CPP=$(BYTECC) -E
@ -149,8 +149,8 @@ BNG_ASM_LEVEL=1
# There must be no spaces or special characters in $(TK_ROOT)
TK_ROOT=c:/tcl
TK_DEFS=-I$(TK_ROOT)/include
TK_LINK=$(TK_ROOT)/bin/tk83.dll $(TK_ROOT)/bin/tcl83.dll -lwsock32
#TK_LINK=$(TK_ROOT)/lib/tk84.lib $(TK_ROOT)/lib/tcl84.lib -lwsock32
TK_LINK=$(TK_ROOT)/bin/tk83.dll $(TK_ROOT)/bin/tcl83.dll -lws2_32
#TK_LINK=$(TK_ROOT)/lib/tk84.lib $(TK_ROOT)/lib/tcl84.lib -lws2_32
############# Aliases for common commands

12
config/Makefile.msvc
View File

@ -65,7 +65,7 @@ ASPP=
ASPPPROFFLAGS=
PROFILING=noprof
DYNLINKOPTS=
DEBUGGER=
DEBUGGER=ocamldebugger
CC_PROFILE=
SYSTHREAD_SUPPORT=true
EXTRALIBS=
@ -86,8 +86,8 @@ BYTECCLINKOPTS=/MD /F16777216
DLLCCCOMPOPTS=/Ox /MD
### Libraries needed
BYTECCLIBS=advapi32.lib
NATIVECCLIBS=advapi32.lib
BYTECCLIBS=advapi32.lib ws2_32.lib
NATIVECCLIBS=advapi32.lib ws2_32.lib
### How to invoke the C preprocessor
CPP=cl /nologo /EP
@ -152,11 +152,11 @@ TK_DEFS=-I$(TK_ROOT)/include
# produced by OCaml, and is therefore required for binary distribution
# of these libraries. However, $(TK_ROOT) must be added to the LIB
# environment variable, as described in README.win32.
#TK_LINK=tk84.lib tcl84.lib wsock32.lib
TK_LINK=tk83.lib tcl83.lib wsock32.lib
#TK_LINK=tk84.lib tcl84.lib ws2_32.lib
TK_LINK=tk83.lib tcl83.lib ws2_32.lib
# An alternative definition that avoids mucking with the LIB variable,
# but hard-wires the Tcl/Tk location in the binaries
# TK_LINK=$(TK_ROOT)/tk83.lib $(TK_ROOT)/tcl83.lib wsock32.lib
# TK_LINK=$(TK_ROOT)/tk83.lib $(TK_ROOT)/tcl83.lib ws2_32.lib
############# Aliases for common commands

6
config/Makefile.msvc64
View File

@ -66,7 +66,7 @@ ASPP=
ASPPPROFFLAGS=
PROFILING=noprof
DYNLINKOPTS=
DEBUGGER=
DEBUGGER=ocamldebugger
CC_PROFILE=
SYSTHREAD_SUPPORT=true
CMXS=cmxs
@ -90,8 +90,8 @@ DLLCCCOMPOPTS=/Ox /MD
### Libraries needed
EXTRALIBS=bufferoverflowu.lib
BYTECCLIBS=advapi32.lib $(EXTRALIBS)
NATIVECCLIBS=advapi32.lib $(EXTRALIBS)
BYTECCLIBS=advapi32.lib ws2_32.lib $(EXTRALIBS)
NATIVECCLIBS=advapi32.lib ws2_32.lib $(EXTRALIBS)
### How to invoke the C preprocessor
CPP=cl /nologo /EP

104
debugger/Makefile
View File

@ -12,105 +12,5 @@
# $Id$
include ../config/Makefile
CAMLC=../ocamlcomp.sh
COMPFLAGS=-warn-error A $(INCLUDES)
LINKFLAGS=-linkall -I ../otherlibs/unix
CAMLYACC=../boot/ocamlyacc
YACCFLAGS=
CAMLLEX=../boot/ocamlrun ../boot/ocamllex
CAMLDEP=../boot/ocamlrun ../tools/ocamldep
DEPFLAGS=$(INCLUDES)
INCLUDES=\
-I ../utils -I ../parsing -I ../typing -I ../bytecomp -I ../toplevel \
-I ../otherlibs/unix
OTHEROBJS=\
../otherlibs/unix/unix.cma \
../utils/misc.cmo ../utils/config.cmo \
../utils/tbl.cmo ../utils/clflags.cmo ../utils/consistbl.cmo \
../parsing/longident.cmo \
../typing/ident.cmo ../typing/path.cmo ../typing/types.cmo \
../typing/btype.cmo ../typing/primitive.cmo ../typing/typedtree.cmo \
../typing/subst.cmo ../typing/predef.cmo \
../typing/datarepr.cmo ../typing/env.cmo ../typing/oprint.cmo \
../typing/ctype.cmo ../typing/printtyp.cmo ../typing/mtype.cmo \
../bytecomp/runtimedef.cmo ../bytecomp/bytesections.cmo \
../bytecomp/dll.cmo ../bytecomp/meta.cmo ../bytecomp/symtable.cmo \
../bytecomp/opcodes.cmo \
../toplevel/genprintval.cmo
OBJS=\
dynlink.cmo \
int64ops.cmo \
primitives.cmo \
unix_tools.cmo \
debugger_config.cmo \
envaux.cmo \
parameters.cmo \
lexer.cmo \
input_handling.cmo \
question.cmo \
debugcom.cmo \
exec.cmo \
source.cmo \
pos.cmo \
checkpoints.cmo \
events.cmo \
symbols.cmo \
breakpoints.cmo \
trap_barrier.cmo \
history.cmo \
program_loading.cmo \
printval.cmo \
show_source.cmo \
time_travel.cmo \
program_management.cmo \
frames.cmo \
eval.cmo \
show_information.cmo \
loadprinter.cmo \
parser.cmo \
command_line.cmo \
main.cmo
all: ocamldebug$(EXE)
ocamldebug$(EXE): $(OBJS) $(OTHEROBJS)
$(CAMLC) $(LINKFLAGS) -o ocamldebug$(EXE) -linkall $(OTHEROBJS) $(OBJS)
install:
cp ocamldebug$(EXE) $(BINDIR)/ocamldebug$(EXE)
clean::
rm -f ocamldebug$(EXE)
rm -f *.cmo *.cmi
.SUFFIXES:
.SUFFIXES: .ml .cmo .mli .cmi
.ml.cmo:
$(CAMLC) -c $(COMPFLAGS) $<
.mli.cmi:
$(CAMLC) -c $(COMPFLAGS) $<
depend: beforedepend
$(CAMLDEP) $(DEPFLAGS) *.mli *.ml > .depend
lexer.ml: lexer.mll
$(CAMLLEX) lexer.mll
clean::
rm -f lexer.ml
beforedepend:: lexer.ml
parser.ml parser.mli: parser.mly
$(CAMLYACC) parser.mly
clean::
rm -f parser.ml parser.mli
beforedepend:: parser.ml parser.mli
include .depend
UNIXDIR=../otherlibs/unix
include Makefile.shared

17
debugger/Makefile.nt Normal file
View File

@ -0,0 +1,17 @@
#########################################################################
# #
# Objective Caml #
# #
# Xavier Leroy, projet Cristal, INRIA Rocquencourt #
# #
# Copyright 1999 Institut National de Recherche en Informatique et #
# en Automatique. All rights reserved. This file is distributed #
# under the terms of the Q Public License version 1.0. #
# #
#########################################################################
# $Id$
UNIXDIR=../otherlibs/win32unix
include Makefile.shared

116
debugger/Makefile.shared Normal file
View File

@ -0,0 +1,116 @@
#########################################################################
# #
# Objective Caml #
# #
# Xavier Leroy, projet Cristal, INRIA Rocquencourt #
# #
# Copyright 1999 Institut National de Recherche en Informatique et #
# en Automatique. All rights reserved. This file is distributed #
# under the terms of the Q Public License version 1.0. #
# #
#########################################################################
# $Id$
include ../config/Makefile
CAMLC=../ocamlcomp.sh
COMPFLAGS=-warn-error A $(INCLUDES)
LINKFLAGS=-linkall -I $(UNIXDIR)
CAMLYACC=../boot/ocamlyacc
YACCFLAGS=
CAMLLEX=../boot/ocamlrun ../boot/ocamllex
CAMLDEP=../boot/ocamlrun ../tools/ocamldep
DEPFLAGS=$(INCLUDES)
INCLUDES=\
-I ../utils -I ../parsing -I ../typing -I ../bytecomp -I ../toplevel \
-I $(UNIXDIR)
OTHEROBJS=\
$(UNIXDIR)/unix.cma \
../utils/misc.cmo ../utils/config.cmo \
../utils/tbl.cmo ../utils/clflags.cmo ../utils/consistbl.cmo \
../parsing/longident.cmo \
../typing/ident.cmo ../typing/path.cmo ../typing/types.cmo \
../typing/btype.cmo ../typing/primitive.cmo ../typing/typedtree.cmo \
../typing/subst.cmo ../typing/predef.cmo \
../typing/datarepr.cmo ../typing/env.cmo ../typing/oprint.cmo \
../typing/ctype.cmo ../typing/printtyp.cmo ../typing/mtype.cmo \
../bytecomp/runtimedef.cmo ../bytecomp/bytesections.cmo \
../bytecomp/dll.cmo ../bytecomp/meta.cmo ../bytecomp/symtable.cmo \
../bytecomp/opcodes.cmo \
../toplevel/genprintval.cmo
OBJS=\
dynlink.cmo \
int64ops.cmo \
primitives.cmo \
unix_tools.cmo \
debugger_config.cmo \
envaux.cmo \
parameters.cmo \
lexer.cmo \
input_handling.cmo \
question.cmo \
debugcom.cmo \
exec.cmo \
source.cmo \
pos.cmo \
checkpoints.cmo \
events.cmo \
symbols.cmo \
breakpoints.cmo \
trap_barrier.cmo \
history.cmo \
program_loading.cmo \
printval.cmo \
show_source.cmo \
time_travel.cmo \
program_management.cmo \
frames.cmo \
eval.cmo \
show_information.cmo \
loadprinter.cmo \
parser.cmo \
command_line.cmo \
main.cmo
all: ocamldebug$(EXE)
ocamldebug$(EXE): $(OBJS) $(OTHEROBJS)
$(CAMLC) $(LINKFLAGS) -o ocamldebug$(EXE) -linkall $(OTHEROBJS) $(OBJS)
install:
cp ocamldebug$(EXE) $(BINDIR)/ocamldebug$(EXE)
clean::
rm -f ocamldebug$(EXE)
rm -f *.cmo *.cmi
.SUFFIXES:
.SUFFIXES: .ml .cmo .mli .cmi
.ml.cmo:
$(CAMLC) -c $(COMPFLAGS) $<
.mli.cmi:
$(CAMLC) -c $(COMPFLAGS) $<
depend: beforedepend
$(CAMLDEP) $(DEPFLAGS) *.mli *.ml > .depend
lexer.ml: lexer.mll
$(CAMLLEX) lexer.mll
clean::
rm -f lexer.ml
beforedepend:: lexer.ml
parser.ml parser.mli: parser.mly
$(CAMLYACC) parser.mly
clean::
rm -f parser.ml parser.mli
beforedepend:: parser.ml parser.mli
include .depend

14
debugger/command_line.ml
View File

@ -76,6 +76,13 @@ let error text =
eprintf "%s@." text;
raise Toplevel
let check_not_windows feature =
match Sys.os_type with
| "Win32" ->
error ("'"^feature^"' feature not supported on Windows")
| _ ->
()
let eol =
end_of_line Lexer.lexeme
@ -220,7 +227,7 @@ let instr_shell ppf lexbuf =
let instr_pwd ppf lexbuf =
eol lexbuf;
ignore(system "/bin/pwd")
fprintf ppf "%s@." (Sys.getcwd ())
let instr_dir ppf lexbuf =
let new_directory = argument_list_eol argument lexbuf in
@ -254,6 +261,7 @@ let instr_run ppf lexbuf =
let instr_reverse ppf lexbuf =
eol lexbuf;
check_not_windows "reverse";
ensure_loaded ();
reset_named_values();
back_run ();
@ -276,6 +284,7 @@ let instr_back ppf lexbuf =
| None -> _1
| Some x -> x
in
check_not_windows "backstep";
ensure_loaded ();
reset_named_values();
step (_0 -- step_count);
@ -301,6 +310,7 @@ let instr_next ppf lexbuf =
let instr_start ppf lexbuf =
eol lexbuf;
check_not_windows "start";
ensure_loaded ();
reset_named_values();
start ();
@ -312,6 +322,7 @@ let instr_previous ppf lexbuf =
| None -> 1
| Some x -> x
in
check_not_windows "previous";
ensure_loaded ();
reset_named_values();
previous step_count;
@ -672,6 +683,7 @@ let instr_last ppf lexbuf =
| None -> _1
| Some x -> x
in
check_not_windows "last";
reset_named_values();
go_to (History.previous_time count);
show_current_event ppf

11
debugger/debugcom.ml
View File

@ -99,10 +99,13 @@ let rec do_go n =
(* Perform a checkpoint *)
let do_checkpoint () =
output_char !conn.io_out 'c';
flush !conn.io_out;
let pid = input_binary_int !conn.io_in in
if pid = -1 then Checkpoint_failed else Checkpoint_done pid
match Sys.os_type with
"Win32" -> failwith "do_checkpoint"
| _ ->
output_char !conn.io_out 'c';
flush !conn.io_out;
let pid = input_binary_int !conn.io_in in
if pid = -1 then Checkpoint_failed else Checkpoint_done pid
(* Kill the given process. *)
let stop chan =

11
debugger/debugger_config.ml
View File

@ -51,7 +51,10 @@ let event_mark_before = "<|b|>"
let event_mark_after = "<|a|>"
(* Name of shell used to launch the debuggee *)
let shell = "/bin/sh"
let shell =
match Sys.os_type with
"Win32" -> "cmd"
| _ -> "/bin/sh"
(* Name of the Objective Caml runtime. *)
let runtime_program = "ocamlrun"
@ -71,5 +74,7 @@ let checkpoint_small_step = ref (~~ "1000")
let checkpoint_max_count = ref 15
(* Whether to keep checkpoints or not. *)
let make_checkpoints = ref true
let make_checkpoints = ref
(match Sys.os_type with
"Win32" -> false
| _ -> true)

7
debugger/exec.ml
View File

@ -25,8 +25,11 @@ let break signum =
else raise Sys.Break
let _ =
Sys.set_signal Sys.sigint (Sys.Signal_handle break);
Sys.set_signal Sys.sigpipe (Sys.Signal_handle (fun _ -> raise End_of_file))
match Sys.os_type with
"Win32" -> ()
| _ ->
Sys.set_signal Sys.sigint (Sys.Signal_handle break);
Sys.set_signal Sys.sigpipe (Sys.Signal_handle (fun _ -> raise End_of_file))
let protect f =
if !is_protected then

11
debugger/main.ml
View File

@ -148,8 +148,15 @@ let speclist = [
let main () =
try
socket_name := Filename.concat Filename.temp_dir_name
("camldebug" ^ (string_of_int (Unix.getpid ())));
socket_name :=
(match Sys.os_type with
"Win32" ->
(Unix.string_of_inet_addr Unix.inet_addr_loopback)^
":"^
(string_of_int (10000 + ((Unix.getpid ()) mod 10000)))
| _ -> Filename.concat Filename.temp_dir_name
("camldebug" ^ (string_of_int (Unix.getpid ())))
);
begin try
Arg.parse speclist anonymous "";
Arg.usage speclist

39
debugger/program_loading.ml
View File

@ -37,7 +37,7 @@ let load_program () =
(*** Launching functions. ***)
(* A generic function for launching the program *)
let generic_exec cmdline = function () ->
let generic_exec_unix cmdline = function () ->
if !debug_loading then
prerr_endline "Launching program...";
let child =
@ -64,11 +64,36 @@ let generic_exec cmdline = function () ->
(_, WEXITED 0) -> ()
| _ -> raise Toplevel
let generic_exec_win cmdline = function () ->
if !debug_loading then
prerr_endline "Launching program...";
try ignore(create_process "cmd.exe" [| "/C"; cmdline() |] stdin stdout stderr)
with x ->
Unix_tools.report_error x;
raise Toplevel
let generic_exec =
match Sys.os_type with
"Win32" -> generic_exec_win
| _ -> generic_exec_unix
(* Execute the program by calling the runtime explicitely *)
let exec_with_runtime =
generic_exec
(function () ->
Printf.sprintf "CAML_DEBUG_SOCKET=%s %s %s %s"
match Sys.os_type with
"Win32" ->
(* This fould fail on a file name with spaces
but quoting is even worse because Unix.create_process
thinks each command line parameter is a file.
So no good solution so far *)
Printf.sprintf "set CAML_DEBUG_SOCKET=%s && %s %s %s"
!socket_name
runtime_program
!program_name
!arguments
| _ ->
Printf.sprintf "CAML_DEBUG_SOCKET=%s %s %s %s"
!socket_name
(Filename.quote runtime_program)
(Filename.quote !program_name)
@ -78,7 +103,15 @@ let exec_with_runtime =
let exec_direct =
generic_exec
(function () ->
Printf.sprintf "CAML_DEBUG_SOCKET=%s %s %s"
match Sys.os_type with
"Win32" ->
(* See the comment above *)
Printf.sprintf "set CAML_DEBUG_SOCKET=%s && %s %s"
!socket_name
!program_name
!arguments
| _ ->
Printf.sprintf "CAML_DEBUG_SOCKET=%s %s %s"
!socket_name
(Filename.quote !program_name)
!arguments)

1
debugger/program_management.ml
View File

@ -74,6 +74,7 @@ let open_connection address continue =
let sock = socket sock_domain SOCK_STREAM 0 in
(try
bind sock sock_address;
setsockopt sock SO_REUSEADDR true;
listen sock 3;
connection := io_channel_of_descr sock;
Input_handling.add_file !connection (accept_connection continue);

4
debugger/unix_tools.ml
View File

@ -36,7 +36,9 @@ let convert_address address =
prerr_endline "The port number should be an integer";
failwith "Can't convert address")))
with Not_found ->
(PF_UNIX, ADDR_UNIX address)
match Sys.os_type with
"Win32" -> failwith "Unix sockets not supported"
| _ -> (PF_UNIX, ADDR_UNIX address)
(*** Report a unix error. ***)
let report_error = function

4
myocamlbuild.ml
View File

@ -432,8 +432,8 @@ flag ["c"; "compile"; "otherlibs_num"] begin
A"-I"; P"../otherlibs/num"]
end;;
flag ["c"; "compile"; "otherlibs_win32unix"] (A"-I../otherlibs/win32unix");;
flag [(* "ocaml" or "c"; *) "ocamlmklib"; "otherlibs_win32unix"] (S[A"-cclib"; Quote (syslib "wsock32")]);;
flag ["c"; "link"; "dll"; "otherlibs_win32unix"] (syslib "wsock32");;
flag [(* "ocaml" or "c"; *) "ocamlmklib"; "otherlibs_win32unix"] (S[A"-cclib"; Quote (syslib "ws2_32")]);;
flag ["c"; "link"; "dll"; "otherlibs_win32unix"] (syslib "ws2_32");;
let flags = S[syslib "kernel32"; syslib "gdi32"; syslib "user32"] in
flag ["c"; "ocamlmklib"; "otherlibs_win32graph"] (S[A"-cclib"; Quote flags]);
flag ["c"; "link"; "dll"; "otherlibs_win32graph"] flags;;

5
otherlibs/win32unix/Makefile.nt
View File

@ -21,7 +21,8 @@ WIN_FILES = accept.c bind.c channels.c close.c \
mkdir.c open.c pipe.c read.c rename.c \
select.c sendrecv.c \
shutdown.c sleep.c socket.c sockopt.c startup.c stat.c \
system.c unixsupport.c windir.c winwait.c write.c
system.c unixsupport.c windir.c winwait.c write.c \
winlist.c winworker.c windbug.c
# Files from the ../unix directory
UNIX_FILES = access.c addrofstr.c chdir.c chmod.c cst2constr.c \
@ -33,7 +34,7 @@ UNIX_FILES = access.c addrofstr.c chdir.c chmod.c cst2constr.c \
UNIX_CAML_FILES = unix.mli unixLabels.mli unixLabels.ml
ALL_FILES=$(WIN_FILES) $(UNIX_FILES)
WSOCKLIB=$(call SYSLIB,wsock32)
WSOCKLIB=$(call SYSLIB,ws2_32)
LIBNAME=unix
COBJS=$(ALL_FILES:.c=.$(O))

1
otherlibs/win32unix/dllunix.dlib
View File

@ -7,6 +7,7 @@ mkdir.d.o open.d.o pipe.d.o read.d.o rename.d.o
select.d.o sendrecv.d.o
shutdown.d.o sleep.d.o socket.d.o sockopt.d.o startup.d.o stat.d.o
system.d.o unixsupport.d.o windir.d.o winwait.d.o write.d.o
winlist.d.o winworker.d.o windbug.d.o
# Files from the ../unix directory
access.d.o addrofstr.d.o chdir.d.o chmod.d.o cst2constr.d.o

1
otherlibs/win32unix/libunix.clib
View File

@ -7,6 +7,7 @@ mkdir.o open.o pipe.o read.o rename.o
select.o sendrecv.o
shutdown.o sleep.o socket.o sockopt.o startup.o stat.o
system.o unixsupport.o windir.o winwait.o write.o
winlist.o winworker.o windbug.o
# Files from the ../unix directory
access.o addrofstr.o chdir.o chmod.o cst2constr.o

1084
otherlibs/win32unix/select.c
View File

File diff suppressed because it is too large Load Diff

11
otherlibs/win32unix/startup.c
View File

@ -16,6 +16,8 @@
#include <stdlib.h>
#include <mlvalues.h>
#include "unixsupport.h"
#include "winworker.h"
#include "windbug.h"
value val_process_id;
@ -26,18 +28,27 @@ CAMLprim value win_startup(unit)
int i;
HANDLE h;
DBUG_INIT;
(void) WSAStartup(MAKEWORD(2, 0), &wsaData);
DuplicateHandle(GetCurrentProcess(), GetCurrentProcess(),
GetCurrentProcess(), &h, 0, TRUE,
DUPLICATE_SAME_ACCESS);
val_process_id = Val_int(h);
worker_init();
return Val_unit;
}
CAMLprim value win_cleanup(unit)
value unit;
{
worker_cleanup();
(void) WSACleanup();
DBUG_CLEANUP;
return Val_unit;
}