PR#6270: remove need for -I directives to ocamldebug in common case

(patch by Josh Watzman)

Add absolute directory names to bytecode format for ocamldebug to use

The need for a long list of -I directives makes interactively using
ocamldebug a pain in the butt. Many folks have solved this with various
`find` invocations or even Python wrappers, but those lead to other
problems when it might include files you weren't expecting (or miss
things you were). But all of this is really annoying since the tooling
should be able to figure out itself, even heuristically, where your
source files are -- gdb gets this right, why can't we?

This patch implements one of the more important heuristics from gdb: you
typically debug on the same machine you built on, so looking for the
source files and built artifacts in the absolute paths where they were
during compilation is a good first try. We write out absolute paths into
a new structure at the beginning of the debug section and then
automatically append those directories into the load path.

This means mean that if you happen to be debugging on a machine
where the original source and build artifacts are *not* available in
their original absolute locations, things will work as before, using the
standard load path mechanism. You can also explicitly use -I to prepend
directories to the load path and override the defaults located by this
new mechanism.

I personally find this makes using ocamldebug much more pleasant :)

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

15 files changed, 50 insertions, 12 deletions

diff --git a/Changes b/Changes
index 1af2190cbd..684a892374 100644
--- a/Changes
+++ b/Changes
@@ -119,10 +119,12 @@ Features wishes:
 - PR#6071: Add a -noinit option to the toplevel (patch by David Sheets)
 - PR#6166: document -ocamldoc option of ocamlbuild
 - PR#6187: ocamlbuild: warn when using -plugin-tag(s) without myocamlbuild.ml
-	   (patch by Jacques-Pascal Deplaix)
+  (patch by Jacques-Pascal Deplaix)
 - PR#6246: allow wilcard _ as for-loop index
+- PR#6270: remove need for -I directives to ocamldebug in common case
+  (patch by Josh Watzman, review by Xavier Clerc and Alain Frisch)
 - ocamllex: user-definable refill action
-	    (patch by Frédéric Bour, review by Gabriel Scherer and Luc Maranget)
+  (patch by Frédéric Bour, review by Gabriel Scherer and Luc Maranget)
 - shorten syntax for functor signatures: "functor (M1:S1) (M2:S2) .. -> .."
   (patches by Thomas Gazagnaire and Jeremy Yallop, review by Gabriel Scherer)
 
diff --git a/boot/ocamlc b/boot/ocamlc
index 60a2ecb429..f118c0c0bf 100755
--- a/boot/ocamlc
+++ b/boot/ocamlc
diff --git a/boot/ocamldep b/boot/ocamldep
index f2e26672a4..e0948caf06 100755
--- a/boot/ocamldep
+++ b/boot/ocamldep
diff --git a/boot/ocamllex b/boot/ocamllex
index 51eadf10ce..06909bd659 100755
--- a/boot/ocamllex
+++ b/boot/ocamllex
diff --git a/bytecomp/bytepackager.ml b/bytecomp/bytepackager.ml
index 9c9c1b842f..23582c1cb2 100644
--- a/bytecomp/bytepackager.ml
+++ b/bytecomp/bytepackager.ml
@@ -17,6 +17,8 @@ open Misc
 open Instruct
 open Cmo_format
 
+module StringSet = Set.Make(String)
+
 type error =
     Forward_reference of string * Ident.t
   | Multiple_definition of string * Ident.t
@@ -30,6 +32,7 @@ exception Error of error
 
 let relocs = ref ([] : (reloc_info * int) list)
 let events = ref ([] : debug_event list)
+let debug_dirs = ref StringSet.empty
 let primitives = ref ([] : string list)
 let force_link = ref false
 
@@ -137,6 +140,10 @@ let rename_append_bytecode ppf packagename oc mapping defined ofs prefix subst
     if !Clflags.debug && compunit.cu_debug > 0 then begin
       seek_in ic compunit.cu_debug;
       List.iter (relocate_debug ofs prefix subst) (input_value ic);
+      debug_dirs := List.fold_left
+        (fun s e -> StringSet.add e s)
+        !debug_dirs
+        (input_value ic);
     end;
     close_in ic;
     compunit.cu_codesize
@@ -215,6 +222,7 @@ let package_object_files ppf files targetfile targetname coercion =
     let pos_debug = pos_out oc in
     if !Clflags.debug && !events <> [] then
       output_value oc (List.rev !events);
+      output_value oc (StringSet.elements !debug_dirs);
     let pos_final = pos_out oc in
     let imports =
       List.filter
diff --git a/bytecomp/emitcode.ml b/bytecomp/emitcode.ml
index 9911de8828..a56bf9175b 100644
--- a/bytecomp/emitcode.ml
+++ b/bytecomp/emitcode.ml
@@ -20,6 +20,8 @@ open Instruct
 open Opcodes
 open Cmo_format
 
+module StringSet = Set.Make(String)
+
 (* Buffering of bytecode *)
 
 let out_buffer = ref(LongString.create 1024)
@@ -135,8 +137,12 @@ and slot_for_c_prim name =
 (* Debugging events *)
 
 let events = ref ([] : debug_event list)
+let debug_dirs = ref StringSet.empty
 
 let record_event ev =
+  let path = ev.ev_loc.Location.loc_start.Lexing.pos_fname in
+  let abspath = Location.absolute_path path in
+  debug_dirs := StringSet.add (Filename.dirname abspath) !debug_dirs;
   ev.ev_pos <- !out_position;
   events := ev :: !events
 
@@ -146,6 +152,7 @@ let init () =
   out_position := 0;
   label_table := Array.create 16 (Label_undefined []);
   reloc_info := [];
+  debug_dirs := StringSet.empty;
   events := []
 
 (* Emission of one instruction *)
@@ -365,6 +372,7 @@ let to_file outchan unit_name code =
     if !Clflags.debug then begin
       let p = pos_out outchan in
       output_value outchan !events;
+      output_value outchan (StringSet.elements !debug_dirs);
       (p, pos_out outchan - p)
     end else
       (0, 0) in
diff --git a/byterun/backtrace.c b/byterun/backtrace.c
index 1d4fb1e07e..d39e395290 100644
--- a/byterun/backtrace.c
+++ b/byterun/backtrace.c
@@ -229,6 +229,7 @@ static value read_debug_info(void)
   for (i = 0; i < num_events; i++) {
     orig = caml_getword(chan);
     evl = caml_input_val(chan);
+    caml_input_val(chan); // Skip the list of absolute directory names
     /* Relocate events in event list */
     for (l = evl; l != Val_int(0); l = Field(l, 1)) {
       value ev = Field(l, 0);
diff --git a/byterun/exec.h b/byterun/exec.h
index 27f291ec59..a58bcf8b39 100644
--- a/byterun/exec.h
+++ b/byterun/exec.h
@@ -54,7 +54,7 @@ struct exec_trailer {
 
 /* Magic number for this release */
 
-#define EXEC_MAGIC "Caml1999X010"
+#define EXEC_MAGIC "Caml1999X011"
 
 
 #endif /* CAML_EXEC_H */
diff --git a/debugger/program_management.ml b/debugger/program_management.ml
index c7438b3981..1e29b138f8 100644
--- a/debugger/program_management.ml
+++ b/debugger/program_management.ml
@@ -124,6 +124,8 @@ let initialize_loading () =
     raise Toplevel;
   end;
   Symbols.read_symbols !program_name;
+  Config.load_path := !Config.load_path @ !Symbols.program_source_dirs;
+  Envaux.reset_cache ();
   if !debug_loading then
     prerr_endline "Opening a socket...";
   open_connection !socket_name
diff --git a/debugger/symbols.ml b/debugger/symbols.ml
index 331d5bbdbe..1be7253328 100644
--- a/debugger/symbols.ml
+++ b/debugger/symbols.ml
@@ -17,9 +17,14 @@ open Instruct
 open Debugger_config (* Toplevel *)
 open Program_loading
 
+module StringSet = Set.Make(String)
+
 let modules =
   ref ([] : string list)
 
+let program_source_dirs =
+  ref ([] : string list)
+
 let events =
   ref ([] : debug_event list)
 let events_by_pc =
@@ -52,13 +57,16 @@ let read_symbols' bytecode_file =
     raise Toplevel
   end;
   let num_eventlists = input_binary_int ic in
+  let dirs = ref StringSet.empty in
   let eventlists = ref [] in
   for i = 1 to num_eventlists do
     let orig = input_binary_int ic in
     let evl = (input_value ic : debug_event list) in
     (* Relocate events in event list *)
     List.iter (relocate_event orig) evl;
-    eventlists := evl :: !eventlists
+    eventlists := evl :: !eventlists;
+    dirs :=
+      List.fold_left (fun s e -> StringSet.add e s) !dirs (input_value ic)
   done;
   begin try
     ignore (Bytesections.seek_section ic "CODE")
@@ -68,12 +76,13 @@ let read_symbols' bytecode_file =
     set_launching_function (List.assoc "manual" loading_modes)
   end;
   close_in_noerr ic;
-  !eventlists
+  !eventlists, !dirs
 
 let read_symbols bytecode_file =
-  let all_events = read_symbols' bytecode_file in
+  let all_events, all_dirs = read_symbols' bytecode_file in
 
   modules := []; events := [];
+  program_source_dirs := StringSet.elements all_dirs;
   Hashtbl.clear events_by_pc; Hashtbl.clear events_by_module;
   Hashtbl.clear all_events_by_module;
 
diff --git a/debugger/symbols.mli b/debugger/symbols.mli
index 980892e048..883b81aa3e 100644
--- a/debugger/symbols.mli
+++ b/debugger/symbols.mli
@@ -14,6 +14,10 @@
 (* Modules used by the program. *)
 val modules : string list ref
 
+(* Absolute directories containing source code on machine where source was
+ * compiled *)
+val program_source_dirs : string list ref
+
 (* Read debugging info from executable file *)
 val read_symbols : string -> unit
 
diff --git a/parsing/location.mli b/parsing/location.mli
index e6df9d1f6c..ffa2166c3e 100644
--- a/parsing/location.mli
+++ b/parsing/location.mli
@@ -69,6 +69,8 @@ val mkloc : 'a -> t -> 'a loc
 val print: formatter -> t -> unit
 val print_filename: formatter -> string -> unit
 
+val absolute_path: string -> string
+
 val show_filename: string -> string
     (** In -absname mode, return the absolute path for this filename.
         Otherwise, returns the filename unchanged. *)
diff --git a/tools/dumpobj.ml b/tools/dumpobj.ml
index db8494cc26..f1255e9cd2 100644
--- a/tools/dumpobj.ml
+++ b/tools/dumpobj.ml
@@ -493,6 +493,7 @@ let dump_obj filename ic =
   if cu.cu_debug > 0 then begin
     seek_in ic cu.cu_debug;
     let evl = (input_value ic : debug_event list) in
+    ignore (input_value ic); (* Skip the list of absolute directory names *)
     record_events 0 evl
   end;
   seek_in ic cu.cu_pos;
@@ -531,6 +532,7 @@ let dump_exe ic =
     for _i = 1 to num_eventlists do
       let orig = input_binary_int ic in
       let evl = (input_value ic : debug_event list) in
+      ignore (input_value ic); (* Skip the list of absolute directory names *)
       record_events orig evl
     done
   with Not_found -> ()
diff --git a/utils/config.mlbuild b/utils/config.mlbuild
index 524558b163..c887ac2b4e 100644
--- a/utils/config.mlbuild
+++ b/utils/config.mlbuild
@@ -60,10 +60,10 @@ let mkdll = C.mkdll
 let mkexe = C.mkexe
 let mkmaindll = C.mkmaindll
 
-let exec_magic_number = "Caml1999X010"
+let exec_magic_number = "Caml1999X011"
 and cmi_magic_number = "Caml1999I016"
-and cmo_magic_number = "Caml1999O008"
-and cma_magic_number = "Caml1999A009"
+and cmo_magic_number = "Caml1999O009"
+and cma_magic_number = "Caml1999A010"
 and cmx_magic_number = "Caml1999Y011"
 and cmxa_magic_number = "Caml1999Z010"
 and ast_impl_magic_number = "Caml1999M016"
diff --git a/utils/config.mlp b/utils/config.mlp
index e16ef29988..c83071da14 100644
--- a/utils/config.mlp
+++ b/utils/config.mlp
@@ -48,10 +48,10 @@ let mkdll = "%%MKDLL%%"
 let mkexe = "%%MKEXE%%"
 let mkmaindll = "%%MKMAINDLL%%"
 
-let exec_magic_number = "Caml1999X010"
+let exec_magic_number = "Caml1999X011"
 and cmi_magic_number = "Caml1999I016"
-and cmo_magic_number = "Caml1999O008"
-and cma_magic_number = "Caml1999A009"
+and cmo_magic_number = "Caml1999O009"
+and cma_magic_number = "Caml1999A010"
 and cmx_magic_number = "Caml1999Y012"
 and cmxa_magic_number = "Caml1999Z011"
 and ast_impl_magic_number = "Caml1999M016"