From 9c182f7e243320b51721ff383ac863f424eed607 Mon Sep 17 00:00:00 2001 From: Xavier Clerc Date: Wed, 27 Jun 2018 14:56:29 +0100 Subject: [PATCH] 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 | 5 +++++ Makefile | 1 + bytecomp/bytelink.ml | 34 +++++++++++++++++++++++----------- config/Makefile.mingw | 1 + config/Makefile.mingw64 | 1 + config/Makefile.msvc | 1 + config/Makefile.msvc64 | 1 + configure | 7 +++++++ driver/main.ml | 1 + driver/main_args.ml | 6 ++++++ driver/main_args.mli | 1 + ocamldoc/odoc_args.ml | 1 + testsuite/tools/expect_test.ml | 1 + tools/ocamlcp.ml | 1 + utils/ccomp.ml | 9 +++++++-- utils/ccomp.mli | 2 +- utils/clflags.ml | 1 + utils/clflags.mli | 1 + utils/config.mli | 2 ++ utils/config.mlp | 1 + 20 files changed, 64 insertions(+), 14 deletions(-) diff --git a/Changes b/Changes index db135c73477f..17e87722a7eb 100644 --- a/Changes +++ b/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. diff --git a/Makefile b/Makefile index c96772aa9bf4..7acf0a62ea67 100644 --- a/Makefile +++ b/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" diff --git a/bytecomp/bytelink.ml b/bytecomp/bytelink.ml index 05ff3d674add..5745b9f1d0d7 100644 --- a/bytecomp/bytelink.ml +++ b/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 diff --git a/config/Makefile.mingw b/config/Makefile.mingw index 402389705c38..bbcc13b2cd47 100644 --- a/config/Makefile.mingw +++ b/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 diff --git a/config/Makefile.mingw64 b/config/Makefile.mingw64 index 5538f9853b87..ea67e560d19f 100644 --- a/config/Makefile.mingw64 +++ b/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 diff --git a/config/Makefile.msvc b/config/Makefile.msvc index 2cf4de5640b8..1004991ff4bd 100644 --- a/config/Makefile.msvc +++ b/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 diff --git a/config/Makefile.msvc64 b/config/Makefile.msvc64 index 3ad35d32860f..82dec674b474 100644 --- a/config/Makefile.msvc64 +++ b/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 diff --git a/configure b/configure index af10ed8aefca..ac392bb87dd6 100755 --- a/configure +++ b/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 diff --git a/driver/main.ml b/driver/main.ml index 13c1e3b21b0d..0ff8168432c8 100644 --- a/driver/main.ml +++ b/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 diff --git a/driver/main_args.ml b/driver/main_args.ml index 87720ca359d6..2fc432ff2ca9 100644 --- a/driver/main_args.ml +++ b/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; diff --git a/driver/main_args.mli b/driver/main_args.mli index 40cecebb51aa..d41f5df422cc 100644 --- a/driver/main_args.mli +++ b/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;; diff --git a/ocamldoc/odoc_args.ml b/ocamldoc/odoc_args.ml index cdaf1993c1c9..fec8829b37ca 100644 --- a/ocamldoc/odoc_args.ml +++ b/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) diff --git a/testsuite/tools/expect_test.ml b/testsuite/tools/expect_test.ml index 660712b918ea..fd0d23a2ab24 100644 --- a/testsuite/tools/expect_test.ml +++ b/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 diff --git a/tools/ocamlcp.ml b/tools/ocamlcp.ml index 882203782084..2e4a1b74302b 100644 --- a/tools/ocamlcp.ml +++ b/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 diff --git a/utils/ccomp.ml b/utils/ccomp.ml index f3482a900bfb..3d46a2c87239 100644 --- a/utils/ccomp.ml +++ b/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) diff --git a/utils/ccomp.mli b/utils/ccomp.mli index 17094ba21351..cedd7052bf8f 100644 --- a/utils/ccomp.mli +++ b/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 diff --git a/utils/clflags.ml b/utils/clflags.ml index 424e6af57042..9ecfb1af245b 100644 --- a/utils/clflags.ml +++ b/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 *) diff --git a/utils/clflags.mli b/utils/clflags.mli index 1f5013ed47a7..7a29102909a8 100644 --- a/utils/clflags.mli +++ b/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 diff --git a/utils/config.mli b/utils/config.mli index 3fb18023b26e..79afbe356954 100644 --- a/utils/config.mli +++ b/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 diff --git a/utils/config.mlp b/utils/config.mlp index 994e0f9c6ccb..6ae206f200da 100644 --- a/utils/config.mlp +++ b/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%%"