Add -dcamlprimc + pass -fdebug-prefix-map when available (#1845)

- Introduce `-dcamlprimc`, to keep the generated C file containing the primitive list
- Use `-fdebug-prefix-map` for compiling temporary C files when this option is supported

Changes

@@ -76,6 +76,11 @@ Working version
 - GPR#1822: keep attributes attached to pattern variables from being discarded.
   (Nicolás Ojeda Bär, review by Thomas Refis)
 
+- GPR#1845: new `-dcamlprimc` option to keep the generated C file containing
+  the information about primitives; pass `-fdebug-prefix-map` to the C compiler
+  when supported
+  (Xavier Clerc, review by Jérémie Dimino)
+
 ### Code generation and optimizations:
 
 - MPR#7725, GPR#1754: improve AFL instrumentation for objects and lazy values.

Makefile

@@ -352,6 +352,7 @@ utils/config.ml: utils/config.mlp config/Makefile Makefile
 	    $(call SUBST,WITH_SPACETIME) \
 	    $(call SUBST,ENABLE_CALL_COUNTS) \
 	    $(call SUBST,FLAT_FLOAT_ARRAY) \
+	    $(call SUBST,CC_HAS_DEBUG_PREFIX_MAP) \
 	    $< > $@
 
 ifeq "$(UNIX_OR_WIN32)" "unix"

bytecomp/bytelink.ml

@@ -536,8 +536,13 @@ let link_bytecode_as_c ppf tolink outfile =
 
 let build_custom_runtime prim_name exec_name =
   let runtime_lib = "-lcamlrun" ^ !Clflags.runtime_variant in
+  let debug_prefix_map =
+    if Config.c_has_debug_prefix_map && not !Clflags.keep_camlprimc_file then
+      [Printf.sprintf "-fdebug-prefix-map=%s=camlprim.c" prim_name]
+    else
+      [] in
   Ccomp.call_linker Ccomp.Exe exec_name
-    ([prim_name] @ List.rev !Clflags.ccobjs @ [runtime_lib])
+    (debug_prefix_map @ [prim_name] @ List.rev !Clflags.ccobjs @ [runtime_lib])
     (Clflags.std_include_flag "-I" ^ " " ^ Config.bytecomp_c_libraries)
 
 let append_bytecode_and_cleanup bytecode_name exec_name prim_name =
@@ -547,7 +552,7 @@ let append_bytecode_and_cleanup bytecode_name exec_name prim_name =
   close_in ic;
   close_out oc;
   remove_file bytecode_name;
-  remove_file prim_name
+  if not !Clflags.keep_camlprimc_file then remove_file prim_name
 
 (* Fix the name of the output file, if the C compiler changes it behind
    our back. *)
@@ -582,10 +587,16 @@ let link ppf objfiles output_name =
     link_bytecode ppf tolink output_name true
   else if not !Clflags.output_c_object then begin
     let bytecode_name = Filename.temp_file "camlcode" "" in
-    let prim_name = Filename.temp_file "camlprim" ".c" in
+    let prim_name =
+      if !Clflags.keep_camlprimc_file then
+        output_name ^ ".camlprim.c"
+      else
+        Filename.temp_file "camlprim" ".c" in
     try
       link_bytecode ppf tolink bytecode_name false;
       let poc = open_out prim_name in
+      (* note: builds will not be reproducible if the C code contains macros
+         such as __FILE__. *)
       output_string poc "\
         #ifdef __cplusplus\n\
         extern \"C\" {\n\
@@ -608,24 +619,25 @@ let link ppf objfiles output_name =
       let exec_name = fix_exec_name output_name in
       if not (build_custom_runtime prim_name exec_name)
       then raise(Error Custom_runtime);
-      if !Clflags.make_runtime
-      then (remove_file bytecode_name; remove_file prim_name)
-      else append_bytecode_and_cleanup bytecode_name exec_name prim_name
+      if !Clflags.make_runtime then begin
+        remove_file bytecode_name;
+        if not !Clflags.keep_camlprimc_file then remove_file prim_name
+      end else append_bytecode_and_cleanup bytecode_name exec_name prim_name
     with x ->
       remove_file bytecode_name;
-      remove_file prim_name;
+      if not !Clflags.keep_camlprimc_file then remove_file prim_name;
       raise x
   end else begin
     let basename = Filename.chop_extension output_name in
     let temps = ref [] in
-    let c_file =
+    let c_file, stable_name =
       if !Clflags.output_complete_object
          && not (Filename.check_suffix output_name ".c")
-      then Filename.temp_file "camlobj" ".c"
+      then Filename.temp_file "camlobj" ".c", Some "camlobj.c"
       else begin
         let f = basename ^ ".c" in
         if Sys.file_exists f then raise(Error(File_exists f));
-        f
+        f, None
       end
     in
     let obj_file =
@@ -637,7 +649,7 @@ let link ppf objfiles output_name =
       link_bytecode_as_c ppf tolink c_file;
       if not (Filename.check_suffix output_name ".c") then begin
         temps := c_file :: !temps;
-        if Ccomp.compile_file ~output:obj_file c_file <> 0 then
+        if Ccomp.compile_file ~output:obj_file ?stable_name c_file <> 0 then
           raise(Error Custom_runtime);
         if not (Filename.check_suffix output_name Config.ext_obj) ||
            !Clflags.output_complete_object then begin

config/Makefile.mingw

@@ -107,6 +107,7 @@ DEFAULT_SAFE_STRING=true
 WINDOWS_UNICODE=1
 AFL_INSTRUMENT=false
 AWK=gawk
+CC_HAS_DEBUG_PREFIX_MAP=false
 
 ########## Configuration for the bytecode compiler
 

config/Makefile.mingw64

@@ -107,6 +107,7 @@ DEFAULT_SAFE_STRING=true
 WINDOWS_UNICODE=1
 AFL_INSTRUMENT=false
 AWK=gawk
+CC_HAS_DEBUG_PREFIX_MAP=false
 
 ########## Configuration for the bytecode compiler
 

config/Makefile.msvc

@@ -100,6 +100,7 @@ DEFAULT_SAFE_STRING=true
 WINDOWS_UNICODE=1
 AFL_INSTRUMENT=false
 AWK=gawk
+CC_HAS_DEBUG_PREFIX_MAP=false
 
 ########## Configuration for the bytecode compiler
 

config/Makefile.msvc64

@@ -99,6 +99,7 @@ DEFAULT_SAFE_STRING=true
 WINDOWS_UNICODE=1
 AFL_INSTRUMENT=false
 AWK=gawk
+CC_HAS_DEBUG_PREFIX_MAP=false
 
 ########## Configuration for the bytecode compiler
 

configure

@@ -1523,6 +1523,12 @@ if sh ./hasgot pwrite; then
   echo "#define HAS_PWRITE" >> s.h
 fi
 
+if sh ./trycompile -fdebug-prefix-map=old=new ansi.c; then
+    cc_has_debug_prefix_map=true
+else
+    cc_has_debug_prefix_map=false
+fi
+
 nanosecond_stat=none
 for i in 1 2 3; do
   if sh ./trycompile -DHAS_NANOSECOND_STAT=$i nanosecond_stat.c; then
@@ -2161,6 +2167,7 @@ config AFL_INSTRUMENT "$afl_instrument"
 config MAX_TESTSUITE_DIR_RETRIES "$max_testsuite_dir_retries"
 config FLAT_FLOAT_ARRAY "$flat_float_array"
 config AWK "awk"
+config CC_HAS_DEBUG_PREFIX_MAP "$cc_has_debug_prefix_map"
 
 
 rm -f tst hasgot.c

driver/main.ml

@@ -116,6 +116,7 @@ module Options = Main_args.Make_bytecomp_options (struct
   let _drawlambda = set dump_rawlambda
   let _dlambda = set dump_lambda
   let _dinstr = set dump_instr
+  let _dcamlprimc = set keep_camlprimc_file
   let _dtimings () = profile_columns := [ `Time ]
   let _dprofile () = profile_columns := Profile.all_columns
 

driver/main_args.ml

@@ -682,6 +682,10 @@ let mk_dinstr f =
   "-dinstr", Arg.Unit f, " (undocumented)"
 ;;
 
+let mk_dcamlprimc f =
+  "-dcamlprimc", Arg.Unit f, " (undocumented)"
+;;
+
 let mk_dcmm f =
   "-dcmm", Arg.Unit f, " (undocumented)"
 ;;
@@ -923,6 +927,7 @@ module type Bytecomp_options = sig
   val _use_runtime : string -> unit
 
   val _dinstr : unit -> unit
+  val _dcamlprimc : unit -> unit
 
   val _use_prims : string -> unit
 end;;
@@ -1123,6 +1128,7 @@ struct
     mk_drawlambda F._drawlambda;
     mk_dlambda F._dlambda;
     mk_dinstr F._dinstr;
+    mk_dcamlprimc F._dcamlprimc;
     mk_dtimings F._dtimings;
     mk_dprofile F._dprofile;
 

driver/main_args.mli

@@ -138,6 +138,7 @@ module type Bytecomp_options = sig
   val _use_runtime : string -> unit
 
   val _dinstr : unit -> unit
+  val _dcamlprimc : unit -> unit
 
   val _use_prims : string -> unit
 end;;

ocamldoc/odoc_args.ml

@@ -250,6 +250,7 @@ module Options = Main_args.Make_ocamldoc_options(struct
   let _dlambda = set Clflags.dump_lambda
   let _dflambda = set Clflags.dump_flambda
   let _dinstr = set Clflags.dump_instr
+  let _dcamlprimc = set Clflags.keep_camlprimc_file
   let anonymous = anonymous
 end)
 

testsuite/tools/expect_test.ml

@@ -410,6 +410,7 @@ module Options = Main_args.Make_bytetop_options (struct
   let _dtimings () = profile_columns := [ `Time ]
   let _dprofile () = profile_columns := Profile.all_columns
   let _dinstr = set dump_instr
+  let _dcamlprimc = set keep_camlprimc_file
 
   let _args = Arg.read_arg
   let _args0 = Arg.read_arg0

tools/ocamlcp.ml

@@ -132,6 +132,7 @@ module Options = Main_args.Make_bytecomp_options (struct
   let _dlambda = option "-dlambda"
   let _dflambda = option "-dflambda"
   let _dinstr = option "-dinstr"
+  let _dcamlprimc = option "-dcamlprimc"
   let _dtimings = option "-dtimings"
   let _dprofile = option "-dprofile"
   let _args = Arg.read_arg

utils/ccomp.ml

@@ -66,7 +66,7 @@ let display_msvc_output file name =
     close_in c;
     Sys.remove file
 
-let compile_file ?output ?(opt="") name =
+let compile_file ?output ?(opt="") ?stable_name name =
   let (pipe, file) =
     if Config.ccomp_type = "msvc" && not !Clflags.verbose then
       try
@@ -77,10 +77,14 @@ let compile_file ?output ?(opt="") name =
         ("", "")
     else
       ("", "") in
+  let debug_prefix_map =
+    match stable_name with
+    | None -> ""
+    | Some stable -> Printf.sprintf " -fdebug-prefix-map=%s=%s" name stable in
   let exit =
     command
       (Printf.sprintf
-         "%s %s %s -c %s %s %s %s %s%s"
+         "%s%s %s %s -c %s %s %s %s %s%s"
          (match !Clflags.c_compiler with
           | Some cc -> cc
           | None ->
@@ -89,6 +93,7 @@ let compile_file ?output ?(opt="") name =
                   then (Config.ocamlopt_cflags, Config.ocamlopt_cppflags)
                   else (Config.ocamlc_cflags, Config.ocamlc_cppflags) in
               (String.concat " " [Config.c_compiler; cflags; cppflags]))
+         debug_prefix_map
          (match output with
           | None -> ""
           | Some o -> Printf.sprintf "%s%s" Config.c_output_obj o)

utils/ccomp.mli

@@ -17,7 +17,7 @@
 
 val command: string -> int
 val run_command: string -> unit
-val compile_file: ?output:string -> ?opt:string -> string -> int
+val compile_file: ?output:string -> ?opt:string -> ?stable_name:string -> string -> int
 val create_archive: string -> string list -> int
 val expand_libname: string -> string
 val quote_files: string list -> string

utils/clflags.ml

@@ -106,6 +106,7 @@ and dump_flambda = ref false            (* -dflambda *)
 and dump_flambda_let = ref (None : int option) (* -dflambda-let=... *)
 and dump_flambda_verbose = ref false    (* -dflambda-verbose *)
 and dump_instr = ref false              (* -dinstr *)
+and keep_camlprimc_file = ref false     (* -dcamlprimc *)
 
 let keep_asm_file = ref false           (* -S *)
 let optimize_for_speed = ref true       (* -compact *)

utils/clflags.mli

@@ -132,6 +132,7 @@ val dump_rawflambda : bool ref
 val dump_flambda : bool ref
 val dump_flambda_let : int option ref
 val dump_instr : bool ref
+val keep_camlprimc_file : bool ref
 val keep_asm_file : bool ref
 val optimize_for_speed : bool ref
 val dump_cmm : bool ref

utils/config.mli

@@ -31,6 +31,8 @@ val c_compiler: string
 val c_output_obj: string
         (* Name of the option of the C compiler for specifying the output
            file *)
+val c_has_debug_prefix_map : bool
+        (* Whether the C compiler supports -fdebug-prefix-map *)
 val ocamlc_cflags : string
         (* The flags ocamlc should pass to the C compiler *)
 val ocamlc_cppflags : string

utils/config.mlp

@@ -32,6 +32,7 @@ let standard_runtime = "%%BYTERUN%%"
 let ccomp_type = "%%CCOMPTYPE%%"
 let c_compiler = "%%CC%%"
 let c_output_obj = "%%OUTPUTOBJ%%"
+let c_has_debug_prefix_map = %%CC_HAS_DEBUG_PREFIX_MAP%%
 let ocamlc_cflags = "%%OCAMLC_CFLAGS%%"
 let ocamlc_cppflags = "%%OCAMLC_CPPFLAGS%%"
 let ocamlopt_cflags = "%%OCAMLOPT_CFLAGS%%"