Ocaml debugger under Windows

Ocaml debugger under Windows

[Dmitry Bely]

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

The topic has a long history [1], but since then nothing has actually
changed. It's easy to understand: INRIA people are busy and there are
probably quite few Ocaml users in the Windows land to worry about. So I
decided to do something myself :) (as it was with mingw port several years
ago).

Let's go into detail. Ocam debugger consists of the the two parts: the
client (byterun/debugger.c linked into debuggee) and the server
(ocamldebug). The following issues should be addressed to make a Windows
port:

1. Checkpointing is done via Unix fork() (client)

The most problematic one. I have spend a fair amount of time trying to find
an acceptable solution.
a) direct port of fork() to Windows. There is a BSD-licenced Windows fork()
in tcsh sources [2] that could be used. It's based on Cygwin ideas. But how
to handle dynamically loaded DLLs (loaded via LoadLibrary())? I asked the
author (Amol Deshpande) and he replied:

"DLLs that are dynamically loaded are a can of worms. I would not support
those if I were you."

BTW, does Cygwin do this right? I doubt at least.

b) some checkpoint library. Although Web search gives many references, e.g.
[3], I have not found yet anything ready-to-use, even commercial!

2. Unix select (server)

It is a problem because server waits for network and console events
simultaneously. To work on Windows the main loop should probably be
multi-threaded.

3. Unix sockets (client & server)

Probably can be ignored. Internet sockets are quite enough.

So what is done now.

- Client

It's ported without (1) and (3). To me it's quite usable even without
checkpoints.

- Server

I don't bother to do (2) right now (until the whole idea is accepted).
Currently I use cygwin-compiled ocamldebug with checkpoints and Unix sockets
disabled by default. It works well with the native Win32 clients.

- OcaIDE

Yes, with minor changes in OcaIDE the debugged works there.

If it's interesting for anyone I can publish a patch against Ocaml 3.10.1

- Dmitry Bely

[1]
http://caml.inria.fr/pub/ml-archives/caml-list/1999/03/f44178e212e78826bcbdee52ddf6fd91.en.html
http://caml.inria.fr/pub/ml-archives/caml-list/2002/10/ed776d7376ed7a9676d4a9981372ccdf.fr.html

[2] http://www.tcsh.org/MostRecentRelease

[3]
http://www.usenix.org/publications/library/proceedings/usenix-nt98/full_papers/srouji/srouji_html/srouji.html

[-- Attachment #2: Type: text/html, Size: 2950 bytes --]

Re: [Caml-list] Ocaml debugger under Windows

[Alain Frisch]

Dmitry Bely wrote:
> The topic has a long history [1], but since then nothing has actually 
> changed. It's easy to understand: INRIA people are busy and there are 
> probably quite few Ocaml users in the Windows land to worry about. So I 
> decided to do something myself :) (as it was with mingw port several 
> years ago).
 >...
> If it's interesting for anyone I can publish a patch against Ocaml 3.10.1

Yes, that's definitely interesting for us!

Is there any hope to build the server with the mingw or msvc port?

-- Alain

Re: [Caml-list] Ocaml debugger under Windows

[Dmitry Bely]

On Feb 5, 2008 12:54 PM, Alain Frisch <alain@frisch.fr> wrote:
> Dmitry Bely wrote:
> > The topic has a long history [1], but since then nothing has actually
> > changed. It's easy to understand: INRIA people are busy and there are
> > probably quite few Ocaml users in the Windows land to worry about. So I
> > decided to do something myself :) (as it was with mingw port several
> > years ago).
>  >...
> > If it's interesting for anyone I can publish a patch against Ocaml 3.10.1
>
> Yes, that's definitely interesting for us!
>
> Is there any hope to build the server with the mingw or msvc port?

As soon as the following function is rewritten:

debugger/input_handling.ml

(* Handle active files until `continue_main_loop' is false. *)
let main_loop () =
  let old_state = !continue_main_loop in
    try
      continue_main_loop := true;
      while !continue_main_loop do
        try
          let (input, _, _) =
            select (List.map fst !active_files) [] [] (-1.)
          in
            List.iter
              (function fd ->
                 let (funct, iochan) = (List.assoc fd !active_files) in
                   funct iochan)
              input
        with
          Unix_error (EINTR, _, _) -> ()
      done;
      continue_main_loop := old_state
    with
      x ->
        continue_main_loop := old_state;
        raise x

here Unix.select() waits for both network and user input events. We
could split this into 2 threads, but how to interrupt network select()
when we going to exit? Well, we could use some small timeout value for
select() (say 500ms) and restart it the loop when !continue_main_loop
is set, but this looks not very elegant... Or it's OK?

The point is not to modify win32unix library or write Win32-specific C
functions for ocamldebug. I believe it's necessary to be ever accepted
by INRIA.


- Dmitry Bely

Re: [Caml-list] Ocaml debugger under Windows

[Benedikt Grundmann]

Use Shawn Wagner's MsgQueue module to communicate between both threads
in a select friendly way.

http://raevnos.pennmush.org/code/ethread/doc/MsgQueue.html

Cheers,

Bene

2008/2/5, Dmitry Bely <dmitry.bely@gmail.com>:
> On Feb 5, 2008 12:54 PM, Alain Frisch <alain@frisch.fr> wrote:
> > Dmitry Bely wrote:
> > > The topic has a long history [1], but since then nothing has actually
> > > changed. It's easy to understand: INRIA people are busy and there are
> > > probably quite few Ocaml users in the Windows land to worry about. So I
> > > decided to do something myself :) (as it was with mingw port several
> > > years ago).
> >  >...
> > > If it's interesting for anyone I can publish a patch against Ocaml 3.10.1
> >
> > Yes, that's definitely interesting for us!
> >
> > Is there any hope to build the server with the mingw or msvc port?
>
> As soon as the following function is rewritten:
>
> debugger/input_handling.ml
>
> (* Handle active files until `continue_main_loop' is false. *)
> let main_loop () =
>   let old_state = !continue_main_loop in
>     try
>       continue_main_loop := true;
>       while !continue_main_loop do
>         try
>           let (input, _, _) =
>             select (List.map fst !active_files) [] [] (-1.)
>           in
>             List.iter
>               (function fd ->
>                  let (funct, iochan) = (List.assoc fd !active_files) in
>                    funct iochan)
>               input
>         with
>           Unix_error (EINTR, _, _) -> ()
>       done;
>       continue_main_loop := old_state
>     with
>       x ->
>         continue_main_loop := old_state;
>         raise x
>
> here Unix.select() waits for both network and user input events. We
> could split this into 2 threads, but how to interrupt network select()
> when we going to exit? Well, we could use some small timeout value for
> select() (say 500ms) and restart it the loop when !continue_main_loop
> is set, but this looks not very elegant... Or it's OK?
>
> The point is not to modify win32unix library or write Win32-specific C
> functions for ocamldebug. I believe it's necessary to be ever accepted
> by INRIA.
>
>
> - Dmitry Bely
>
> _______________________________________________
> Caml-list mailing list. Subscription management:
> http://yquem.inria.fr/cgi-bin/mailman/listinfo/caml-list
> Archives: http://caml.inria.fr
> Beginner's list: http://groups.yahoo.com/group/ocaml_beginners
> Bug reports: http://caml.inria.fr/bin/caml-bugs
>


-- 
Calvin: I try to make everyone's day a little more
surreal.

(From Calvin & Hobbes)

Re: [Caml-list] Ocaml debugger under Windows

[Dmitry Bely]

On Feb 5, 2008 8:40 PM, Benedikt Grundmann <benedikt@cardexpert.net> wrote:
> Use Shawn Wagner's MsgQueue module to communicate between both threads
> in a select friendly way.
>
> http://raevnos.pennmush.org/code/ethread/doc/MsgQueue.html

I don't think it would work on Windows. You cannot select() on
arbitrary Unix.file_descr - only socket-associated descriptor can be
used.

- Dmitry Bely

Re: [Caml-list] Ocaml debugger under Windows

[Alain Frisch]

Dmitry Bely wrote:
> I don't think it would work on Windows. You cannot select() on
> arbitrary Unix.file_descr - only socket-associated descriptor can be
> used.

Do you know how Cygwin emulate the desired behavior?  Does it use threads?

-- Alain

Re: [Caml-list] Ocaml debugger under Windows

[Dmitry Bely]

On Feb 6, 2008 12:00 AM, Alain Frisch <alain@frisch.fr> wrote:
> > I don't think it would work on Windows. You cannot select() on
> > arbitrary Unix.file_descr - only socket-associated descriptor can be
> > used.
>
> Do you know how Cygwin emulate the desired behavior?  Does it use threads?

It surely use WaitForMultipleObjects() instead of select(). The
implementation is quite complicated; GDB's one seems to be better
showing an idea (see below).

But frankly speaking I don't like to add any C code here - in fact it
means altering win32unix library that is unlikely to happen. Can it be
solved on Caml level? Anyone? Is select() with small timeout is
acceptable?

/* Wrapper for select.  On Windows systems, where the select interface
   only works for sockets, this uses the GDB serial abstraction to
   handle sockets, consoles, pipes, and serial ports.

   The arguments to this function are the same as the traditional
   arguments to select on POSIX platforms.  */

int
gdb_select (int n, fd_set *readfds, fd_set *writefds, fd_set *exceptfds,
	    struct timeval *timeout)
{
  static HANDLE never_handle;
  HANDLE handles[MAXIMUM_WAIT_OBJECTS];
  HANDLE h;
  DWORD event;
  DWORD num_handles;
  int fd;
  int num_ready;
  int indx;

  num_ready = 0;
  num_handles = 0;
  for (fd = 0; fd < n; ++fd)
    {
      HANDLE read = NULL, except = NULL;
      struct serial *scb;

      /* There is no support yet for WRITEFDS.  At present, this isn't
	 used by GDB -- but we do not want to silently ignore WRITEFDS
	 if something starts using it.  */
      gdb_assert (!writefds || !FD_ISSET (fd, writefds));

      if ((!readfds || !FD_ISSET (fd, readfds))
	  && (!exceptfds || !FD_ISSET (fd, exceptfds)))
	continue;
      h = (HANDLE) _get_osfhandle (fd);

      scb = serial_for_fd (fd);
      if (scb)
	serial_wait_handle (scb, &read, &except);

      if (read == NULL)
	read = h;
      if (except == NULL)
	{
	  if (!never_handle)
	    never_handle = CreateEvent (0, FALSE, FALSE, 0);

	  except = never_handle;
	}

      if (readfds && FD_ISSET (fd, readfds))
	{
	  gdb_assert (num_handles < MAXIMUM_WAIT_OBJECTS);
	  handles[num_handles++] = read;
	}

      if (exceptfds && FD_ISSET (fd, exceptfds))
	{
	  gdb_assert (num_handles < MAXIMUM_WAIT_OBJECTS);
	  handles[num_handles++] = except;
	}
    }
  /* If we don't need to wait for any handles, we are done.  */
  if (!num_handles)
    {
      if (timeout)
	Sleep (timeout->tv_sec * 1000 + timeout->tv_usec / 1000);

      return 0;
    }

  event = WaitForMultipleObjects (num_handles,
				  handles,
				  FALSE,
				  timeout
				  ? (timeout->tv_sec * 1000
				     + timeout->tv_usec / 1000)
				  : INFINITE);
  /* EVENT can only be a value in the WAIT_ABANDONED_0 range if the
     HANDLES included an abandoned mutex.  Since GDB doesn't use
     mutexes, that should never occur.  */
  gdb_assert (!(WAIT_ABANDONED_0 <= event
		&& event < WAIT_ABANDONED_0 + num_handles));
  if (event == WAIT_FAILED)
    return -1;
  if (event == WAIT_TIMEOUT)
    return 0;
  /* Run through the READFDS, clearing bits corresponding to descriptors
     for which input is unavailable.  */
  h = handles[event - WAIT_OBJECT_0];
  for (fd = 0, indx = 0; fd < n; ++fd)
    {
      HANDLE fd_h;
      struct serial *scb;

      if ((!readfds || !FD_ISSET (fd, readfds))
	  && (!exceptfds || !FD_ISSET (fd, exceptfds)))
	continue;

      if (readfds && FD_ISSET (fd, readfds))
	{
	  fd_h = handles[indx++];
	  /* This handle might be ready, even though it wasn't the handle
	     returned by WaitForMultipleObjects.  */
	  if (fd_h != h && WaitForSingleObject (fd_h, 0) != WAIT_OBJECT_0)
	    FD_CLR (fd, readfds);
	  else
	    num_ready++;
	}

      if (exceptfds && FD_ISSET (fd, exceptfds))
	{
	  fd_h = handles[indx++];
	  /* This handle might be ready, even though it wasn't the handle
	     returned by WaitForMultipleObjects.  */
	  if (fd_h != h && WaitForSingleObject (fd_h, 0) != WAIT_OBJECT_0)
	    FD_CLR (fd, exceptfds);
	  else
	    num_ready++;
	}

      /* We created at least one event handle for this fd.  Let the
	 device know we are finished with it.  */
      scb = serial_for_fd (fd);
      if (scb)
	serial_done_wait_handle (scb);
    }

  return num_ready;
}

- Dmitry Bely

Re: [Caml-list] Ocaml debugger under Windows

[Xavier Leroy]

Hello Dmitry,

I'm delighted to see your attempts at getting ocamldebug to work under
Windows.

Generally speaking, the Windows port is the part of OCaml where we
most desperately need outside help, as (1) it consumes quite a bit of
my very limited time, (2) it's a cost center for the Caml development
team (none of us uses Windows for our research activities), and (3)
none of us is competent with Win32 programming.

(For example, if anyone could help debugging PR#4399, that would be
much appreciated.)

Coming back to ocamldebug:

> The point is not to modify win32unix library or write Win32-specific C
> functions for ocamldebug. I believe it's necessary to be ever accepted
> by INRIA.

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.

- Xavier Leroy

Re: [Caml-list] Ocaml debugger under Windows

[Dmitry Bely]

On Feb 6, 2008 8:12 PM, Xavier Leroy <Xavier.Leroy@inria.fr> wrote:
> Hello Dmitry,
>
> I'm delighted to see your attempts at getting ocamldebug to work under
> Windows.
>
> Generally speaking, the Windows port is the part of OCaml where we
> most desperately need outside help, as (1) it consumes quite a bit of
> my very limited time, (2) it's a cost center for the Caml development
> team (none of us uses Windows for our research activities), and (3)
> none of us is competent with Win32 programming.
>
> (For example, if anyone could help debugging PR#4399, that would be
> much appreciated.)

Alas, I have not migrated to Vista yet. But once the reporter has
Visual C++ experience I would recommend him to build OCaml from
sources with debug info enabled (if won't compile out-of-the-box but
the fix is trivial) and launch ocamlwin under debugger. When it should
become obvious where the access violation occurs.

> Coming back to ocamldebug:
>
> > The point is not to modify win32unix library or write Win32-specific C
> > functions for ocamldebug. I believe it's necessary to be ever accepted
> > by INRIA.
>
> 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.

Indeed, porting select() to Windows would be preferable.
WaitForMultipleObjects() can wait for console, pipe and network events
simultaneously so this should not be that hard (and multiple threads
are probably not necessary). Of course, there are some pitfalls like
this (taken from Cygwin sources):

      /* Some types of object (e.g., consoles) wake up on "inappropriate" events
         like mouse movements.  The verify function will detect these
situations.
         If it returns false, then this wakeup was a false alarm and
we should go
         back to waiting. */

But at least I'll try.

- Dmitry Bely

Re: [Caml-list] Ocaml debugger under Windows

[Dmitry Bely]

[-- 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=

Re: [Caml-list] Ocaml debugger under Windows

[Kuba Ober]

On Tuesday 05 February 2008, Dmitry Bely wrote:
> On Feb 5, 2008 12:54 PM, Alain Frisch <alain@frisch.fr> wrote:
> > Dmitry Bely wrote:
> > > The topic has a long history [1], but since then nothing has actually
> > > changed. It's easy to understand: INRIA people are busy and there are
> > > probably quite few Ocaml users in the Windows land to worry about. So I
> > > decided to do something myself :) (as it was with mingw port several
> > > years ago).
> > >
> >  >...
> > >
> > > If it's interesting for anyone I can publish a patch against Ocaml
> > > 3.10.1
> >
> > Yes, that's definitely interesting for us!
> >
> > Is there any hope to build the server with the mingw or msvc port?
>
> As soon as the following function is rewritten:
>
> debugger/input_handling.ml
>
> (* Handle active files until `continue_main_loop' is false. *)
> let main_loop () =
>   let old_state = !continue_main_loop in
>     try
>       continue_main_loop := true;
>       while !continue_main_loop do
>         try
>           let (input, _, _) =
>             select (List.map fst !active_files) [] [] (-1.)
>           in
>             List.iter
>               (function fd ->
>                  let (funct, iochan) = (List.assoc fd !active_files) in
>                    funct iochan)
>               input
>         with
>           Unix_error (EINTR, _, _) -> ()
>       done;
>       continue_main_loop := old_state
>     with
>       x ->
>         continue_main_loop := old_state;
>         raise x
>
> here Unix.select() waits for both network and user input events.

There's a windows API function for that. As long as the newtork access can be 
wrapped in the usual aysnchronous I/O primitives, there's a wait function 
that will wait on an async conditition *or* a message.

Cheers, Kuba

Re: [Caml-list] Ocaml debugger under Windows

[Dmitry Bely]

On Feb 8, 2008 4:27 PM, Kuba Ober <ober.14@osu.edu> wrote:
[...]
> > here Unix.select() waits for both network and user input events.
>
> There's a windows API function for that. As long as the newtork access can be
> wrapped in the usual aysnchronous I/O primitives, there's a wait function
> that will wait on an async conditition *or* a message.

Did you ever read the discussion?

- Dmitry Bely