Continuation of PR2027 (tests passing for runtime 4 and 5)

ocaml/Makefile

@@ -1158,7 +1158,7 @@ clean::
 subdirs = \
   stdlib $(addprefix otherlibs/, \
     $(filter-out runtime_events, $(ALL_OTHERLIBS))) \
-  debugger ocamldoc ocamltest
+  debugger$(RUNTIME_SUFFIX) ocamldoc ocamltest
 
 .PHONY: alldepend
 alldepend: depend
@@ -1352,10 +1352,10 @@ clean::
 
 .PHONY: ocamldebugger
 ocamldebugger: ocamlc ocamlyacc ocamllex otherlibraries
-	$(MAKE) -C debugger all
+	$(MAKE) -C debugger$(RUNTIME_SUFFIX) all
 
 partialclean::
-	$(MAKE) -C debugger clean
+	$(MAKE) -C debugger$(RUNTIME_SUFFIX) clean
 
 # Check that the native-code compiler is supported
 .PHONY: checknative
@@ -1667,7 +1667,7 @@ depend: beforedepend
 
 .PHONY: distclean
 distclean: clean
-	$(MAKE) -C debugger distclean
+	$(MAKE) -C debugger$(RUNTIME_SUFFIX) distclean
 	$(MAKE) -C manual distclean
 	$(MAKE) -C ocamldoc distclean
 	$(MAKE) -C ocamltest distclean
@@ -1797,7 +1797,7 @@ ifeq "$(WITH_OCAMLDOC)-$(STDLIB_MANPAGES)" "ocamldoc-true"
 	$(MAKE) -C api_docgen install
 endif
 	if test -n "$(WITH_DEBUGGER)"; then \
-	  $(MAKE) -C debugger install; \
+	  $(MAKE) -C debugger$(RUNTIME_SUFFIX) install; \
 	fi
 ifeq "$(BOOTSTRAPPING_FLEXDLL)" "true"
 ifeq "$(TOOLCHAIN)" "msvc"

ocaml/Makefile.common-jst

@@ -122,9 +122,9 @@ $(ocamldir)/otherlibs/dune:
 
 $(ocamldir)/dune.runtime_selection:
 	if [ "$(RUNTIME_DIR)" = "runtime4" ]; then \
-          echo "(dirs (:standard \ runtime))" > $@; \
+          echo "(dirs (:standard \ runtime debugger))" > $@; \
 	else \
-          echo "(dirs (:standard \ runtime4))" > $@; \
+          echo "(dirs (:standard \ runtime4 debugger4))" > $@; \
 	fi
 
 _build/_bootinstall: Makefile.config $(dune_config_targets)
@@ -276,10 +276,10 @@ install_for_test: _install
 	mkdir -p _runtest/lib/ocaml/stublibs/
 	cp $(main_prefix)/lib/ocaml/stublibs/*.so _runtest/lib/ocaml/stublibs
 	# ocamldebug
-	mkdir _runtest/debugger
-	ln -s ../ocamldebug _runtest/debugger
-	cp $(main_build)/$(ocamldir)/debugger/.ocamldebug.objs/byte/*.cm* \
-	  _runtest/debugger
+	mkdir _runtest/debugger$(RUNTIME_SUFFIX)
+	ln -s ../ocamldebug _runtest/debugger$(RUNTIME_SUFFIX)
+	cp $(main_build)/$(ocamldir)/debugger$(RUNTIME_SUFFIX)/.ocamldebug.objs/byte/*.cm* \
+	  _runtest/debugger$(RUNTIME_SUFFIX)
 	# The ast_invariants test needs VERSION to be present.  In fact ideally
 	# we should have all the source files in _runtest too for this test,
 	# but for the moment we accept it being a weaker check.  We're not

ocaml/bytecomp/dll.ml

@@ -19,11 +19,13 @@ type dll_handle
 type dll_address
 type dll_mode = For_checking | For_execution
 
-(* BACKPORT BEGIN
-external dll_open: string -> dll_handle = "caml_dynlink_open_lib"
-*)
-external dll_open: dll_mode -> string -> dll_handle = "caml_dynlink_open_lib"
-(* BACKPORT END *)
+external dll_open5: string -> dll_handle = "caml_dynlink_open_lib"
+
+external dll_open4: dll_mode -> string -> dll_handle = "caml_dynlink_open_lib"
+
+let dll_open mode path =
+  if Config.runtime5 then dll_open5 path else dll_open4 mode path
+
 external dll_close: dll_handle -> unit = "caml_dynlink_close_lib"
 external dll_sym: dll_handle -> string -> dll_address
                 = "caml_dynlink_lookup_symbol"
@@ -85,11 +87,7 @@ let open_dll mode name =
           failwith (fullname ^ ": " ^ Binutils.error_to_string err)
       end
   | (None | Some (Checking _) as current), For_execution ->
-(* BACKPORT BEGIN
-      begin match dll_open fullname with
-*)
       begin match dll_open For_execution fullname with
-(* BACKPORT END *)
       | dll ->
           let opened = match current with
             | None -> List.remove_assoc fullname !opened_dlls

ocaml/debugger/.depend

@@ -182,7 +182,6 @@ eval.cmo : \
     ../typing/env.cmi \
     debugcom.cmi \
     ../typing/ctype.cmi \
-    ../utils/compilation_unit.cmi \
     ../typing/btype.cmi \
     eval.cmi
 eval.cmx : \
@@ -203,7 +202,6 @@ eval.cmx : \
     ../typing/env.cmx \
     debugcom.cmx \
     ../typing/ctype.cmx \
-    ../utils/compilation_unit.cmx \
     ../typing/btype.cmx \
     eval.cmi
 eval.cmi : \
@@ -286,12 +284,10 @@ loadprinter.cmo : \
     ../utils/misc.cmi \
     ../parsing/longident.cmi \
     ../utils/load_path.cmi \
-    ../typing/jkind.cmi \
     ../typing/ident.cmi \
     ../typing/env.cmi \
     ../otherlibs/dynlink/dynlink.cmi \
     ../typing/ctype.cmi \
-    ../utils/compilation_unit.cmi \
     loadprinter.cmi
 loadprinter.cmx : \
     ../typing/types.cmx \
@@ -303,12 +299,10 @@ loadprinter.cmx : \
     ../utils/misc.cmx \
     ../parsing/longident.cmx \
     ../utils/load_path.cmx \
-    ../typing/jkind.cmx \
     ../typing/ident.cmx \
     ../typing/env.cmx \
-    ../otherlibs/dynlink/dynlink.cmx \
+    ../otherlibs/dynlink/dynlink.cmi \
     ../typing/ctype.cmx \
-    ../utils/compilation_unit.cmx \
     loadprinter.cmi
 loadprinter.cmi : \
     ../parsing/longident.cmi \
@@ -407,7 +401,6 @@ printval.cmo : \
     ../toplevel/genprintval.cmi \
     ../typing/env.cmi \
     debugcom.cmi \
-    ../utils/compilation_unit.cmi \
     printval.cmi
 printval.cmx : \
     ../typing/types.cmx \
@@ -419,7 +412,6 @@ printval.cmx : \
     ../toplevel/genprintval.cmx \
     ../typing/env.cmx \
     debugcom.cmx \
-    ../utils/compilation_unit.cmx \
     printval.cmi
 printval.cmi : \
     ../typing/types.cmi \

ocaml/debugger/debugcom.ml

@@ -52,7 +52,6 @@ type pc =
 module Sp = struct
 
   (* Position in the debuggee's stack. *)
-(* BACKPORT BEGIN
   type t = {
     block : int;
     offset : int;
@@ -66,25 +65,14 @@ module Sp = struct
     match Stdlib.compare sp1.block sp2.block with
     | 0 -> Stdlib.compare sp1.offset sp2.offset
     | x -> x
-*)
-  type t = int
-
-  let null = 0
-  let base _ _ = assert false
-  let compare = Int.compare
-(* BACKPORT END *)
 
 end
 
 (* Identifier of the code fragment for the main program.
    Numbering starts at 1 and the runtime registers 2 fragments before
    the main program: one for uncaught exceptions and one for callbacks.
 *)
-(* BACKPOR BEGIN
 let main_frag = 3
-*)
-let main_frag = 0
-(* BACKPORT END *)
 
 let set_event {frag; pos} =
   output_char !conn.io_out 'e';
@@ -149,21 +137,13 @@ let do_go_smallint n =
          |  c  -> Misc.fatal_error (Printf.sprintf "Debugcom.do_go %c" c)
        in
        let event_counter = input_binary_int !conn.io_in in
-(* BACKPORT BEGIN
        let block = input_binary_int !conn.io_in in
        let offset = input_binary_int !conn.io_in in
-*)
-       let rep_stack_pointer = input_binary_int !conn.io_in in
-(* BACKPORT END *)
        let frag = input_binary_int !conn.io_in in
        let pos = input_binary_int !conn.io_in in
        { rep_type = summary;
          rep_event_count = Int64.of_int event_counter;
-(* BACKPORT BEGIN
          rep_stack_pointer = Sp.{block; offset};
-*)
-         rep_stack_pointer;
-(* BACKPORT END *)
          rep_program_pointer = {frag; pos} })
 
 let rec do_go n =
@@ -212,19 +192,11 @@ let wait_child chan =
 let initial_frame () =
   output_char !conn.io_out '0';
   flush !conn.io_out;
-(* BACKPORT BEGIN
   let block = input_binary_int !conn.io_in in
   let offset = input_binary_int !conn.io_in in
-*)
-  let stack_pos = input_binary_int !conn.io_in in
-(* BACKPORT END *)
   let frag = input_binary_int !conn.io_in in
   let pos = input_binary_int !conn.io_in in
-(* BACKPORT BEGIN
   (Sp.{block; offset}, {frag; pos})
-*)
-  (stack_pos, {frag; pos})
-(* BACKPOR END *)
 
 let set_initial_frame () =
   ignore(initial_frame ())
@@ -237,14 +209,9 @@ let up_frame stacksize =
   output_char !conn.io_out 'U';
   output_binary_int !conn.io_out stacksize;
   flush !conn.io_out;
-(* BACKPORT BEGIN
   let block = input_binary_int !conn.io_in in
   let offset = input_binary_int !conn.io_in in
-*)
-  let stack_pos = input_binary_int !conn.io_in in
-(* BACKPORT END *)
   let frag, pos =
-(* BACKPORT BEGIN
     if block = -1 then
     begin
       assert (offset = -1);
@@ -254,56 +221,31 @@ let up_frame stacksize =
       let pos = input_binary_int !conn.io_in in
       frag, pos
     end
-*)
-    if stack_pos = -1
-    then 0, 0
-    else let frag = input_binary_int !conn.io_in in
-         let pos = input_binary_int !conn.io_in in
-         frag, pos
-(* BACKPORT END *)
   in
-(* BACKPORT BEGIN
   (Sp.{block; offset}, { frag; pos })
-*)
-  (stack_pos, { frag; pos })
-(* BACKPORT END *)
 
 (* Get and set the current frame position *)
 
 let get_frame () =
   output_char !conn.io_out 'f';
   flush !conn.io_out;
-  let stack_pos = input_binary_int !conn.io_in in
-(*
   let block = input_binary_int !conn.io_in in
   let offset = input_binary_int !conn.io_in in
-*)
   let frag = input_binary_int !conn.io_in in
   let pos = input_binary_int !conn.io_in in
-(*
   (Sp.{block; offset}, {frag; pos})
-*)
-  (stack_pos, {frag; pos})
 
 let set_frame stack_pos =
   output_char !conn.io_out 'S';
-(* BACKPORT BEGIN
   output_binary_int !conn.io_out stack_pos.Sp.block;
   output_binary_int !conn.io_out stack_pos.Sp.offset
-*)
-  output_binary_int !conn.io_out stack_pos
-(* BACKPORT END *)
 
 (* Set the trap barrier to given stack position. *)
 
 let set_trap_barrier pos =
   output_char !conn.io_out 'b';
-(* BACKPORT BEGIN
   output_binary_int !conn.io_out pos.Sp.block;
   output_binary_int !conn.io_out pos.Sp.offset
-*)
-  output_binary_int !conn.io_out pos
-(* BACKPORT END *)
 
 (* Handling of remote values *)
 

ocaml/debugger/debugcom.mli

@@ -17,11 +17,7 @@
 (* Low-level communication with the debuggee *)
 
 module Sp : sig
-(* BACKPORT BEGIN
   type t
-*)
-  type t = int
-(* BACKPORT END *)
   val null : t
   val base : t -> int -> t
   val compare : t -> t -> int

ocaml/debugger/eval.ml

@@ -39,7 +39,6 @@ exception Error of error
 
 let abstract_type =
   Btype.newgenty (Tconstr (Pident (Ident.create_local "<abstr>"), [], ref Mnil))
-
 let get_global_or_predef id =
   try
     Debugcom.Remote_value.global (Symtable.get_global_position id)

ocaml/debugger/frames.ml

@@ -53,11 +53,7 @@ let selected_event_is_before () =
 let rec move_up frame_count event =
   if frame_count <= 0 then event else begin
     let (sp, pc) = up_frame event.ev_ev.ev_stacksize in
-(* BACKPORT BEGIN
     if sp = Sp.null then raise Not_found;
-*)
-    if sp < Sp.null then raise Not_found;
-(* BACKPORT END *)
     move_up (frame_count - 1) (any_event_at_pc pc)
   end
 
@@ -117,11 +113,7 @@ let do_backtrace action =
       begin try
         while action (Some !event) do
           let (sp, pc) = up_frame !event.ev_ev.ev_stacksize in
-(* BACKPORT BEGIN
           if sp = Sp.null then raise Exit;
-*)
-          if sp < Sp.null then raise Exit;
-(* BACKPORT END *)
           event := any_event_at_pc pc
         done
       with Exit -> ()