ocamldebug under Win32 (S. Le Gall, Lexifi)

git-svn-id: http://caml.inria.fr/svn/ocaml/trunk@8955 f963ae5c-01c2-4b8c-9fe0-0dff7051ff02

11 files changed, 217 insertions, 118 deletions

diff --git a/debugger/Makefile b/debugger/Makefile
index a1faabd1ff..3ff1b54aa4 100644
--- a/debugger/Makefile
+++ b/debugger/Makefile
@@ -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
diff --git a/debugger/Makefile.nt b/debugger/Makefile.nt
new file mode 100644
index 0000000000..3630d32e0e
--- /dev/null
+++ b/debugger/Makefile.nt
@@ -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
+
diff --git a/debugger/Makefile.shared b/debugger/Makefile.shared
new file mode 100644
index 0000000000..4ed986a544
--- /dev/null
+++ b/debugger/Makefile.shared
@@ -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
diff --git a/debugger/command_line.ml b/debugger/command_line.ml
index cfbdee303f..f37d529b34 100644
--- a/debugger/command_line.ml
+++ b/debugger/command_line.ml
@@ -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
diff --git a/debugger/debugcom.ml b/debugger/debugcom.ml
index edec454727..307f4258de 100644
--- a/debugger/debugcom.ml
+++ b/debugger/debugcom.ml
@@ -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 =
diff --git a/debugger/debugger_config.ml b/debugger/debugger_config.ml
index fa6fd7018f..13e3f086c0 100644
--- a/debugger/debugger_config.ml
+++ b/debugger/debugger_config.ml
@@ -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)
diff --git a/debugger/exec.ml b/debugger/exec.ml
index d97a8c4e7d..1ea165978f 100644
--- a/debugger/exec.ml
+++ b/debugger/exec.ml
@@ -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
diff --git a/debugger/main.ml b/debugger/main.ml
index 4920d0d79b..fda242bc52 100644
--- a/debugger/main.ml
+++ b/debugger/main.ml
@@ -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
diff --git a/debugger/program_loading.ml b/debugger/program_loading.ml
index e1507e5d9f..1a750a2bbc 100644
--- a/debugger/program_loading.ml
+++ b/debugger/program_loading.ml
@@ -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)
diff --git a/debugger/program_management.ml b/debugger/program_management.ml
index d38adc7137..35f74d6543 100644
--- a/debugger/program_management.ml
+++ b/debugger/program_management.ml
@@ -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);
diff --git a/debugger/unix_tools.ml b/debugger/unix_tools.ml
index 5061bb1ddf..5328a2aadb 100644
--- a/debugger/unix_tools.ml
+++ b/debugger/unix_tools.ml
@@ -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