Re: [Caml-list] Ocaml debugger under Windows

["Dmitry Bely" <dmitry.bely@gmail.com>]

[-- Attachment #1: Type: text/plain, Size: 909 bytes --]

On Wed, Feb 6, 2008 at 9:12 PM, Xavier Leroy <Xavier.Leroy@inria.fr> wrote:

[...]
>  Actually, I would be happy with a Win32 implementation of Unix.select
>  that works over any combination of sockets and file descriptors.
>  Unfortunately, it looks like we'd need a gross hack involving threads,
>  WaitForMultipleObjects() and select(), but if someone comes up with an
>  implementation that isn't too gross, I'll be interested.

OK, I have found some spare time and finally done that. Both select()
and ocamldebug now work on Win32. Console, pipes, disk files, sockets
can now be tested for reading; write and exceptional condition lists
are not supported yet (write probably cannot be implemented, at least
Cygwin and GDB don't care, but exceptional conditions probably can if
someone explains me an expected semantics).

The patch is attached. Please let me know what do you think of it.

- Dmitry Bely

[-- Attachment #2: win32_select_debug.diff --]
[-- Type: application/octet-stream, Size: 23042 bytes --]

Index: debugger/exec.ml
===================================================================
--- debugger/exec.ml	(revision 143)
+++ debugger/exec.ml	(revision 146)
@@ -25,8 +25,11 @@
   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
Index: debugger/unix_tools.ml
===================================================================
--- debugger/unix_tools.ml	(revision 143)
+++ debugger/unix_tools.ml	(revision 146)
@@ -36,7 +36,9 @@
                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
Index: debugger/program_loading.ml
===================================================================
--- debugger/program_loading.ml	(revision 143)
+++ debugger/program_loading.ml	(revision 146)
@@ -37,7 +37,7 @@
 (*** 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,12 +64,37 @@
        (_, 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)
                      !arguments)
@@ -78,8 +103,16 @@
 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)
 
Index: debugger/debugger_config.ml
===================================================================
--- debugger/debugger_config.ml	(revision 143)
+++ debugger/debugger_config.ml	(revision 146)
@@ -51,7 +51,10 @@
 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_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)
Index: debugger/main.ml
===================================================================
--- debugger/main.ml	(revision 143)
+++ debugger/main.ml	(revision 146)
@@ -148,8 +148,12 @@
 
 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" -> "127.0.0.1:10000"
+      | _ -> Filename.concat Filename.temp_dir_name
+                                ("camldebug" ^ (string_of_int (Unix.getpid ())))
+      );
     begin try
       Arg.parse speclist anonymous "";
       Arg.usage speclist
Index: debugger/debugcom.ml
===================================================================
--- debugger/debugcom.ml	(revision 143)
+++ debugger/debugcom.ml	(revision 146)
@@ -99,10 +99,13 @@
 (* 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 =
Index: byterun/debugger.c
===================================================================
--- byterun/debugger.c	(revision 143)
+++ byterun/debugger.c	(revision 146)
@@ -32,7 +32,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)
 {
@@ -48,17 +48,25 @@
 #include <unistd.h>
 #endif
 #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
+#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 */
@@ -69,10 +77,36 @@
 
 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("cannot connect to debugger");
+#ifdef _WIN32
+  dbg_socket = _open_osfhandle(dbg_socket);
+  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 */
@@ -87,6 +121,20 @@
   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;
@@ -97,12 +145,17 @@
   address = getenv("CAML_DEBUG_SOCKET");
   if (address == NULL) return;
 
+#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;
@@ -111,6 +164,9 @@
     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;
@@ -235,6 +291,7 @@
       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. */
@@ -243,6 +300,10 @@
         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);
@@ -251,7 +312,12 @@
       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;
Index: otherlibs/win32unix/select.c
===================================================================
--- otherlibs/win32unix/select.c	(revision 143)
+++ otherlibs/win32unix/select.c	(revision 146)
@@ -17,79 +17,334 @@
 #include <alloc.h>
 #include <memory.h>
 #include <signals.h>
+#include <WinSock2.h>
+#include <Mswsock.h>
 #include "unixsupport.h"
 
-static void fdlist_to_fdset(value fdlist, fd_set *fdset)
+enum HandleType {
+  UnknownHandle,
+  DiskHandle,
+  ConsoleHandle,
+  PipeHandle,
+  SocketHandle,
+};
+
+static enum HandleType get_handle_type(HANDLE h)
 {
-  value l;
-  FD_ZERO(fdset);
-  for (l = fdlist; l != Val_int(0); l = Field(l, 1)) {
-    FD_SET(Socket_val(Field(l, 0)), fdset);
+  switch(GetFileType(h)){
+    case FILE_TYPE_DISK: return DiskHandle;
+    case FILE_TYPE_CHAR: /* character file or a console */
+      {
+        DWORD mode;
+        if (GetConsoleMode(h, &mode) != 0){
+          return ConsoleHandle;
+        }
+        else {
+          return UnknownHandle;
+        }
+      }
+    case FILE_TYPE_PIPE: /* socket, a named pipe, or an anonymous pipe */
+      {
+        int optval, optlen = sizeof(optval);
+        if (getsockopt((SOCKET)h, SOL_SOCKET, SO_TYPE, (char *) &optval, &optlen) != 0
+          && WSAGetLastError() == WSAENOTSOCK){
+          return PipeHandle;
+        }
+        else {
+          return SocketHandle;
+        }
+      }
+    default:
+      return UnknownHandle;
   }
 }
 
-static value fdset_to_fdlist(value fdlist, fd_set *fdset)
+enum State {
+  None,
+  InitFailed,
+  Error,
+  Read
+};
+
+struct Handle_proc {
+  HANDLE h;
+  HANDLE done_event;
+
+  /* state */
+  volatile enum State state;
+  volatile DWORD error;
+
+  /* thread synchronization */
+  HANDLE stop_thread_event;
+  HANDLE thread_started_event;
+  HANDLE thread_handle;
+};
+
+static int check_error(struct Handle_proc * hp, int failed)
 {
-  value res = Val_int(0);
-  Begin_roots2(fdlist, res)
-    for (/*nothing*/; fdlist != Val_int(0); fdlist = Field(fdlist, 1)) {
-      value s = Field(fdlist, 0);
-      if (FD_ISSET(Socket_val(s), fdset)) {
-        value newres = alloc_small(2, 0);
-        Field(newres, 0) = s;
-        Field(newres, 1) = res;
-        res = newres;
+  if (failed && hp->error == 0){
+    hp->state = Error;
+    hp->error = GetLastError();
+  }
+  return failed;
+}
+
+static void start_thread(struct Handle_proc * hp, LPTHREAD_START_ROUTINE thread_proc)
+{
+  check_error(hp, 
+    (hp->thread_handle = CreateThread(NULL, 0, thread_proc, hp, 0, NULL)) == NULL ||
+    WaitForSingleObject(hp->thread_started_event, INFINITE) == WAIT_FAILED);
+}
+
+static void stop_thread(struct Handle_proc * hp)
+{
+  check_error(hp,
+    SetEvent(hp->stop_thread_event) == 0 ||
+    WaitForSingleObject(hp->done_event, INFINITE) == WAIT_FAILED);
+}
+
+/* disk */
+
+static void init_disk(struct Handle_proc * hp)
+{
+  /* Assume that disk I/O never blocks */
+  hp->state = Read;
+  check_error(hp, SetEvent(hp->done_event) == 0);
+}
+
+static void done_disk(struct Handle_proc * hp)
+{
+}
+
+/* console */
+
+static DWORD WINAPI console_thread(LPVOID param)
+{
+  struct Handle_proc * hp = param;
+
+  check_error(hp, SetEvent(hp->thread_started_event) == 0);
+  while (hp->state == None){
+    HANDLE events[2];
+    INPUT_RECORD record;
+    DWORD event, n;
+
+    events[0] = hp->stop_thread_event;
+    events[1] = hp->h;
+    event = WaitForMultipleObjects(2, events, FALSE, INFINITE);
+    if (event == WAIT_OBJECT_0 || check_error(hp, event == WAIT_FAILED)){
+      /* stop_thread_event or error */
+      break;
+    }
+    /* console event */
+    if (check_error(hp, PeekConsoleInput(hp->h, &record, 1, &n) == 0)){
+      break;
+    }
+    /* check for ASCII keypress only */
+    if (record.EventType == KEY_EVENT &&
+        record.Event.KeyEvent.bKeyDown &&
+        record.Event.KeyEvent.uChar.AsciiChar != 0){
+        hp->state = Read;
+        break;
+    }
+    else {
+      /* discard everything else and try again */ 
+      if (check_error(hp, ReadConsoleInput(hp->h, &record, 1, &n) == 0)){
+        break;
       }
     }
-  End_roots();
-  return res;
+  }
+  check_error(hp, SetEvent(hp->done_event) == 0);
+  return 0;
 }
 
+static void init_console(struct Handle_proc * hp)
+{
+  start_thread(hp, console_thread);
+}
+
+static void done_console(struct Handle_proc * hp)
+{
+  stop_thread(hp);
+}
+
+/* pipe */
+
+static DWORD WINAPI pipe_thread(LPVOID param)
+{
+  struct Handle_proc * hp = param;
+
+  check_error(hp, SetEvent(hp->thread_started_event) == 0);
+  while (hp->state == None){
+    DWORD event, n;
+    if (check_error(hp, PeekNamedPipe(hp->h, NULL, 0, NULL, &n, NULL) == 0)){
+      break;
+    }
+    if (n > 0){
+      hp->state = Read;
+      break;
+    }
+
+    /* Alas, nothing except polling seems to work for pipes.
+       Check the state & stop_thread_event every 10 ms */
+    event = WaitForSingleObject(hp->stop_thread_event, 10);
+    if (event == WAIT_OBJECT_0 || check_error(hp, event == WAIT_FAILED)){
+      break;
+    }
+  }
+  check_error(hp, SetEvent(hp->done_event) == 0);
+  return 0;
+}
+
+static void init_pipe(struct Handle_proc * hp)
+{
+  start_thread(hp, pipe_thread);
+}
+
+static void done_pipe(struct Handle_proc * hp)
+{
+  stop_thread(hp);
+}
+
+/* socket */
+
+static void init_socket(struct Handle_proc * hp)
+{
+  check_error(hp, WSAEventSelect((SOCKET)hp->h, hp->done_event, FD_ACCEPT | FD_READ) != 0);
+}
+
+static void done_socket(struct Handle_proc * hp)
+{
+  /* check if done_event is signalled */
+  DWORD event = WaitForSingleObject(hp->done_event,0);
+  if (check_error(hp, event == WAIT_FAILED)){
+    return;
+  }
+  if (event == WAIT_OBJECT_0){
+    hp->state = Read;
+  }
+  /* WSAEventSelect() automatically sets socket to nonblocking mode.
+     Restore the blocking one. */
+  {
+    u_long iMode = 0;
+    check_error(hp,
+      WSAEventSelect((SOCKET)hp->h, hp->done_event, 0) != 0 ||
+      ioctlsocket((SOCKET)hp->h, FIONBIO, &iMode) != 0);
+  }
+}
+
+static void init_handle_proc(HANDLE h, struct Handle_proc * hp)
+{
+  hp->h = h;
+  hp->done_event = CreateEvent(0, TRUE, FALSE, 0);
+  hp->state = None;
+  hp->error = 0;
+  hp->stop_thread_event = CreateEvent(0, TRUE, FALSE, 0);
+  hp->thread_started_event = CreateEvent(0, TRUE, FALSE, 0);
+  hp->thread_handle = INVALID_HANDLE_VALUE;
+  if (hp->done_event == NULL
+    || hp->stop_thread_event == NULL
+    || hp->thread_started_event == NULL){
+      hp->state = InitFailed;
+      hp->error = GetLastError();
+  }
+  else {
+    switch(get_handle_type(hp->h)){
+      case DiskHandle: init_disk(hp); break;
+      case ConsoleHandle: init_console(hp); break;
+      case PipeHandle: init_pipe(hp); break;
+      case SocketHandle: init_socket(hp); break;
+      default: UnknownHandle:
+        hp->state = InitFailed;
+        hp->error = ERROR_INVALID_HANDLE;
+    }
+  }
+}
+
+static void done_handle_proc(struct Handle_proc * hp)
+{
+  if (hp->state != InitFailed){
+    switch(get_handle_type(hp->h)){
+      case DiskHandle: done_disk(hp); break;
+      case ConsoleHandle: done_console(hp); break;
+      case PipeHandle: done_pipe(hp); break;
+      case SocketHandle: done_socket(hp); break;
+    }
+  }
+  /* ignore errors */
+  CloseHandle(hp->done_event);
+  CloseHandle(hp->stop_thread_event);
+  CloseHandle(hp->thread_started_event);
+  CloseHandle(hp->thread_handle);
+}
+
+
 CAMLprim value unix_select(value readfds, value writefds, value exceptfds, value timeout)
 {
-  fd_set read, write, except;
-  double tm;
-  struct timeval tv;
-  struct timeval * tvp;
-  int retcode;
+  DWORD tm;
   value res;
-  value read_list = Val_unit, write_list = Val_unit, except_list = Val_unit;
+  value read_list = Val_emptylist, write_list = Val_emptylist, except_list = Val_emptylist;
   DWORD err = 0;
 
   Begin_roots3 (readfds, writefds, exceptfds)
   Begin_roots3 (read_list, write_list, except_list)
-    tm = Double_val(timeout);
-    if (readfds == Val_int(0)
-	&& writefds == Val_int(0)
-	&& exceptfds == Val_int(0)) {
+    tm = Double_val(timeout) > 0? Double_val(timeout)*1000: INFINITE;
+    if (writefds != Val_emptylist
+        || exceptfds != Val_emptylist) {
+        invalid_argument("Unix.select: write/except conditions not implemented");
+    }
+    if (readfds == Val_emptylist) {
       if ( tm > 0.0 ) {
-	enter_blocking_section();
-	Sleep( (int)(tm * 1000));
-	leave_blocking_section();
+        enter_blocking_section();
+        Sleep( (int)(tm * 1000));
+        leave_blocking_section();
       }
-      read_list = write_list = except_list = Val_int(0);
     } else {      
-      fdlist_to_fdset(readfds, &read);
-      fdlist_to_fdset(writefds, &write);
-      fdlist_to_fdset(exceptfds, &except);
-      if (tm < 0.0)
-	tvp = (struct timeval *) NULL;
-      else {
-	tv.tv_sec = (int) tm;
-	tv.tv_usec = (int) (1e6 * (tm - (int) tm));
-	tvp = &tv;
+      HANDLE events[MAXIMUM_WAIT_OBJECTS];
+      struct Handle_proc hproc[MAXIMUM_WAIT_OBJECTS];
+      int i, n;
+      value l;
+      for (l = readfds, i = 0; l != Val_emptylist && err == 0; l = Field(l, 1), ++i) {
+        value fd = Field(l, 0);
+        init_handle_proc(Handle_val(fd), &hproc[i]);
+        switch(hproc[i].state){
+          case InitFailed:
+          case Error:
+            /* cannot exit immediately as the cleanup is required */
+            err = hproc[i].error;
+        }
+        events[i] = hproc[i].done_event;
       }
-      enter_blocking_section();
-      if (select(FD_SETSIZE, &read, &write, &except, tvp) == -1)
-        err = WSAGetLastError();
-      leave_blocking_section();
+      n = i;
+      if (err == 0){
+        enter_blocking_section();
+        if (WaitForMultipleObjects(n, events, FALSE, tm) == WAIT_FAILED)
+          err = GetLastError();
+        leave_blocking_section();
+      }
+      /* cleanup/convert results */
+      l = Val_unit;
+      Begin_roots1 (l);
+        for (l = readfds, i = 0; i < n; l = Field(l, 1), ++i) {
+          done_handle_proc(&hproc[i]);
+          switch(hproc[i].state){
+            case Error:
+              if (err == 0) err = hproc[i].error;
+              break;
+            case Read:
+              {
+                value rl = alloc_small(2, 0);
+                Field(rl, 0) = Field(l, 0);
+                Field(rl, 1) = read_list;
+                read_list = rl;
+                break;
+              }
+          }
+        }
+      End_roots();
       if (err) {
-	win32_maperr(err);
-	uerror("select", Nothing);
+        win32_maperr(err);
+        uerror("select", Nothing);
       }
-      read_list = fdset_to_fdlist(readfds, &read);
-      write_list = fdset_to_fdlist(writefds, &write);
-      except_list = fdset_to_fdlist(exceptfds, &except);
     }
     res = alloc_small(3, 0);
     Field(res, 0) = read_list;
Index: otherlibs/win32unix/Makefile.nt
===================================================================
--- otherlibs/win32unix/Makefile.nt	(revision 143)
+++ otherlibs/win32unix/Makefile.nt	(revision 146)
@@ -44,7 +44,7 @@
 DOBJS=$(ALL_FILES:.c=.$(DO))
 SOBJS=$(ALL_FILES:.c=.$(SO))
 
-LIBS=$(call SYSLIB,wsock32)
+LIBS=$(call SYSLIB,ws2_32)
 
 CAML_OBJS=unix.cmo unixLabels.cmo
 CAMLOPT_OBJS=$(CAML_OBJS:.cmo=.cmx)
Index: Makefile.nt
===================================================================
--- Makefile.nt	(revision 143)
+++ Makefile.nt	(revision 146)
@@ -114,7 +114,7 @@
 	@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.
@@ -229,6 +229,8 @@
 	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
@@ -564,6 +566,15 @@
 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
Index: config/Makefile.msvc
===================================================================
--- config/Makefile.msvc	(revision 143)
+++ config/Makefile.msvc	(revision 146)
@@ -66,7 +66,7 @@
 ASPPPROFFLAGS=
 PROFILING=noprof
 DYNLINKOPTS=
-DEBUGGER=
+DEBUGGER=ocamldebugger
 CC_PROFILE=
 SYSTHREAD_SUPPORT=true
 EXTRALIBS=