From 87d5aad8425a41e3aa46006a027142218e9601ae Mon Sep 17 00:00:00 2001 From: Greta Yorsh Date: Fri, 18 Oct 2019 15:16:02 +0100 Subject: [PATCH 01/14] Add fdo field to context in dune-workspace Signed-off-by: Greta Yorsh --- src/dune/context.ml | 21 +++++++++++++-------- src/dune/context.mli | 3 +++ src/dune/workspace.ml | 31 +++++++++++++++++++++++++++++-- src/dune/workspace.mli | 1 + 4 files changed, 46 insertions(+), 10 deletions(-) diff --git a/src/dune/context.ml b/src/dune/context.ml index c1fd674daf3..aab2c852e4e 100644 --- a/src/dune/context.ml +++ b/src/dune/context.ml @@ -40,6 +40,7 @@ type t = ; kind : Kind.t ; profile : Profile.t ; merlin : bool + ; fdo_target_exe : string option ; for_host : t option ; implicit : bool ; build_dir : Path.Build.t @@ -109,6 +110,7 @@ let to_dyn t : Dyn.t = ; ( "for_host" , option Context_name.to_dyn (Option.map t.for_host ~f:(fun t -> t.name)) ) + ; ("fdo_target_exe", option string t.fdo_target_exe) ; ("build_dir", Path.Build.to_dyn t.build_dir) ; ("toplevel_path", option path t.toplevel_path) ; ("ocaml_bin", path t.ocaml_bin) @@ -215,7 +217,7 @@ let ocamlfind_printconf_path ~env ~ocamlfind ~toolchain = List.map l ~f:Path.of_filename_relative_to_initial_cwd let create ~(kind : Kind.t) ~path ~env ~env_nodes ~name ~merlin ~targets - ~host_context ~host_toolchain ~profile = + ~host_context ~host_toolchain ~profile ~fdo_target_exe = let opam_var_cache = Table.create (module String) 128 in ( match kind with | Opam { root = Some root; _ } -> Table.set opam_var_cache "root" root @@ -444,6 +446,7 @@ let create ~(kind : Kind.t) ~path ~env ~env_nodes ~name ~merlin ~targets ; kind ; profile ; merlin + ; fdo_target_exe ; env_nodes ; for_host = host ; build_dir @@ -557,9 +560,9 @@ let extend_paths t ~env = let opam_config_var t var = opam_config_var ~env:t.env ~cache:t.opam_var_cache var -let default ~merlin ~env_nodes ~env ~targets = +let default ~merlin ~env_nodes ~env ~targets ~fdo_target_exe = let path = Env.path env in - create ~kind:Default ~path ~env ~env_nodes ~merlin ~targets + create ~kind:Default ~path ~env ~env_nodes ~merlin ~targets ~fdo_target_exe let opam_version = let res = ref None in @@ -583,8 +586,8 @@ let opam_version = res := Some future; Fiber.Future.wait future -let create_for_opam ~root ~env ~env_nodes ~targets ~profile - ~(switch : Context_name.t) ~name ~merlin ~host_context ~host_toolchain = +let create_for_opam ~root ~env ~env_nodes ~targets ~profile ~switch ~name + ~merlin ~host_context ~host_toolchain ~fdo_target_exe = let opam = match Lazy.force opam with | None -> Utils.program_not_found "opam" ~loc:None @@ -634,7 +637,7 @@ let create_for_opam ~root ~env ~env_nodes ~targets ~profile create ~kind:(Opam { root; switch }) ~profile ~targets ~path ~env ~env_nodes ~name ~merlin ~host_context - ~host_toolchain + ~host_toolchain ~fdo_target_exe let instantiate_context env (workspace : Workspace.t) ~(context : Workspace.Context.t) ~host_context = @@ -652,6 +655,7 @@ let instantiate_context env (workspace : Workspace.t) ; toolchain ; paths ; loc = _ + ; fdo_target_exe } -> let merlin = workspace.merlin_context = Some (Workspace.Context.name context) @@ -666,7 +670,7 @@ let instantiate_context env (workspace : Workspace.t) in let env = extend_paths ~env paths in default ~env ~env_nodes ~profile ~targets ~name ~merlin ~host_context - ~host_toolchain + ~host_toolchain ~fdo_target_exe | Opam { base = { targets @@ -677,6 +681,7 @@ let instantiate_context env (workspace : Workspace.t) ; toolchain ; paths ; loc = _ + ; fdo_target_exe } ; switch ; root @@ -684,7 +689,7 @@ let instantiate_context env (workspace : Workspace.t) } -> let env = extend_paths ~env paths in create_for_opam ~root ~env_nodes ~env ~profile ~switch ~name ~merlin - ~targets ~host_context ~host_toolchain:toolchain + ~targets ~host_context ~host_toolchain:toolchain ~fdo_target_exe let create ~env (workspace : Workspace.t) = let rec contexts : t list Fiber.Once.t Context_name.Map.t Lazy.t = diff --git a/src/dune/context.mli b/src/dune/context.mli index 9487a51c3c6..ea823df53fb 100644 --- a/src/dune/context.mli +++ b/src/dune/context.mli @@ -48,6 +48,9 @@ type t = ; profile : Profile.t (** [true] if this context is used for the .merlin files *) ; merlin : bool + (** [Some path/to/foo.exe] if this contexts is for feedback-directed + optimization of target path/to/foo.exe *) + ; fdo_target_exe : string option (** If this context is a cross-compilation context, you need another context for building tools used for the compilation that run on the host. *) diff --git a/src/dune/workspace.ml b/src/dune/workspace.ml index da6f598a28d..bcac2042552 100644 --- a/src/dune/workspace.ml +++ b/src/dune/workspace.ml @@ -40,8 +40,16 @@ module Context = struct ; name : Context_name.t ; host_context : Context_name.t option ; paths : (string * Ordered_set_lang.t) list + ; fdo_target_exe : string option } + let fdo_suffix t = + match t.fdo_target_exe with + | None -> "" + | Some file -> + let name, _ = Filename.(basename file |> split_extension) in + "-fdo-" ^ name + let t ~profile = let+ env = env_field and+ targets = @@ -53,6 +61,8 @@ module Context = struct and+ toolchain = field_o "toolchain" (Dune_lang.Syntax.since syntax (1, 5) >>> Context_name.decode) + and+ fdo_target_exe = + field_o "fdo" (Dune_lang.Syntax.since syntax (1, 12) >>> string) and+ paths = let f l = match @@ -79,6 +89,19 @@ module Context = struct "`targets` and `host` options cannot be used in the same \ context." ]); + ( match fdo_target_exe with + | None -> () + | Some file -> + let ext = Filename.extension file in + if not (ext = ".exe") then + User_error.raise ~loc + [ Pp.textf + "`fdo %s` expects executable filename ending with .exe \ + extension, not %s. \n\ + Please specify the name of the executable to optimize,\ + including path from ." + file ext + ] ); { targets ; profile ; loc @@ -87,6 +110,7 @@ module Context = struct ; host_context ; toolchain ; paths + ; fdo_target_exe } end @@ -104,7 +128,8 @@ module Context = struct and+ root = field_o "root" string and+ merlin = field_b "merlin" and+ base = Common.t ~profile in - let name = Option.value ~default:switch name in + let default = switch ^ Common.fdo_suffix base in + let name = Option.value ~default name in let base = { base with targets = Target.add base.targets x; name } in { base; switch; root; merlin } end @@ -119,7 +144,8 @@ module Context = struct ( Dune_lang.Syntax.since syntax (1, 10) >>= fun () -> Context_name.decode ) in - let name = Option.value ~default:common.name name in + let default = common.name ^ Common.fdo_suffix common in + let name = Option.value ~default name in { common with targets = Target.add common.targets x; name } end @@ -171,6 +197,7 @@ module Context = struct ; env = Dune_env.Stanza.empty ; toolchain = None ; paths = [] + ; fdo_target_exe = None } end diff --git a/src/dune/workspace.mli b/src/dune/workspace.mli index 273f3b086ec..bdcc1044e83 100644 --- a/src/dune/workspace.mli +++ b/src/dune/workspace.mli @@ -20,6 +20,7 @@ module Context : sig ; name : Context_name.t ; host_context : Context_name.t option ; paths : (string * Ordered_set_lang.t) list + ; fdo_target_exe : string option } end From 466386d36e43bc098eb7a14eb0a727fd0950aaea Mon Sep 17 00:00:00 2001 From: Greta Yorsh Date: Thu, 10 Oct 2019 15:36:53 +0100 Subject: [PATCH 02/14] Check ocaml compiler support for fdo Signed-off-by: Greta Yorsh --- src/dune/ocaml_version.ml | 4 ++++ src/dune/ocaml_version.mli | 7 +++++++ 2 files changed, 11 insertions(+) diff --git a/src/dune/ocaml_version.ml b/src/dune/ocaml_version.ml index cd31c77bbed..46ed783bf41 100644 --- a/src/dune/ocaml_version.ml +++ b/src/dune/ocaml_version.ml @@ -33,3 +33,7 @@ let ooi_supports_no_code version = version >= (4, 05, 0) let supports_let_syntax version = version >= (4, 08, 0) let supports_output_complete_exe version = version >= (4, 10, 0) + +let supports_function_sections version = version > (4, 10, 0) + +let supports_split_at_emit version = version >= (4, 11, 0) diff --git a/src/dune/ocaml_version.mli b/src/dune/ocaml_version.mli index ef293cd71b5..40ddb05fd88 100644 --- a/src/dune/ocaml_version.mli +++ b/src/dune/ocaml_version.mli @@ -50,3 +50,10 @@ val supports_let_syntax : t -> bool (** Does this support [-output-complete-exe]? *) val supports_output_complete_exe : t -> bool + +(** Whether the compiler supports options for splitting compilation at emit: + [-stop-after scheduling] [-save-ir-after scheduling] [-start-from emit] *) +val supports_split_at_emit : t -> bool + +(** Whether the compiler supports -function-sections *) +val supports_function_sections : t -> bool From 160723382ea11318ad65e2fa4f7dbf2a49a156ed Mon Sep 17 00:00:00 2001 From: Greta Yorsh Date: Thu, 10 Oct 2019 15:37:13 +0100 Subject: [PATCH 03/14] Check ocaml compiler dev version Signed-off-by: Greta Yorsh --- src/ocaml-config/ocaml_config.ml | 6 ++++++ src/ocaml-config/ocaml_config.mli | 2 ++ 2 files changed, 8 insertions(+) diff --git a/src/ocaml-config/ocaml_config.ml b/src/ocaml-config/ocaml_config.ml index 9f60f49e516..536a739b4f2 100644 --- a/src/ocaml-config/ocaml_config.ml +++ b/src/ocaml-config/ocaml_config.ml @@ -510,3 +510,9 @@ let make vars = with | t -> Ok t | exception Vars.E (origin, msg) -> Error (origin, msg) + +let is_dev_version t = + try + Scanf.sscanf t.version_string "%u.%u.%u+dev" (fun _ _ _ -> ()); + true + with _ -> false diff --git a/src/ocaml-config/ocaml_config.mli b/src/ocaml-config/ocaml_config.mli index 28e07241a3c..4b7f92a02bc 100644 --- a/src/ocaml-config/ocaml_config.mli +++ b/src/ocaml-config/ocaml_config.mli @@ -159,3 +159,5 @@ module Value : sig end val to_list : t -> (string * Value.t) list + +val is_dev_version : t -> bool From 4e4fe43d09900b6d112724d0098204ad61e3421c Mon Sep 17 00:00:00 2001 From: Greta Yorsh Date: Thu, 10 Oct 2019 15:44:06 +0100 Subject: [PATCH 04/14] User error if fdo is used in dune-workspace but no compiler support Signed-off-by: Greta Yorsh --- src/dune/context.ml | 32 ++++++++++++++++++++++++++++++++ 1 file changed, 32 insertions(+) diff --git a/src/dune/context.ml b/src/dune/context.ml index aab2c852e4e..4321cb7e3b6 100644 --- a/src/dune/context.ml +++ b/src/dune/context.ml @@ -216,6 +216,36 @@ let ocamlfind_printconf_path ~env ~ocamlfind ~toolchain = let+ l = Process.run_capture_lines ~env Strict ocamlfind args in List.map l ~f:Path.of_filename_relative_to_initial_cwd +let check_fdo_support has_native ocfg ~name = + let version = Ocaml_version.of_ocaml_config ocfg in + let version_string = Ocaml_config.version_string ocfg in + let err () = + User_error.raise + [ Pp.textf + "fdo requires ocamlopt version >= 4.10, current version is %s \ + (context: %s)" + name version_string + ] + in + if not has_native then err (); + if Ocaml_config.is_dev_version ocfg then + ( (* Allows fdo to be invoked with any dev version of the compiler. This is + experimental and will be removed when ocamlfdo is fully integrated + into the toolchain. When using a dev version of ocamlopt that does not + support the required options, fdo builds will fail because the + compiler won't recongnize the options. Normals builds won't be + affected. *) ) + else if not (Ocaml_version.supports_split_at_emit version) then + if not (Ocaml_version.supports_function_sections version) then + err () + else + User_warning.emit + [ Pp.textf + "fdo requires ocamlopt version >= 4.10, current version %s has \ + partial support. Some optimizations are disabled! (context: %s)" + name version_string + ] + let create ~(kind : Kind.t) ~path ~env ~env_nodes ~name ~merlin ~targets ~host_context ~host_toolchain ~profile ~fdo_target_exe = let opam_var_cache = Table.create (module String) 128 in @@ -440,6 +470,8 @@ let create ~(kind : Kind.t) ~path ~env ~env_nodes ~name ~merlin ~targets ; stdlib_dir } in + if Option.is_some fdo_target_exe then + check_fdo_support lib_config.has_native ocfg ~name; let t = { name ; implicit From 1ba2fb9dc3efe50fb84464d4a9de13b8f608e1ba Mon Sep 17 00:00:00 2001 From: Greta Yorsh Date: Fri, 18 Oct 2019 15:14:39 +0100 Subject: [PATCH 05/14] Compilation rules with fdo Signed-off-by: Greta Yorsh --- src/dune/fdo.ml | 102 +++++++++++++++++++++++++++++++++ src/dune/fdo.mli | 14 +++++ src/dune/module_compilation.ml | 97 +++++++++++++++++++++++-------- 3 files changed, 190 insertions(+), 23 deletions(-) create mode 100644 src/dune/fdo.ml create mode 100644 src/dune/fdo.mli diff --git a/src/dune/fdo.ml b/src/dune/fdo.ml new file mode 100644 index 00000000000..875109361a6 --- /dev/null +++ b/src/dune/fdo.ml @@ -0,0 +1,102 @@ +open! Stdune +module CC = Compilation_context + +type phase = + | All + | Compile + | Emit + +let linear_ext = ".cmir-linear" + +let linear_fdo_ext = linear_ext ^ "-fdo" + +let fdo_profile_filename s = s ^ ".fdo-profile" + +let linker_script_filename s = s ^ ".linker-script" + +let linker_script_hot_filename s = s ^ ".linker-script-hot" + +let perf_data_filename s = s ^ ".perf.data" + +let phase_flags = function + | None -> [] + | Some All -> [ "-g"; "-function-sections" ] + | Some Compile -> + [ "-g"; "-stop-after"; "scheduling"; "-save-ir-after"; "scheduling" ] + | Some Emit -> [ "-g"; "-start-from"; "emit"; "-function-sections" ] + +(* Location of ocamlfdo binary tool is independent of the module, but may + depend on the context. If it isn't cached elsewhere, we should do it here. + CR gyorsh: is it cached? *) +let ocamlfdo_binary sctx dir = + let ocamlfdo = + Super_context.resolve_program sctx ~dir ~loc:None "ocamlfdo" + ~hint:"try: opam install ocamlfdo" + in + match ocamlfdo with + | Error e -> Action.Prog.Not_found.raise e + | Ok _ -> ocamlfdo + +(* CR gyorsh: this should also be cached *) +let fdo_use_profile (ctx : Context.t) name fdo_profile = + let fdo_profile_src = Path.Source.(relative root fdo_profile) in + let profile_exists = File_tree.file_exists fdo_profile_src in + match Env.get ctx.env "OCAMLFDO_USE_PROFILE" with + | None + | Some "if-exists" -> + profile_exists + | Some "always" -> + if profile_exists then + true + else + User_error.raise + [ Pp.textf + "Cannot build %s: OCAMLFDO_USE_PROFILE=always but profile file %s \ + does not exist." + name fdo_profile + ] + | Some "never" -> false + | Some other -> + User_error.raise + [ Pp.textf + "Failed to parse environment variable: OCAMLFDO_USE_PROFILE=%s\n\ + Permitted values: if-exists always never\n\ + Default: if-exists" + other + ] + +let opt_rule cctx m fdo_target_exe = + let sctx = CC.super_context cctx in + let ctx = CC.context cctx in + let dir = CC.dir cctx in + let obj_dir = CC.obj_dir cctx in + let linear = Obj_dir.Module.obj_file obj_dir m ~kind:Cmx ~ext:linear_ext in + let linear_fdo = + Obj_dir.Module.obj_file obj_dir m ~kind:Cmx ~ext:linear_fdo_ext + in + let fdo_profile = fdo_profile_filename fdo_target_exe in + let name = Module_name.to_string (Module.name m) in + let use_profile = fdo_use_profile ctx name fdo_profile in + let flags = + let open Command.Args in + if use_profile then + S + [ A "-fdo-profile" + ; Dep (Path.build (Path.Build.relative ctx.build_dir fdo_profile)) + ; As [ "-md5-unit"; "-reorder-blocks"; "opt"; "-q" ] + ] + else + As [ "-md5-unit"; "-extra-debug"; "-q" ] + in + let ocamlfdo_flags = + Env.get ctx.env "OCAMLFDO_FLAGS" + |> Option.value ~default:"" |> String.extract_blank_separated_words + in + Super_context.add_rule sctx ~dir + (Command.run ~dir:(Path.build dir) (ocamlfdo_binary sctx dir) + [ A "opt" + ; Hidden_targets [ linear_fdo ] + ; Dep (Path.build linear) + ; As ocamlfdo_flags + ; flags + ]) diff --git a/src/dune/fdo.mli b/src/dune/fdo.mli new file mode 100644 index 00000000000..6ada6db7d44 --- /dev/null +++ b/src/dune/fdo.mli @@ -0,0 +1,14 @@ +(** Integration with feedback-directed optimizations using ocamlfdo. *) + +type phase = + | All + | Compile + | Emit + +val linear_ext : string + +val linear_fdo_ext : string + +val phase_flags : phase option -> string list + +val opt_rule : Compilation_context.t -> Module.t -> string -> unit diff --git a/src/dune/module_compilation.ml b/src/dune/module_compilation.ml index 98f4c7f0fe1..af00cdfa04c 100644 --- a/src/dune/module_compilation.ml +++ b/src/dune/module_compilation.ml @@ -46,7 +46,7 @@ let copy_interface ~sctx ~dir ~obj_dir m = ~src:(Path.build (Obj_dir.Module.cm_file_unsafe obj_dir m ~kind:Cmi)) ~dst:(Obj_dir.Module.cm_public_file_unsafe obj_dir m ~kind:Cmi)) -let build_cm cctx ~dep_graphs ~precompiled_cmi ~cm_kind (m : Module.t) = +let build_cm cctx ~dep_graphs ~precompiled_cmi ~cm_kind (m : Module.t) ~phase = let sctx = CC.super_context cctx in let dir = CC.dir cctx in let obj_dir = CC.obj_dir cctx in @@ -60,33 +60,51 @@ let build_cm cctx ~dep_graphs ~precompiled_cmi ~cm_kind (m : Module.t) = let ml_kind = Cm_kind.source cm_kind in let+ src = Module.file m ~ml_kind in let dst = Obj_dir.Module.cm_file_unsafe obj_dir m ~kind:cm_kind in + let obj = + Obj_dir.Module.obj_file obj_dir m ~kind:Cmx ~ext:ctx.lib_config.ext_obj + in + let linear = + Obj_dir.Module.obj_file obj_dir m ~kind:Cmx ~ext:Fdo.linear_ext + in + let linear_fdo = + Obj_dir.Module.obj_file obj_dir m ~kind:Cmx ~ext:Fdo.linear_fdo_ext + in let extra_args, extra_deps, other_targets = if precompiled_cmi then (force_read_cmi src, [], []) else (* If we're compiling an implementation, then the cmi is present *) let public_vlib_module = Module.kind m = Impl_vmodule in - match (cm_kind, Module.file m ~ml_kind:Intf, public_vlib_module) with - (* If there is no mli, [ocamlY -c file.ml] produces both the .cmY and - .cmi. We choose to use ocamlc to produce the cmi and to produce the - cmx we have to wait to avoid race conditions. *) - | Cmo, None, false -> - copy_interface ~dir ~obj_dir ~sctx m; - ([], [], [ Obj_dir.Module.cm_file_unsafe obj_dir m ~kind:Cmi ]) - | Cmo, None, true - | (Cmo | Cmx), _, _ -> - ( force_read_cmi src - , [ Path.build (Obj_dir.Module.cm_file_unsafe obj_dir m ~kind:Cmi) ] - , [] ) - | Cmi, _, _ -> - copy_interface ~dir ~obj_dir ~sctx m; - ([], [], []) + match phase with + | Some Fdo.Emit -> ([], [], []) + | Some Fdo.Compile + | Some Fdo.All + | None -> ( + match (cm_kind, Module.file m ~ml_kind:Intf, public_vlib_module) with + (* If there is no mli, [ocamlY -c file.ml] produces both the .cmY and + .cmi. We choose to use ocamlc to produce the cmi and to produce the + cmx we have to wait to avoid race conditions. *) + | Cmo, None, false -> + copy_interface ~dir ~obj_dir ~sctx m; + ([], [], [ Obj_dir.Module.cm_file_unsafe obj_dir m ~kind:Cmi ]) + | Cmo, None, true + | (Cmo | Cmx), _, _ -> + ( force_read_cmi src + , [ Path.build (Obj_dir.Module.cm_file_unsafe obj_dir m ~kind:Cmi) ] + , [] ) + | Cmi, _, _ -> + copy_interface ~dir ~obj_dir ~sctx m; + ([], [], []) ) in let other_targets = match cm_kind with - | Cmx -> - Obj_dir.Module.obj_file obj_dir m ~kind:Cmx ~ext:ctx.lib_config.ext_obj - :: other_targets + | Cmx -> ( + match phase with + | Some Fdo.Compile -> linear :: other_targets + | Some Fdo.Emit -> other_targets + | Some Fdo.All + | None -> + obj :: other_targets ) | Cmi | Cmo -> other_targets @@ -125,6 +143,22 @@ let build_cm cctx ~dep_graphs ~precompiled_cmi ~cm_kind (m : Module.t) = and+ pp_flags = pp in flags @ pp_flags in + let output = + match phase with + | Some Fdo.Compile -> dst + | Some Fdo.Emit -> obj + | Some Fdo.All + | None -> + dst + in + let src = + match phase with + | Some Fdo.Emit -> Path.build linear_fdo + | Some Fdo.Compile + | Some Fdo.All + | None -> + src + in let modules = Compilation_context.modules cctx in SC.add_rule sctx ~sandbox ~dir (let open Build.O in @@ -144,6 +178,7 @@ let build_cm cctx ~dep_graphs ~precompiled_cmi ~cm_kind (m : Module.t) = A "-nodynlink" ) ; A "-no-alias-deps" ; opaque_arg + ; As (Fdo.phase_flags phase) ; opens modules m ; As ( match stdlib with @@ -152,7 +187,7 @@ let build_cm cctx ~dep_graphs ~precompiled_cmi ~cm_kind (m : Module.t) = (* XXX why aren't these just normal library flags? *) [ "-nopervasives"; "-nostdlib" ] ) ; A "-o" - ; Target dst + ; Target output ; A "-c" ; Command.Ml_kind.flag ml_kind ; Dep src @@ -161,10 +196,26 @@ let build_cm cctx ~dep_graphs ~precompiled_cmi ~cm_kind (m : Module.t) = |> Option.value ~default:() let build_module ~dep_graphs ?(precompiled_cmi = false) cctx m = - build_cm cctx m ~dep_graphs ~precompiled_cmi ~cm_kind:Cmo; - build_cm cctx m ~dep_graphs ~precompiled_cmi ~cm_kind:Cmx; + build_cm cctx m ~dep_graphs ~precompiled_cmi ~cm_kind:Cmo ~phase:None; + let ctx = CC.context cctx in + let can_split = + Ocaml_version.supports_split_at_emit ctx.version + || Ocaml_config.is_dev_version ctx.ocaml_config + in + ( match (ctx.fdo_target_exe, can_split) with + | None, _ -> + build_cm cctx m ~dep_graphs ~precompiled_cmi ~cm_kind:Cmx ~phase:None + | Some _, false -> + build_cm cctx m ~dep_graphs ~precompiled_cmi ~cm_kind:Cmx + ~phase:(Some Fdo.All) + | Some fdo_target_exe, true -> + build_cm cctx m ~dep_graphs ~precompiled_cmi ~cm_kind:Cmx + ~phase:(Some Fdo.Compile); + Fdo.opt_rule cctx m fdo_target_exe; + build_cm cctx m ~dep_graphs ~precompiled_cmi ~cm_kind:Cmx + ~phase:(Some Fdo.Emit) ); if not precompiled_cmi then - build_cm cctx m ~dep_graphs ~precompiled_cmi ~cm_kind:Cmi; + build_cm cctx m ~dep_graphs ~precompiled_cmi ~cm_kind:Cmi ~phase:None; Compilation_context.js_of_ocaml cctx |> Option.iter ~f:(fun js_of_ocaml -> (* Build *.cmo.js *) From 50f7c2602aa19eec12f71cc4af0b63c78c481ddf Mon Sep 17 00:00:00 2001 From: Greta Yorsh Date: Fri, 18 Oct 2019 15:15:08 +0100 Subject: [PATCH 06/14] Linking rules with fdo Signed-off-by: Greta Yorsh --- src/dune/exe.ml | 6 +++ src/dune/fdo.ml | 102 +++++++++++++++++++++++++++++++++++++++++++++++ src/dune/fdo.mli | 8 ++++ 3 files changed, 116 insertions(+) diff --git a/src/dune/exe.ml b/src/dune/exe.ml index 6e6f50fe926..ff53e506289 100644 --- a/src/dune/exe.ml +++ b/src/dune/exe.ml @@ -128,6 +128,11 @@ let link_exe ~loc ~name ~(linkage : Linkage.t) ~cm_files ~link_time_code_gen let exe = exe_path_from_name cctx ~name ~linkage in let compiler = Option.value_exn (Context.compiler ctx mode) in let top_sorted_cms = Cm_files.top_sorted_cms cm_files ~mode:linkage.mode in + let target_exe = + let open Path in + exe |> build |> drop_build_context_exn |> Source.to_string + in + let fdo_linker_script = Fdo.Linker_script.create cctx target_exe in SC.add_rule sctx ~loc ~dir ~mode: ( match promote with @@ -166,6 +171,7 @@ let link_exe ~loc ~name ~(linkage : Linkage.t) ~cm_files ~link_time_code_gen ]) ; Deps o_files ; Dyn (Build.map top_sorted_cms ~f:(fun x -> Command.Args.Deps x)) + ; Fdo.Linker_script.flags fdo_linker_script ]) let link_js ~name ~cm_files ~promote cctx = diff --git a/src/dune/fdo.ml b/src/dune/fdo.ml index 875109361a6..8720c50448b 100644 --- a/src/dune/fdo.ml +++ b/src/dune/fdo.ml @@ -100,3 +100,105 @@ let opt_rule cctx m fdo_target_exe = ; As ocamlfdo_flags ; flags ]) + +module Linker_script = struct + type t = Path.t option + + let linker_script_rule cctx fdo_target_exe = + let sctx = CC.super_context cctx in + let ctx = CC.context cctx in + let dir = CC.dir cctx in + let ocamlfdo = ocamlfdo_binary sctx dir in + let linker_script_hot = linker_script_hot_filename fdo_target_exe in + let fdo_profile = fdo_profile_filename fdo_target_exe in + let linker_script = linker_script_filename fdo_target_exe in + let linker_script_path = + Path.Build.(relative ctx.build_dir linker_script) + in + let linker_script_template = + match ocamlfdo with + | Error _ -> assert false + | Ok ocamlfdo_path -> + let ocamlfdo_dir = + ocamlfdo_path |> Path.to_absolute_filename |> Filename.dirname + in + ocamlfdo_dir ^ "/../etc/ocamlfdo/linker-script" + in + (* CR gyorsh: is there a gracefull way to check it? *) + if not (Sys.file_exists linker_script_template) then + User_error.raise + [ Pp.textf + "Cannot find template linker script for %s: %s does not exist." + linker_script_template fdo_target_exe + ]; + let linker_script_template_path = + Path.of_filename_relative_to_initial_cwd linker_script_template + in + let extra_flags = + Env.get ctx.env "OCAMLFDO_LINKER_SCRIPT_FLAGS" + |> Option.value ~default:"" |> String.extract_blank_separated_words + in + let use_profile = fdo_use_profile ctx linker_script fdo_profile in + let flags = + let open Command.Args in + if use_profile then + let fdo_profile_path = + Path.build (Path.Build.relative ctx.build_dir fdo_profile) + in + S [ A "-fdo-profile"; Dep fdo_profile_path ] + else if + File_tree.file_exists Path.Source.(relative root linker_script_hot) + then ( + let linker_script_hot_path = + Path.build (Path.Build.relative ctx.build_dir linker_script_hot) + in + User_warning.emit + ~hints:[ Pp.textf "To ignore %s, rename it." linker_script_hot ] + [ Pp.textf + "Linker script generation with ocamlfdo cannot get hot function \ + layout from profile, because either OCAMLFDO_USE_PROFILE=never \ + or %s not found. Hot functions layout from file %s will be \ + used." + fdo_profile linker_script_hot + ]; + S [ A "-linker-script-hot"; Dep linker_script_hot_path ] + ) else + As [] + in + Super_context.add_rule sctx ~dir + (Command.run ~dir:(Path.build ctx.build_dir) ocamlfdo + [ A "linker-script" + ; A "-linker-script-template" + ; Dep linker_script_template_path + ; A "-o" + ; Target linker_script_path + ; flags + ; A "-q" + ; As extra_flags + ]); + Path.build linker_script_path + + let create cctx name = + let ctx = CC.context cctx in + match ctx.fdo_target_exe with + | None -> None + | Some fdo_target_exe -> + if + String.equal name fdo_target_exe + && ( Ocaml_version.supports_function_sections ctx.version + || Ocaml_config.is_dev_version ctx.ocaml_config ) + then + Some (linker_script_rule cctx fdo_target_exe) + else + None + + let flags t = + let open Command.Args in + match t with + | None -> As [] + | Some linker_script -> + S + [ A "-ccopt" + ; Concat ("", [ A "-Xlinker --script="; Dep linker_script ]) + ] +end diff --git a/src/dune/fdo.mli b/src/dune/fdo.mli index 6ada6db7d44..87fc8418ebe 100644 --- a/src/dune/fdo.mli +++ b/src/dune/fdo.mli @@ -12,3 +12,11 @@ val linear_fdo_ext : string val phase_flags : phase option -> string list val opt_rule : Compilation_context.t -> Module.t -> string -> unit + +module Linker_script : sig + type t + + val create : Compilation_context.t -> string -> t + + val flags : t -> Command.Args.dynamic Command.Args.t +end From 8e68c5e7978a13bbfbc31df243539cb3f7baf396 Mon Sep 17 00:00:00 2001 From: Greta Yorsh Date: Thu, 10 Oct 2019 15:34:34 +0100 Subject: [PATCH 07/14] Tests for fdo Signed-off-by: Greta Yorsh --- src/dune/fdo.ml | 2 - test/blackbox-tests/dune.inc | 9 ++ test/blackbox-tests/gen_tests.ml | 1 + .../test-cases/fdo/dune-project | 1 + .../test-cases/fdo/dune-workspace.1 | 20 +++ .../test-cases/fdo/dune-workspace.2 | 18 +++ .../test-cases/fdo/dune-workspace.3 | 18 +++ .../test-cases/fdo/dune-workspace.4 | 7 + .../test-cases/fdo/dune-workspace.5 | 7 + test/blackbox-tests/test-cases/fdo/run.t | 102 ++++++++++++++ .../test-cases/fdo/src-with-profile/dune | 1 + .../fdo/src-with-profile/foo.exe.fdo-profile | 130 ++++++++++++++++++ .../foo.exe.linker-script-hot | 6 + .../test-cases/fdo/src-with-profile/foo.ml | 17 +++ test/blackbox-tests/test-cases/fdo/src/dune | 1 + test/blackbox-tests/test-cases/fdo/src/foo.ml | 17 +++ .../test-cases/workspaces/run.t | 2 +- 17 files changed, 356 insertions(+), 3 deletions(-) create mode 100644 test/blackbox-tests/test-cases/fdo/dune-project create mode 100644 test/blackbox-tests/test-cases/fdo/dune-workspace.1 create mode 100644 test/blackbox-tests/test-cases/fdo/dune-workspace.2 create mode 100644 test/blackbox-tests/test-cases/fdo/dune-workspace.3 create mode 100644 test/blackbox-tests/test-cases/fdo/dune-workspace.4 create mode 100644 test/blackbox-tests/test-cases/fdo/dune-workspace.5 create mode 100644 test/blackbox-tests/test-cases/fdo/run.t create mode 100644 test/blackbox-tests/test-cases/fdo/src-with-profile/dune create mode 100644 test/blackbox-tests/test-cases/fdo/src-with-profile/foo.exe.fdo-profile create mode 100644 test/blackbox-tests/test-cases/fdo/src-with-profile/foo.exe.linker-script-hot create mode 100644 test/blackbox-tests/test-cases/fdo/src-with-profile/foo.ml create mode 100644 test/blackbox-tests/test-cases/fdo/src/dune create mode 100644 test/blackbox-tests/test-cases/fdo/src/foo.ml diff --git a/src/dune/fdo.ml b/src/dune/fdo.ml index 8720c50448b..48f97dc1ebb 100644 --- a/src/dune/fdo.ml +++ b/src/dune/fdo.ml @@ -16,8 +16,6 @@ let linker_script_filename s = s ^ ".linker-script" let linker_script_hot_filename s = s ^ ".linker-script-hot" -let perf_data_filename s = s ^ ".perf.data" - let phase_flags = function | None -> [] | Some All -> [ "-g"; "-function-sections" ] diff --git a/test/blackbox-tests/dune.inc b/test/blackbox-tests/dune.inc index e4caf1c36c1..4073cb363da 100644 --- a/test/blackbox-tests/dune.inc +++ b/test/blackbox-tests/dune.inc @@ -570,6 +570,14 @@ test-cases/fallback-dune (progn (run %{exe:cram.exe} -test run.t) (diff? run.t run.t.corrected))))) +(alias + (name fdo) + (deps (package dune) (source_tree test-cases/fdo)) + (action + (chdir + test-cases/fdo + (progn (run %{exe:cram.exe} -test run.t) (diff? run.t run.t.corrected))))) + (alias (name findlib) (deps (package dune) (source_tree test-cases/findlib)) @@ -2319,6 +2327,7 @@ (deps (alias cinaps) (alias envs-and-contexts) + (alias fdo) (alias utop) (alias utop-default) (alias utop-default-implementation))) diff --git a/test/blackbox-tests/gen_tests.ml b/test/blackbox-tests/gen_tests.ml index 7b58fda8064..4438152bb1a 100644 --- a/test/blackbox-tests/gen_tests.ml +++ b/test/blackbox-tests/gen_tests.ml @@ -139,6 +139,7 @@ let exclusions = ; odoc "github717-odoc-index" ; odoc "multiple-private-libs" ; make "cinaps" ~external_deps:true ~enabled:false + ; make "fdo" ~external_deps:true ~enabled:false ; make "ppx-rewriter" ~skip_ocaml:"4.02.3" ~external_deps:true ; make "cross-compilation" ~external_deps:true ; make "dune-ppx-driver-system" ~external_deps:true diff --git a/test/blackbox-tests/test-cases/fdo/dune-project b/test/blackbox-tests/test-cases/fdo/dune-project new file mode 100644 index 00000000000..1c29073dfff --- /dev/null +++ b/test/blackbox-tests/test-cases/fdo/dune-project @@ -0,0 +1 @@ +(lang dune 1.12) diff --git a/test/blackbox-tests/test-cases/fdo/dune-workspace.1 b/test/blackbox-tests/test-cases/fdo/dune-workspace.1 new file mode 100644 index 00000000000..4c02e39465f --- /dev/null +++ b/test/blackbox-tests/test-cases/fdo/dune-workspace.1 @@ -0,0 +1,20 @@ +(lang dune 1.12) + +; this is a test for various ways of specifying an fdo context +; and inferring the names of these contexts from the name +; of the target executable, unless explicitly specified. + +(context (default)) + +;; ; explicitly named context with fdo +(context (default + (fdo src/foo.exe) + (name foofoo) + )) + +;; default named context with fdo +(context (default + (fdo src/foo.exe) + ; expected name: + ;; (name default-fdo-foo) + )) diff --git a/test/blackbox-tests/test-cases/fdo/dune-workspace.2 b/test/blackbox-tests/test-cases/fdo/dune-workspace.2 new file mode 100644 index 00000000000..d2ba396ad9d --- /dev/null +++ b/test/blackbox-tests/test-cases/fdo/dune-workspace.2 @@ -0,0 +1,18 @@ +(lang dune 1.12) + +; this is a test for various ways of specifying an fdo context +; and inferring the names of these contexts from the name +; of the target executable, unless explicitly specified. + +(context (default + (fdo src/test2.exe) + ; expected name: + ;; (name default-fdo-test2) + )) + +; the following context is expected to cause an error +; because it has the same name as the inferred names of fdo context +(context (default + (name default-fdo-test2) + )) + diff --git a/test/blackbox-tests/test-cases/fdo/dune-workspace.3 b/test/blackbox-tests/test-cases/fdo/dune-workspace.3 new file mode 100644 index 00000000000..81713878452 --- /dev/null +++ b/test/blackbox-tests/test-cases/fdo/dune-workspace.3 @@ -0,0 +1,18 @@ +(lang dune 1.12) + +; this is a test for various ways of specifying an fdo context +; and inferring the names of these contexts from the name +; of the target executable, unless explicitly specified. + +(context (default + (fdo src/test2.exe) + ; expected name: + ;; (name default-fdo-test2) + )) + +; the following context is expected to cause an error +; because it has the same name as the inferred names of fdo context +(context (default + (name default-fdo-test2) + (fdo src/test2.exe) + )) diff --git a/test/blackbox-tests/test-cases/fdo/dune-workspace.4 b/test/blackbox-tests/test-cases/fdo/dune-workspace.4 new file mode 100644 index 00000000000..0b5a8cb5aa0 --- /dev/null +++ b/test/blackbox-tests/test-cases/fdo/dune-workspace.4 @@ -0,0 +1,7 @@ +(lang dune 1.12) + +(context (default + (fdo src/foo.exe) + (name fdo) + )) + diff --git a/test/blackbox-tests/test-cases/fdo/dune-workspace.5 b/test/blackbox-tests/test-cases/fdo/dune-workspace.5 new file mode 100644 index 00000000000..9b46623d11f --- /dev/null +++ b/test/blackbox-tests/test-cases/fdo/dune-workspace.5 @@ -0,0 +1,7 @@ +(lang dune 1.12) + +(context (default + (fdo src-with-profile/foo.exe) + (name fdo) + )) + diff --git a/test/blackbox-tests/test-cases/fdo/run.t b/test/blackbox-tests/test-cases/fdo/run.t new file mode 100644 index 00000000000..d9d269405b7 --- /dev/null +++ b/test/blackbox-tests/test-cases/fdo/run.t @@ -0,0 +1,102 @@ +Prerequisits: +- external tool ocamlfdo that can be installed from opam +- linux perf (called by ocamlfdo) +- compiler version >= 4.10 (support for function +sections and split compilation at emit). + +A workspace context can be used to build an executable using +feedback-direct optimizations (fdo). The name of the context is +determined from the name of the target executable for fdo and the +default switch name, unless a name field is provided explicitly. +It should work for both default and opam switches, but we don't have +a way to test opam switches. + +This test should build all three contexts: + + $ dune build src/foo.exe --workspace dune-workspace.1 + + $ ./_build/default/src/foo.exe + /_build/default/src/foo.exe: hello from fdo! + + $ ./_build/default-fdo-foo/src/foo.exe + /_build/default-fdo-foo/src/foo.exe: hello from fdo! + + $ ./_build/foofoo/src/foo.exe + /_build/foofoo/src/foo.exe: hello from fdo! + +This is intended to fail + + $ dune build --workspace dune-workspace.2 + File "$TESTCASE_ROOT/dune-workspace.2", line 15, characters 9-66: + 15 | (context (default + 16 | (name default-fdo-test2) + 17 | )) + Error: second definition of build context "default-fdo-test2" + [1] + + $ dune build fdo --workspace dune-workspace.3 + File "$TESTCASE_ROOT/dune-workspace.3", line 15, characters 9-97: + 15 | (context (default + 16 | (name default-fdo-test2) + 17 | (fdo src/test2.exe) + 18 | )) + Error: second definition of build context "default-fdo-test2" + [1] + +Check that OCAMLFDO_USE_PROFILE is handled correctly. + +We cannot check that ocamlfdo built with a profile produces a working +executable. The reason is that profiles cannot be applied when +compiled code changes, for example when compiler versions change. To +detect such changes, profiles contain digests from the original +executable the profile was collected from. + +To check that ocamlfdo command was invoked by dune with or without +profile, as expected, the test profile contains a fake digest that is +guaranteed to fail if ocamlfdo attempts to load the profile. + + $ OCAMLFDO_USE_PROFILE=what-can-go-here dune build src/foo.exe --workspace dune-workspace.4 + Error: Failed to parse environment variable: + OCAMLFDO_USE_PROFILE=what-can-go-here + Permitted values: if-exists always never + Default: if-exists + [1] + $ OCAMLFDO_USE_PROFILE=if-exists dune build src/foo.exe --workspace dune-workspace.4 + + $ OCAMLFDO_USE_PROFILE=if-exists dune build src-with-profile/foo.exe --workspace dune-workspace.5 2>&1 | grep -v 'new crc' + ocamlfdo src-with-profile/.foo.eobjs/native/foo.cmir-linear-fdo [fdo] (exit 65) + (cd _build/fdo/src-with-profile && /usr/local/home/gyorsh/.opam/dunefdo/bin/ocamlfdo opt .foo.eobjs/native/foo.cmir-linear -fdo-profile foo.exe.fdo-profile -md5-unit -reorder-blocks opt -q) + Error: Linear IR for Foo from file .foo.eobjs/native/foo.cmir-linear does not match the version of this IR used for creating the profiled binary. + old crc: aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa + + + $ OCAMLFDO_USE_PROFILE=never dune build src/foo.exe --workspace dune-workspace.4 + + $ OCAMLFDO_USE_PROFILE=never dune build src-with-profile/foo.exe --workspace dune-workspace.5 + Warning: Linker script generation with ocamlfdo cannot get hot function + layout from profile, because either OCAMLFDO_USE_PROFILE=never or + src-with-profile/foo.exe.fdo-profile not found. Hot functions layout from + file src-with-profile/foo.exe.linker-script-hot will be used. + Hint: To ignore src-with-profile/foo.exe.linker-script-hot, rename it. + + $ OCAMLFDO_USE_PROFILE=always dune build src/foo.exe --workspace dune-workspace.4 + Error: Cannot build Foo: OCAMLFDO_USE_PROFILE=always but profile file + src/foo.exe.fdo-profile does not exist. + [1] + + $ OCAMLFDO_USE_PROFILE=always dune build src-with-profile/foo.exe --workspace dune-workspace.5 2>&1 | grep -v 'new crc' + ocamlfdo src-with-profile/.foo.eobjs/native/foo.cmir-linear-fdo [fdo] (exit 65) + (cd _build/fdo/src-with-profile && /usr/local/home/gyorsh/.opam/dunefdo/bin/ocamlfdo opt .foo.eobjs/native/foo.cmir-linear -fdo-profile foo.exe.fdo-profile -md5-unit -reorder-blocks opt -q) + Error: Linear IR for Foo from file .foo.eobjs/native/foo.cmir-linear does not match the version of this IR used for creating the profiled binary. + old crc: aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa + + + +Check OCAMLFDO_FLAGS are passed on to "ocamlfdo opt" + + $ OCAMLFDO_FLAGS="-help" dune build src/foo.exe --workspace dune-workspace.4 2>&1 | head -n 4 + ocamlfdo src/.foo.eobjs/native/foo.cmir-linear-fdo [fdo] + Use a profile to optimize intermediate representation of the program. + + ocamlfdo opt [INPUT ...] + diff --git a/test/blackbox-tests/test-cases/fdo/src-with-profile/dune b/test/blackbox-tests/test-cases/fdo/src-with-profile/dune new file mode 100644 index 00000000000..cbed18a388d --- /dev/null +++ b/test/blackbox-tests/test-cases/fdo/src-with-profile/dune @@ -0,0 +1 @@ +(executable (name foo)) diff --git a/test/blackbox-tests/test-cases/fdo/src-with-profile/foo.exe.fdo-profile b/test/blackbox-tests/test-cases/fdo/src-with-profile/foo.exe.fdo-profile new file mode 100644 index 00000000000..76bfa1ec6bc --- /dev/null +++ b/test/blackbox-tests/test-cases/fdo/src-with-profile/foo.exe.fdo-profile @@ -0,0 +1,130 @@ +((addr2loc + ((-1479002897 ((addr -1479002897) (rel ()) (dbg ()))) + (-1479002288 ((addr -1479002288) (rel ()) (dbg ()))) + (33758480 + ((addr 33758480) (rel (((id 5) (offset 0) (label ())))) (dbg ()))) + (33759360 + ((addr 33759360) (rel (((id 4) (offset 0) (label ())))) (dbg ()))) + (33759386 + ((addr 33759386) (rel (((id 4) (offset 26) (label ())))) (dbg ()))) + (33759393 + ((addr 33759393) (rel (((id 4) (offset 33) (label ())))) (dbg ()))) + (33759433 + ((addr 33759433) (rel (((id 4) (offset 73) (label ())))) (dbg ()))) + (33761582 + ((addr 33761582) (rel (((id 1) (offset 110) (label ())))) (dbg ()))) + (33761600 + ((addr 33761600) (rel (((id 1) (offset 128) (label ())))) (dbg ()))) + (33761631 + ((addr 33761631) (rel (((id 1) (offset 159) (label ())))) (dbg ()))) + (33761726 + ((addr 33761726) (rel (((id 1) (offset 254) (label ())))) (dbg ()))) + (33761731 + ((addr 33761731) (rel (((id 1) (offset 259) (label ())))) (dbg ()))) + (33761736 + ((addr 33761736) (rel (((id 1) (offset 264) (label ())))) (dbg ()))) + (33761741 + ((addr 33761741) (rel (((id 1) (offset 269) (label ())))) (dbg ()))) + (33761746 + ((addr 33761746) (rel (((id 1) (offset 274) (label ())))) (dbg ()))) + (33761751 + ((addr 33761751) (rel (((id 1) (offset 279) (label ())))) (dbg ()))) + (33761759 + ((addr 33761759) (rel (((id 1) (offset 287) (label ())))) (dbg ()))) + (33764112 + ((addr 33764112) (rel (((id 2) (offset 0) (label ())))) (dbg ()))) + (33764210 + ((addr 33764210) (rel (((id 2) (offset 98) (label ())))) (dbg ()))) + (33764275 + ((addr 33764275) (rel (((id 2) (offset 163) (label ())))) (dbg ()))) + (33764305 + ((addr 33764305) (rel (((id 2) (offset 193) (label ())))) (dbg ()))) + (33764680 + ((addr 33764680) (rel (((id 0) (offset 40) (label ())))) (dbg ()))) + (33764690 + ((addr 33764690) (rel (((id 0) (offset 50) (label ())))) (dbg ()))) + (33764700 + ((addr 33764700) (rel (((id 0) (offset 60) (label ())))) (dbg ()))) + (33764705 + ((addr 33764705) (rel (((id 0) (offset 65) (label ())))) (dbg ()))) + (33764707 + ((addr 33764707) (rel (((id 0) (offset 67) (label ())))) (dbg ()))) + (33764720 + ((addr 33764720) (rel (((id 0) (offset 80) (label ())))) (dbg ()))) + (33764726 + ((addr 33764726) (rel (((id 0) (offset 86) (label ())))) (dbg ()))) + (33812615 + ((addr 33812615) (rel (((id 3) (offset 135) (label ())))) (dbg ()))) + (33812661 + ((addr 33812661) (rel (((id 3) (offset 181) (label ())))) (dbg ()))))) + (name2id + ((caml_init_gc 3) (caml_init_major_heap 5) (caml_page_table_add 0) + (caml_page_table_modify 2) (caml_set_minor_heap_size 1) (reset_table 4))) + (functions + ((0 + ((id 0) (name caml_page_table_add) (start 33764640) (finish 33764727) + (count 15) (has_linearids false) (malformed_traces 0) + (agg + ((instructions ()) + (branches + (((33764305 33764705) 4) ((33764690 33764720) 1) + ((33764700 33764112) 4) ((33764707 33764680) 5) + ((33764726 33761582) 1))) + (mispredicts (((33764690 33764720) 1))) + (traces + (((33764680 33764690) 1) ((33764680 33764700) 4) + ((33764705 33764707) 4) ((33764720 33764726) 1))))))) + (1 + ((id 1) (name caml_set_minor_heap_size) (start 33761472) + (finish 33761765) (count 9) (has_linearids false) (malformed_traces 0) + (agg + ((instructions ()) + (branches + (((33759433 33761731) 1) ((33759433 33761741) 1) + ((33759433 33761751) 1) ((33761600 33761631) 1) + ((33761726 33759360) 1) ((33761736 33759360) 1) + ((33761746 33759360) 1) ((33761759 33812615) 1) + ((33764726 33761582) 1))) + (mispredicts (((33761600 33761631) 1) ((33761759 33812615) 1))) + (traces + (((33761582 33761600) 1) ((33761631 33761726) 1) + ((33761731 33761736) 1) ((33761741 33761746) 1) + ((33761751 33761759) 1))))))) + (2 + ((id 2) (name caml_page_table_modify) (start 33764112) (finish 33764630) + (count 12) (has_linearids false) (malformed_traces 0) + (agg + ((instructions ()) + (branches + (((33764210 33764275) 4) ((33764305 33764705) 4) + ((33764700 33764112) 4))) + (mispredicts ()) + (traces (((33764112 33764210) 4) ((33764275 33764305) 4))))))) + (3 + ((id 3) (name caml_init_gc) (start 33812480) (finish 33813023) (count 2) + (has_linearids false) (malformed_traces 0) + (agg + ((instructions ()) + (branches (((33761759 33812615) 1) ((33812661 33758480) 1))) + (mispredicts (((33761759 33812615) 1))) + (traces (((33812615 33812661) 1))))))) + (4 + ((id 4) (name reset_table) (start 33759360) (finish 33759434) (count 9) + (has_linearids false) (malformed_traces 0) + (agg + ((instructions ()) + (branches + (((33759386 33759393) 3) ((33759433 33761731) 1) + ((33759433 33761741) 1) ((33759433 33761751) 1) + ((33761726 33759360) 1) ((33761736 33759360) 1) + ((33761746 33759360) 1))) + (mispredicts (((33759386 33759393) 2))) + (traces (((33759360 33759386) 3) ((33759393 33759433) 3))))))) + (5 + ((id 5) (name caml_init_major_heap) (start 33758480) (finish 33758887) + (count 2) (has_linearids false) (malformed_traces 0) + (agg + ((instructions ()) + (branches (((-1479002897 33758480) 1) ((33812661 33758480) 1))) + (mispredicts ()) (traces ()))))))) + (execounts ()) (crcs ((Foo aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa)))) diff --git a/test/blackbox-tests/test-cases/fdo/src-with-profile/foo.exe.linker-script-hot b/test/blackbox-tests/test-cases/fdo/src-with-profile/foo.exe.linker-script-hot new file mode 100644 index 00000000000..b7d451178bf --- /dev/null +++ b/test/blackbox-tests/test-cases/fdo/src-with-profile/foo.exe.linker-script-hot @@ -0,0 +1,6 @@ +*(.text.caml_page_table_add) +*(.text.caml_page_table_modify) +*(.text.caml_set_minor_heap_size) +*(.text.reset_table) +*(.text.caml_init_gc) +*(.text.caml_init_major_heap) diff --git a/test/blackbox-tests/test-cases/fdo/src-with-profile/foo.ml b/test/blackbox-tests/test-cases/fdo/src-with-profile/foo.ml new file mode 100644 index 00000000000..43c5ebe9904 --- /dev/null +++ b/test/blackbox-tests/test-cases/fdo/src-with-profile/foo.ml @@ -0,0 +1,17 @@ +print_string "" +;; + +let sep = Filename.dir_sep in +assert ((String.length sep) = 1); +let l = Sys.executable_name + |> String.split_on_char sep.[0] in +(* print the last 4 elements if exist *) +let len = (List.length l) in +List.iteri + (fun i dir -> + if ((len - i) < 5) then Printf.printf "/%s" dir) + l +;; + +print_endline ": hello from fdo!" +;; diff --git a/test/blackbox-tests/test-cases/fdo/src/dune b/test/blackbox-tests/test-cases/fdo/src/dune new file mode 100644 index 00000000000..cbed18a388d --- /dev/null +++ b/test/blackbox-tests/test-cases/fdo/src/dune @@ -0,0 +1 @@ +(executable (name foo)) diff --git a/test/blackbox-tests/test-cases/fdo/src/foo.ml b/test/blackbox-tests/test-cases/fdo/src/foo.ml new file mode 100644 index 00000000000..43c5ebe9904 --- /dev/null +++ b/test/blackbox-tests/test-cases/fdo/src/foo.ml @@ -0,0 +1,17 @@ +print_string "" +;; + +let sep = Filename.dir_sep in +assert ((String.length sep) = 1); +let l = Sys.executable_name + |> String.split_on_char sep.[0] in +(* print the last 4 elements if exist *) +let len = (List.length l) in +List.iteri + (fun i dir -> + if ((len - i) < 5) then Printf.printf "/%s" dir) + l +;; + +print_endline ": hello from fdo!" +;; diff --git a/test/blackbox-tests/test-cases/workspaces/run.t b/test/blackbox-tests/test-cases/workspaces/run.t index 3e2f4e979b0..6cc230f44d2 100644 --- a/test/blackbox-tests/test-cases/workspaces/run.t +++ b/test/blackbox-tests/test-cases/workspaces/run.t @@ -24,7 +24,7 @@ Workspaces let you set custom profiles Entering directory 'custom-profile' build profile: foobar -A workspace context can ve defined using an opam switch. This test is disabled +A workspace context can be defined using an opam switch. This test is disabled because we don't really have a way to mock an opam switch. # $ dune build --root opam --display quiet 2>&1 From fcc80f124269dc05098728c5d8aa9e5891386f5c Mon Sep 17 00:00:00 2001 From: Greta Yorsh Date: Tue, 15 Oct 2019 14:23:09 +0100 Subject: [PATCH 08/14] Add flag -ffunction-sections to c/c++ compiler with fdo Signed-off-by: Greta Yorsh --- src/dune/fdo.ml | 11 +++++++++++ src/dune/fdo.mli | 4 ++++ src/dune/foreign_rules.ml | 2 ++ 3 files changed, 17 insertions(+) diff --git a/src/dune/fdo.ml b/src/dune/fdo.ml index 48f97dc1ebb..760dd1eeb17 100644 --- a/src/dune/fdo.ml +++ b/src/dune/fdo.ml @@ -23,6 +23,17 @@ let phase_flags = function [ "-g"; "-stop-after"; "scheduling"; "-save-ir-after"; "scheduling" ] | Some Emit -> [ "-g"; "-start-from"; "emit"; "-function-sections" ] +(* CR-soon gyorsh: add a rule to use profile with c/cxx profile if available, + similarly to opt_rule for ocaml modules. The profile will have to be + generated externally from perf data for example using google's autofdo + toolset: create_gcov for gcc or create_llvm_prof for llvm. *) +let c_flags (ctx : Context.t) = + match ctx.fdo_target_exe with + | None -> [] + | Some _ -> [ "-ffunction-sections" ] + +let cxx_flags = c_flags + (* Location of ocamlfdo binary tool is independent of the module, but may depend on the context. If it isn't cached elsewhere, we should do it here. CR gyorsh: is it cached? *) diff --git a/src/dune/fdo.mli b/src/dune/fdo.mli index 87fc8418ebe..489f4cb84cc 100644 --- a/src/dune/fdo.mli +++ b/src/dune/fdo.mli @@ -11,6 +11,10 @@ val linear_fdo_ext : string val phase_flags : phase option -> string list +val c_flags : Context.t -> string list + +val cxx_flags : Context.t -> string list + val opt_rule : Compilation_context.t -> Module.t -> string -> unit module Linker_script : sig diff --git a/src/dune/foreign_rules.ml b/src/dune/foreign_rules.ml index f346291f580..c63ed29ede2 100644 --- a/src/dune/foreign_rules.ml +++ b/src/dune/foreign_rules.ml @@ -56,6 +56,7 @@ let build_c_file ~sctx ~dir ~expander ~include_flags (loc, src, dst) = Super_context.foreign_flags sctx ~dir ~expander ~flags ~language:Foreign.Language.C in + let c_flags = Build.map c_flags ~f:(List.append (Fdo.c_flags ctx)) in Super_context.add_rule sctx ~loc ~dir (* With sandboxing we get errors like: bar.c:2:19: fatal error: foo.cxx: @@ -88,6 +89,7 @@ let build_cxx_file ~sctx ~dir ~expander ~include_flags (loc, src, dst) = Super_context.foreign_flags sctx ~dir ~expander ~flags ~language:Foreign.Language.Cxx in + let cxx_flags = Build.map cxx_flags ~f:(List.append (Fdo.cxx_flags ctx)) in Super_context.add_rule sctx ~loc ~dir (* this seems to work with sandboxing, but for symmetry with From 00ab46e563ad2a4c2fa48199b7667d5ee6c58283 Mon Sep 17 00:00:00 2001 From: Greta Yorsh Date: Wed, 23 Oct 2019 12:01:16 +0100 Subject: [PATCH 09/14] Raise only if ocamlfdo is used but not found Signed-off-by: Greta Yorsh --- src/dune/fdo.ml | 33 +++------------------------------ 1 file changed, 3 insertions(+), 30 deletions(-) diff --git a/src/dune/fdo.ml b/src/dune/fdo.ml index 760dd1eeb17..e07580b4f8a 100644 --- a/src/dune/fdo.ml +++ b/src/dune/fdo.ml @@ -38,13 +38,8 @@ let cxx_flags = c_flags depend on the context. If it isn't cached elsewhere, we should do it here. CR gyorsh: is it cached? *) let ocamlfdo_binary sctx dir = - let ocamlfdo = - Super_context.resolve_program sctx ~dir ~loc:None "ocamlfdo" - ~hint:"try: opam install ocamlfdo" - in - match ocamlfdo with - | Error e -> Action.Prog.Not_found.raise e - | Ok _ -> ocamlfdo + Super_context.resolve_program sctx ~dir ~loc:None "ocamlfdo" + ~hint:"try: opam install ocamlfdo" (* CR gyorsh: this should also be cached *) let fdo_use_profile (ctx : Context.t) name fdo_profile = @@ -117,32 +112,12 @@ module Linker_script = struct let sctx = CC.super_context cctx in let ctx = CC.context cctx in let dir = CC.dir cctx in - let ocamlfdo = ocamlfdo_binary sctx dir in let linker_script_hot = linker_script_hot_filename fdo_target_exe in let fdo_profile = fdo_profile_filename fdo_target_exe in let linker_script = linker_script_filename fdo_target_exe in let linker_script_path = Path.Build.(relative ctx.build_dir linker_script) in - let linker_script_template = - match ocamlfdo with - | Error _ -> assert false - | Ok ocamlfdo_path -> - let ocamlfdo_dir = - ocamlfdo_path |> Path.to_absolute_filename |> Filename.dirname - in - ocamlfdo_dir ^ "/../etc/ocamlfdo/linker-script" - in - (* CR gyorsh: is there a gracefull way to check it? *) - if not (Sys.file_exists linker_script_template) then - User_error.raise - [ Pp.textf - "Cannot find template linker script for %s: %s does not exist." - linker_script_template fdo_target_exe - ]; - let linker_script_template_path = - Path.of_filename_relative_to_initial_cwd linker_script_template - in let extra_flags = Env.get ctx.env "OCAMLFDO_LINKER_SCRIPT_FLAGS" |> Option.value ~default:"" |> String.extract_blank_separated_words @@ -175,10 +150,8 @@ module Linker_script = struct As [] in Super_context.add_rule sctx ~dir - (Command.run ~dir:(Path.build ctx.build_dir) ocamlfdo + (Command.run ~dir:(Path.build ctx.build_dir) (ocamlfdo_binary sctx dir) [ A "linker-script" - ; A "-linker-script-template" - ; Dep linker_script_template_path ; A "-o" ; Target linker_script_path ; flags From a98382a04115dc0b38483b53c72b17bef19e50a2 Mon Sep 17 00:00:00 2001 From: Greta Yorsh Date: Wed, 23 Oct 2019 12:01:57 +0100 Subject: [PATCH 10/14] Remove unnecessary comment and fix formatting Signed-off-by: Greta Yorsh --- src/dune/fdo.ml | 1 - src/dune/workspace.ml | 2 +- 2 files changed, 1 insertion(+), 2 deletions(-) diff --git a/src/dune/fdo.ml b/src/dune/fdo.ml index e07580b4f8a..001bc95e8e2 100644 --- a/src/dune/fdo.ml +++ b/src/dune/fdo.ml @@ -41,7 +41,6 @@ let ocamlfdo_binary sctx dir = Super_context.resolve_program sctx ~dir ~loc:None "ocamlfdo" ~hint:"try: opam install ocamlfdo" -(* CR gyorsh: this should also be cached *) let fdo_use_profile (ctx : Context.t) name fdo_profile = let fdo_profile_src = Path.Source.(relative root fdo_profile) in let profile_exists = File_tree.file_exists fdo_profile_src in diff --git a/src/dune/workspace.ml b/src/dune/workspace.ml index bcac2042552..3a95dbeaf77 100644 --- a/src/dune/workspace.ml +++ b/src/dune/workspace.ml @@ -98,7 +98,7 @@ module Context = struct [ Pp.textf "`fdo %s` expects executable filename ending with .exe \ extension, not %s. \n\ - Please specify the name of the executable to optimize,\ + Please specify the name of the executable to optimize, \ including path from ." file ext ] ); From 2ee55316fae23336655544ecbdbf757374915895 Mon Sep 17 00:00:00 2001 From: Greta Yorsh Date: Wed, 23 Oct 2019 15:40:32 +0100 Subject: [PATCH 11/14] Prefix dune__exe in test and short paths in test output Signed-off-by: Greta Yorsh --- test/blackbox-tests/test-cases/fdo/run.t | 18 +-- .../fdo/src-with-profile/foo.exe.fdo-profile | 134 +----------------- .../foo.exe.linker-script-hot | 7 +- 3 files changed, 10 insertions(+), 149 deletions(-) diff --git a/test/blackbox-tests/test-cases/fdo/run.t b/test/blackbox-tests/test-cases/fdo/run.t index d9d269405b7..3b218e1d1dd 100644 --- a/test/blackbox-tests/test-cases/fdo/run.t +++ b/test/blackbox-tests/test-cases/fdo/run.t @@ -63,12 +63,8 @@ guaranteed to fail if ocamlfdo attempts to load the profile. [1] $ OCAMLFDO_USE_PROFILE=if-exists dune build src/foo.exe --workspace dune-workspace.4 - $ OCAMLFDO_USE_PROFILE=if-exists dune build src-with-profile/foo.exe --workspace dune-workspace.5 2>&1 | grep -v 'new crc' - ocamlfdo src-with-profile/.foo.eobjs/native/foo.cmir-linear-fdo [fdo] (exit 65) - (cd _build/fdo/src-with-profile && /usr/local/home/gyorsh/.opam/dunefdo/bin/ocamlfdo opt .foo.eobjs/native/foo.cmir-linear -fdo-profile foo.exe.fdo-profile -md5-unit -reorder-blocks opt -q) - Error: Linear IR for Foo from file .foo.eobjs/native/foo.cmir-linear does not match the version of this IR used for creating the profiled binary. - old crc: aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa - + $ OCAMLFDO_USE_PROFILE=if-exists dune build src-with-profile/foo.exe --workspace dune-workspace.5 2>&1 | grep 'Error: ' + Error: Linear IR for Dune__exe__Foo from file .foo.eobjs/native/dune__exe__Foo.cmir-linear does not match the version of this IR used for creating the profiled binary. $ OCAMLFDO_USE_PROFILE=never dune build src/foo.exe --workspace dune-workspace.4 @@ -84,18 +80,14 @@ guaranteed to fail if ocamlfdo attempts to load the profile. src/foo.exe.fdo-profile does not exist. [1] - $ OCAMLFDO_USE_PROFILE=always dune build src-with-profile/foo.exe --workspace dune-workspace.5 2>&1 | grep -v 'new crc' - ocamlfdo src-with-profile/.foo.eobjs/native/foo.cmir-linear-fdo [fdo] (exit 65) - (cd _build/fdo/src-with-profile && /usr/local/home/gyorsh/.opam/dunefdo/bin/ocamlfdo opt .foo.eobjs/native/foo.cmir-linear -fdo-profile foo.exe.fdo-profile -md5-unit -reorder-blocks opt -q) - Error: Linear IR for Foo from file .foo.eobjs/native/foo.cmir-linear does not match the version of this IR used for creating the profiled binary. - old crc: aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa - + $ OCAMLFDO_USE_PROFILE=always dune build src-with-profile/foo.exe --workspace dune-workspace.5 2>&1 | grep 'Error: ' + Error: Linear IR for Dune__exe__Foo from file .foo.eobjs/native/dune__exe__Foo.cmir-linear does not match the version of this IR used for creating the profiled binary. Check OCAMLFDO_FLAGS are passed on to "ocamlfdo opt" $ OCAMLFDO_FLAGS="-help" dune build src/foo.exe --workspace dune-workspace.4 2>&1 | head -n 4 - ocamlfdo src/.foo.eobjs/native/foo.cmir-linear-fdo [fdo] + ocamlfdo src/.foo.eobjs/native/dune__exe__Foo.cmir-linear-fdo [fdo] Use a profile to optimize intermediate representation of the program. ocamlfdo opt [INPUT ...] diff --git a/test/blackbox-tests/test-cases/fdo/src-with-profile/foo.exe.fdo-profile b/test/blackbox-tests/test-cases/fdo/src-with-profile/foo.exe.fdo-profile index 76bfa1ec6bc..df82536b0b6 100644 --- a/test/blackbox-tests/test-cases/fdo/src-with-profile/foo.exe.fdo-profile +++ b/test/blackbox-tests/test-cases/fdo/src-with-profile/foo.exe.fdo-profile @@ -1,130 +1,4 @@ -((addr2loc - ((-1479002897 ((addr -1479002897) (rel ()) (dbg ()))) - (-1479002288 ((addr -1479002288) (rel ()) (dbg ()))) - (33758480 - ((addr 33758480) (rel (((id 5) (offset 0) (label ())))) (dbg ()))) - (33759360 - ((addr 33759360) (rel (((id 4) (offset 0) (label ())))) (dbg ()))) - (33759386 - ((addr 33759386) (rel (((id 4) (offset 26) (label ())))) (dbg ()))) - (33759393 - ((addr 33759393) (rel (((id 4) (offset 33) (label ())))) (dbg ()))) - (33759433 - ((addr 33759433) (rel (((id 4) (offset 73) (label ())))) (dbg ()))) - (33761582 - ((addr 33761582) (rel (((id 1) (offset 110) (label ())))) (dbg ()))) - (33761600 - ((addr 33761600) (rel (((id 1) (offset 128) (label ())))) (dbg ()))) - (33761631 - ((addr 33761631) (rel (((id 1) (offset 159) (label ())))) (dbg ()))) - (33761726 - ((addr 33761726) (rel (((id 1) (offset 254) (label ())))) (dbg ()))) - (33761731 - ((addr 33761731) (rel (((id 1) (offset 259) (label ())))) (dbg ()))) - (33761736 - ((addr 33761736) (rel (((id 1) (offset 264) (label ())))) (dbg ()))) - (33761741 - ((addr 33761741) (rel (((id 1) (offset 269) (label ())))) (dbg ()))) - (33761746 - ((addr 33761746) (rel (((id 1) (offset 274) (label ())))) (dbg ()))) - (33761751 - ((addr 33761751) (rel (((id 1) (offset 279) (label ())))) (dbg ()))) - (33761759 - ((addr 33761759) (rel (((id 1) (offset 287) (label ())))) (dbg ()))) - (33764112 - ((addr 33764112) (rel (((id 2) (offset 0) (label ())))) (dbg ()))) - (33764210 - ((addr 33764210) (rel (((id 2) (offset 98) (label ())))) (dbg ()))) - (33764275 - ((addr 33764275) (rel (((id 2) (offset 163) (label ())))) (dbg ()))) - (33764305 - ((addr 33764305) (rel (((id 2) (offset 193) (label ())))) (dbg ()))) - (33764680 - ((addr 33764680) (rel (((id 0) (offset 40) (label ())))) (dbg ()))) - (33764690 - ((addr 33764690) (rel (((id 0) (offset 50) (label ())))) (dbg ()))) - (33764700 - ((addr 33764700) (rel (((id 0) (offset 60) (label ())))) (dbg ()))) - (33764705 - ((addr 33764705) (rel (((id 0) (offset 65) (label ())))) (dbg ()))) - (33764707 - ((addr 33764707) (rel (((id 0) (offset 67) (label ())))) (dbg ()))) - (33764720 - ((addr 33764720) (rel (((id 0) (offset 80) (label ())))) (dbg ()))) - (33764726 - ((addr 33764726) (rel (((id 0) (offset 86) (label ())))) (dbg ()))) - (33812615 - ((addr 33812615) (rel (((id 3) (offset 135) (label ())))) (dbg ()))) - (33812661 - ((addr 33812661) (rel (((id 3) (offset 181) (label ())))) (dbg ()))))) - (name2id - ((caml_init_gc 3) (caml_init_major_heap 5) (caml_page_table_add 0) - (caml_page_table_modify 2) (caml_set_minor_heap_size 1) (reset_table 4))) - (functions - ((0 - ((id 0) (name caml_page_table_add) (start 33764640) (finish 33764727) - (count 15) (has_linearids false) (malformed_traces 0) - (agg - ((instructions ()) - (branches - (((33764305 33764705) 4) ((33764690 33764720) 1) - ((33764700 33764112) 4) ((33764707 33764680) 5) - ((33764726 33761582) 1))) - (mispredicts (((33764690 33764720) 1))) - (traces - (((33764680 33764690) 1) ((33764680 33764700) 4) - ((33764705 33764707) 4) ((33764720 33764726) 1))))))) - (1 - ((id 1) (name caml_set_minor_heap_size) (start 33761472) - (finish 33761765) (count 9) (has_linearids false) (malformed_traces 0) - (agg - ((instructions ()) - (branches - (((33759433 33761731) 1) ((33759433 33761741) 1) - ((33759433 33761751) 1) ((33761600 33761631) 1) - ((33761726 33759360) 1) ((33761736 33759360) 1) - ((33761746 33759360) 1) ((33761759 33812615) 1) - ((33764726 33761582) 1))) - (mispredicts (((33761600 33761631) 1) ((33761759 33812615) 1))) - (traces - (((33761582 33761600) 1) ((33761631 33761726) 1) - ((33761731 33761736) 1) ((33761741 33761746) 1) - ((33761751 33761759) 1))))))) - (2 - ((id 2) (name caml_page_table_modify) (start 33764112) (finish 33764630) - (count 12) (has_linearids false) (malformed_traces 0) - (agg - ((instructions ()) - (branches - (((33764210 33764275) 4) ((33764305 33764705) 4) - ((33764700 33764112) 4))) - (mispredicts ()) - (traces (((33764112 33764210) 4) ((33764275 33764305) 4))))))) - (3 - ((id 3) (name caml_init_gc) (start 33812480) (finish 33813023) (count 2) - (has_linearids false) (malformed_traces 0) - (agg - ((instructions ()) - (branches (((33761759 33812615) 1) ((33812661 33758480) 1))) - (mispredicts (((33761759 33812615) 1))) - (traces (((33812615 33812661) 1))))))) - (4 - ((id 4) (name reset_table) (start 33759360) (finish 33759434) (count 9) - (has_linearids false) (malformed_traces 0) - (agg - ((instructions ()) - (branches - (((33759386 33759393) 3) ((33759433 33761731) 1) - ((33759433 33761741) 1) ((33759433 33761751) 1) - ((33761726 33759360) 1) ((33761736 33759360) 1) - ((33761746 33759360) 1))) - (mispredicts (((33759386 33759393) 2))) - (traces (((33759360 33759386) 3) ((33759393 33759433) 3))))))) - (5 - ((id 5) (name caml_init_major_heap) (start 33758480) (finish 33758887) - (count 2) (has_linearids false) (malformed_traces 0) - (agg - ((instructions ()) - (branches (((-1479002897 33758480) 1) ((33812661 33758480) 1))) - (mispredicts ()) (traces ()))))))) - (execounts ()) (crcs ((Foo aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa)))) +((addr2loc ()) + (name2id ()) + (functions ()) + (execounts ()) (crcs ((Dune__exe__Foo aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa)))) diff --git a/test/blackbox-tests/test-cases/fdo/src-with-profile/foo.exe.linker-script-hot b/test/blackbox-tests/test-cases/fdo/src-with-profile/foo.exe.linker-script-hot index b7d451178bf..8b137891791 100644 --- a/test/blackbox-tests/test-cases/fdo/src-with-profile/foo.exe.linker-script-hot +++ b/test/blackbox-tests/test-cases/fdo/src-with-profile/foo.exe.linker-script-hot @@ -1,6 +1 @@ -*(.text.caml_page_table_add) -*(.text.caml_page_table_modify) -*(.text.caml_set_minor_heap_size) -*(.text.reset_table) -*(.text.caml_init_gc) -*(.text.caml_init_major_heap) + From 8e09253eb00f3915b41297e7d24cf2c90e190eac Mon Sep 17 00:00:00 2001 From: Greta Yorsh Date: Wed, 23 Oct 2019 12:02:30 +0100 Subject: [PATCH 12/14] Update syntax version for fdo Signed-off-by: Greta Yorsh --- src/dune/workspace.ml | 2 +- test/blackbox-tests/test-cases/fdo/dune-project | 2 +- test/blackbox-tests/test-cases/fdo/dune-workspace.1 | 2 +- test/blackbox-tests/test-cases/fdo/dune-workspace.2 | 2 +- test/blackbox-tests/test-cases/fdo/dune-workspace.3 | 2 +- test/blackbox-tests/test-cases/fdo/dune-workspace.4 | 2 +- test/blackbox-tests/test-cases/fdo/dune-workspace.5 | 2 +- 7 files changed, 7 insertions(+), 7 deletions(-) diff --git a/src/dune/workspace.ml b/src/dune/workspace.ml index 3a95dbeaf77..25652e4dec5 100644 --- a/src/dune/workspace.ml +++ b/src/dune/workspace.ml @@ -62,7 +62,7 @@ module Context = struct field_o "toolchain" (Dune_lang.Syntax.since syntax (1, 5) >>> Context_name.decode) and+ fdo_target_exe = - field_o "fdo" (Dune_lang.Syntax.since syntax (1, 12) >>> string) + field_o "fdo" (Dune_lang.Syntax.since syntax (2, 0) >>> string) and+ paths = let f l = match diff --git a/test/blackbox-tests/test-cases/fdo/dune-project b/test/blackbox-tests/test-cases/fdo/dune-project index 1c29073dfff..929c696e561 100644 --- a/test/blackbox-tests/test-cases/fdo/dune-project +++ b/test/blackbox-tests/test-cases/fdo/dune-project @@ -1 +1 @@ -(lang dune 1.12) +(lang dune 2.0) diff --git a/test/blackbox-tests/test-cases/fdo/dune-workspace.1 b/test/blackbox-tests/test-cases/fdo/dune-workspace.1 index 4c02e39465f..cb8049cc361 100644 --- a/test/blackbox-tests/test-cases/fdo/dune-workspace.1 +++ b/test/blackbox-tests/test-cases/fdo/dune-workspace.1 @@ -1,4 +1,4 @@ -(lang dune 1.12) +(lang dune 2.0) ; this is a test for various ways of specifying an fdo context ; and inferring the names of these contexts from the name diff --git a/test/blackbox-tests/test-cases/fdo/dune-workspace.2 b/test/blackbox-tests/test-cases/fdo/dune-workspace.2 index d2ba396ad9d..66150a27e92 100644 --- a/test/blackbox-tests/test-cases/fdo/dune-workspace.2 +++ b/test/blackbox-tests/test-cases/fdo/dune-workspace.2 @@ -1,4 +1,4 @@ -(lang dune 1.12) +(lang dune 2.0) ; this is a test for various ways of specifying an fdo context ; and inferring the names of these contexts from the name diff --git a/test/blackbox-tests/test-cases/fdo/dune-workspace.3 b/test/blackbox-tests/test-cases/fdo/dune-workspace.3 index 81713878452..14cb1e42a4f 100644 --- a/test/blackbox-tests/test-cases/fdo/dune-workspace.3 +++ b/test/blackbox-tests/test-cases/fdo/dune-workspace.3 @@ -1,4 +1,4 @@ -(lang dune 1.12) +(lang dune 2.0) ; this is a test for various ways of specifying an fdo context ; and inferring the names of these contexts from the name diff --git a/test/blackbox-tests/test-cases/fdo/dune-workspace.4 b/test/blackbox-tests/test-cases/fdo/dune-workspace.4 index 0b5a8cb5aa0..61f0765e78e 100644 --- a/test/blackbox-tests/test-cases/fdo/dune-workspace.4 +++ b/test/blackbox-tests/test-cases/fdo/dune-workspace.4 @@ -1,4 +1,4 @@ -(lang dune 1.12) +(lang dune 2.0) (context (default (fdo src/foo.exe) diff --git a/test/blackbox-tests/test-cases/fdo/dune-workspace.5 b/test/blackbox-tests/test-cases/fdo/dune-workspace.5 index 9b46623d11f..cbfe1ffe70a 100644 --- a/test/blackbox-tests/test-cases/fdo/dune-workspace.5 +++ b/test/blackbox-tests/test-cases/fdo/dune-workspace.5 @@ -1,4 +1,4 @@ -(lang dune 1.12) +(lang dune 2.0) (context (default (fdo src-with-profile/foo.exe) From ef20b96ae4d45382ab4e36e92a06fd827caf3ecd Mon Sep 17 00:00:00 2001 From: Greta Yorsh Date: Wed, 23 Oct 2019 19:13:36 +0100 Subject: [PATCH 13/14] Address review comments - Workspace: type of fdo_target_exe is Path.t instead of string. - Fdo.Mode to read and parse OCAMLFDO_USE_PROFILE env variable from context. - File_tree.file_exists is lazy, and forced only when needed, depending on Fdo.Mode. - Fdo.use_profile is computed dynamically (when opt_rule executes, not when it is constructed). - The result of Fdo.use_profile is now memoized based on context, to speed up module compilation under fdo. - Simplify linker_script_rule: remove linker_script_hot, which is not is intended for experiments and can specified via OCAMLFDO_LINKER_SCRIPT_FLAGS variable. - Fix tests. Signed-off-by: Greta Yorsh --- src/dune/context.ml | 4 +- src/dune/context.mli | 2 +- src/dune/exe.ml | 6 +- src/dune/fdo.ml | 194 +++++++++++++---------- src/dune/fdo.mli | 5 +- src/dune/module_compilation.ml | 4 +- src/dune/workspace.ml | 35 ++-- src/dune/workspace.mli | 2 +- test/blackbox-tests/test-cases/fdo/run.t | 9 +- 9 files changed, 140 insertions(+), 121 deletions(-) diff --git a/src/dune/context.ml b/src/dune/context.ml index 4321cb7e3b6..44550e76c6e 100644 --- a/src/dune/context.ml +++ b/src/dune/context.ml @@ -40,7 +40,7 @@ type t = ; kind : Kind.t ; profile : Profile.t ; merlin : bool - ; fdo_target_exe : string option + ; fdo_target_exe : Path.t option ; for_host : t option ; implicit : bool ; build_dir : Path.Build.t @@ -110,7 +110,7 @@ let to_dyn t : Dyn.t = ; ( "for_host" , option Context_name.to_dyn (Option.map t.for_host ~f:(fun t -> t.name)) ) - ; ("fdo_target_exe", option string t.fdo_target_exe) + ; ("fdo_target_exe", option path t.fdo_target_exe) ; ("build_dir", Path.Build.to_dyn t.build_dir) ; ("toplevel_path", option path t.toplevel_path) ; ("ocaml_bin", path t.ocaml_bin) diff --git a/src/dune/context.mli b/src/dune/context.mli index ea823df53fb..7346e5df5cd 100644 --- a/src/dune/context.mli +++ b/src/dune/context.mli @@ -50,7 +50,7 @@ type t = ; merlin : bool (** [Some path/to/foo.exe] if this contexts is for feedback-directed optimization of target path/to/foo.exe *) - ; fdo_target_exe : string option + ; fdo_target_exe : Path.t option (** If this context is a cross-compilation context, you need another context for building tools used for the compilation that run on the host. *) diff --git a/src/dune/exe.ml b/src/dune/exe.ml index ff53e506289..3af5852b1a0 100644 --- a/src/dune/exe.ml +++ b/src/dune/exe.ml @@ -128,11 +128,7 @@ let link_exe ~loc ~name ~(linkage : Linkage.t) ~cm_files ~link_time_code_gen let exe = exe_path_from_name cctx ~name ~linkage in let compiler = Option.value_exn (Context.compiler ctx mode) in let top_sorted_cms = Cm_files.top_sorted_cms cm_files ~mode:linkage.mode in - let target_exe = - let open Path in - exe |> build |> drop_build_context_exn |> Source.to_string - in - let fdo_linker_script = Fdo.Linker_script.create cctx target_exe in + let fdo_linker_script = Fdo.Linker_script.create cctx (Path.build exe) in SC.add_rule sctx ~loc ~dir ~mode: ( match promote with diff --git a/src/dune/fdo.ml b/src/dune/fdo.ml index 001bc95e8e2..897f338422c 100644 --- a/src/dune/fdo.ml +++ b/src/dune/fdo.ml @@ -10,11 +10,9 @@ let linear_ext = ".cmir-linear" let linear_fdo_ext = linear_ext ^ "-fdo" -let fdo_profile_filename s = s ^ ".fdo-profile" +let fdo_profile s = Path.extend_basename s ~suffix:".fdo-profile" -let linker_script_filename s = s ^ ".linker-script" - -let linker_script_hot_filename s = s ^ ".linker-script-hot" +let linker_script s = Path.extend_basename s ~suffix:".linker-script" let phase_flags = function | None -> [] @@ -35,40 +33,100 @@ let c_flags (ctx : Context.t) = let cxx_flags = c_flags (* Location of ocamlfdo binary tool is independent of the module, but may - depend on the context. If it isn't cached elsewhere, we should do it here. - CR gyorsh: is it cached? *) + depend on the context. *) let ocamlfdo_binary sctx dir = Super_context.resolve_program sctx ~dir ~loc:None "ocamlfdo" ~hint:"try: opam install ocamlfdo" -let fdo_use_profile (ctx : Context.t) name fdo_profile = - let fdo_profile_src = Path.Source.(relative root fdo_profile) in - let profile_exists = File_tree.file_exists fdo_profile_src in - match Env.get ctx.env "OCAMLFDO_USE_PROFILE" with - | None - | Some "if-exists" -> - profile_exists - | Some "always" -> - if profile_exists then - true +(* FDO flags are context dependent. *) +let get_flags var = + let f (ctx : Context.t) = + Env.get ctx.env var |> Option.value ~default:"" + |> String.extract_blank_separated_words + in + let memo = + Memo.create_hidden var + ~doc:(sprintf "parse %s environment variable in context" var) + ~input:(module Context) + Sync f + in + Memo.exec memo + +let ocamlfdo_flags = get_flags "OCAMLFDO_FLAGS" + +module Mode = struct + type t = + | If_exists + | Always + | Never + + let to_string = function + | If_exists -> "if-exists" + | Always -> "always" + | Never -> "never" + + let default = If_exists + + let all = [ If_exists; Never; Always ] + + let var = "OCAMLFDO_USE_PROFILE" + + let of_context (ctx : Context.t) = + match Env.get ctx.env var with + | None -> default + | Some v -> ( + match List.find_opt ~f:(fun s -> String.equal v (to_string s)) all with + | Some v -> v + | None -> + User_error.raise + [ Pp.textf + "Failed to parse environment variable: %s=%s\n\ + Permitted values: if-exists always never\n\ + Default: %s" + var v (to_string default) + ] ) +end + +let get_profile = + (* The dependency on the existence of profile file in source should be + detected automatically by Memo. *) + let f (ctx : Context.t) = + let path = ctx.fdo_target_exe |> Option.value_exn |> fdo_profile in + let profile_exists = + Memo.lazy_ (fun () -> + path |> Path.as_in_source_tree + |> Option.map ~f:File_tree.file_exists + |> Option.value ~default:false) + in + let use_profile = + match Mode.of_context ctx with + | If_exists -> Memo.Lazy.force profile_exists + | Always -> + if Memo.Lazy.force profile_exists then + true + else + User_error.raise + [ Pp.textf "%s=%s but profile file %s does not exist." Mode.var + (Mode.to_string Always) (Path.to_string path) + ] + | Never -> false + in + if use_profile then + Some path else - User_error.raise - [ Pp.textf - "Cannot build %s: OCAMLFDO_USE_PROFILE=always but profile file %s \ - does not exist." - name fdo_profile - ] - | Some "never" -> false - | Some other -> - User_error.raise - [ Pp.textf - "Failed to parse environment variable: OCAMLFDO_USE_PROFILE=%s\n\ - Permitted values: if-exists always never\n\ - Default: if-exists" - other - ] - -let opt_rule cctx m fdo_target_exe = + None + in + let memo = + Memo.create_hidden Mode.var + ~doc: + (sprintf "use profile based on %s environment variable in context" + Mode.var) + ~input:(module Context) + Sync f + in + Memo.exec memo + +let opt_rule cctx m = let sctx = CC.super_context cctx in let ctx = CC.context cctx in let dir = CC.dir cctx in @@ -77,87 +135,55 @@ let opt_rule cctx m fdo_target_exe = let linear_fdo = Obj_dir.Module.obj_file obj_dir m ~kind:Cmx ~ext:linear_fdo_ext in - let fdo_profile = fdo_profile_filename fdo_target_exe in - let name = Module_name.to_string (Module.name m) in - let use_profile = fdo_use_profile ctx name fdo_profile in - let flags = + let flags () = let open Command.Args in - if use_profile then + match get_profile ctx with + | Some fdo_profile_path -> S [ A "-fdo-profile" - ; Dep (Path.build (Path.Build.relative ctx.build_dir fdo_profile)) + ; Dep fdo_profile_path ; As [ "-md5-unit"; "-reorder-blocks"; "opt"; "-q" ] ] - else - As [ "-md5-unit"; "-extra-debug"; "-q" ] - in - let ocamlfdo_flags = - Env.get ctx.env "OCAMLFDO_FLAGS" - |> Option.value ~default:"" |> String.extract_blank_separated_words + | None -> As [ "-md5-unit"; "-extra-debug"; "-q" ] in Super_context.add_rule sctx ~dir (Command.run ~dir:(Path.build dir) (ocamlfdo_binary sctx dir) [ A "opt" ; Hidden_targets [ linear_fdo ] ; Dep (Path.build linear) - ; As ocamlfdo_flags - ; flags + ; As (ocamlfdo_flags ctx) + ; Dyn (Build.delayed flags) ]) module Linker_script = struct type t = Path.t option + let ocamlfdo_linker_script_flags = get_flags "OCAMLFDO_LINKER_SCRIPT_FLAGS" + let linker_script_rule cctx fdo_target_exe = let sctx = CC.super_context cctx in let ctx = CC.context cctx in let dir = CC.dir cctx in - let linker_script_hot = linker_script_hot_filename fdo_target_exe in - let fdo_profile = fdo_profile_filename fdo_target_exe in - let linker_script = linker_script_filename fdo_target_exe in + let linker_script = linker_script fdo_target_exe in let linker_script_path = - Path.Build.(relative ctx.build_dir linker_script) - in - let extra_flags = - Env.get ctx.env "OCAMLFDO_LINKER_SCRIPT_FLAGS" - |> Option.value ~default:"" |> String.extract_blank_separated_words + Path.Build.(relative ctx.build_dir (Path.to_string linker_script)) in - let use_profile = fdo_use_profile ctx linker_script fdo_profile in - let flags = + let flags () = let open Command.Args in - if use_profile then - let fdo_profile_path = - Path.build (Path.Build.relative ctx.build_dir fdo_profile) - in - S [ A "-fdo-profile"; Dep fdo_profile_path ] - else if - File_tree.file_exists Path.Source.(relative root linker_script_hot) - then ( - let linker_script_hot_path = - Path.build (Path.Build.relative ctx.build_dir linker_script_hot) - in - User_warning.emit - ~hints:[ Pp.textf "To ignore %s, rename it." linker_script_hot ] - [ Pp.textf - "Linker script generation with ocamlfdo cannot get hot function \ - layout from profile, because either OCAMLFDO_USE_PROFILE=never \ - or %s not found. Hot functions layout from file %s will be \ - used." - fdo_profile linker_script_hot - ]; - S [ A "-linker-script-hot"; Dep linker_script_hot_path ] - ) else - As [] + match get_profile ctx with + | Some fdo_profile_path -> S [ A "-fdo-profile"; Dep fdo_profile_path ] + | None -> As [] in Super_context.add_rule sctx ~dir (Command.run ~dir:(Path.build ctx.build_dir) (ocamlfdo_binary sctx dir) [ A "linker-script" ; A "-o" ; Target linker_script_path - ; flags + ; Dyn (Build.delayed flags) ; A "-q" - ; As extra_flags + ; As (ocamlfdo_linker_script_flags ctx) ]); - Path.build linker_script_path + linker_script let create cctx name = let ctx = CC.context cctx in @@ -165,7 +191,7 @@ module Linker_script = struct | None -> None | Some fdo_target_exe -> if - String.equal name fdo_target_exe + Path.equal name fdo_target_exe && ( Ocaml_version.supports_function_sections ctx.version || Ocaml_config.is_dev_version ctx.ocaml_config ) then diff --git a/src/dune/fdo.mli b/src/dune/fdo.mli index 489f4cb84cc..d857a715af3 100644 --- a/src/dune/fdo.mli +++ b/src/dune/fdo.mli @@ -1,4 +1,5 @@ (** Integration with feedback-directed optimizations using ocamlfdo. *) +open Stdune type phase = | All @@ -15,12 +16,12 @@ val c_flags : Context.t -> string list val cxx_flags : Context.t -> string list -val opt_rule : Compilation_context.t -> Module.t -> string -> unit +val opt_rule : Compilation_context.t -> Module.t -> unit module Linker_script : sig type t - val create : Compilation_context.t -> string -> t + val create : Compilation_context.t -> Path.t -> t val flags : t -> Command.Args.dynamic Command.Args.t end diff --git a/src/dune/module_compilation.ml b/src/dune/module_compilation.ml index af00cdfa04c..0dc6374ed4f 100644 --- a/src/dune/module_compilation.ml +++ b/src/dune/module_compilation.ml @@ -208,10 +208,10 @@ let build_module ~dep_graphs ?(precompiled_cmi = false) cctx m = | Some _, false -> build_cm cctx m ~dep_graphs ~precompiled_cmi ~cm_kind:Cmx ~phase:(Some Fdo.All) - | Some fdo_target_exe, true -> + | Some _, true -> build_cm cctx m ~dep_graphs ~precompiled_cmi ~cm_kind:Cmx ~phase:(Some Fdo.Compile); - Fdo.opt_rule cctx m fdo_target_exe; + Fdo.opt_rule cctx m; build_cm cctx m ~dep_graphs ~precompiled_cmi ~cm_kind:Cmx ~phase:(Some Fdo.Emit) ); if not precompiled_cmi then diff --git a/src/dune/workspace.ml b/src/dune/workspace.ml index 25652e4dec5..8f43691665e 100644 --- a/src/dune/workspace.ml +++ b/src/dune/workspace.ml @@ -40,15 +40,15 @@ module Context = struct ; name : Context_name.t ; host_context : Context_name.t option ; paths : (string * Ordered_set_lang.t) list - ; fdo_target_exe : string option + ; fdo_target_exe : Path.t option } let fdo_suffix t = match t.fdo_target_exe with | None -> "" | Some file -> - let name, _ = Filename.(basename file |> split_extension) in - "-fdo-" ^ name + let name, _ = Path.split_extension file in + "-fdo-" ^ Path.basename name let t ~profile = let+ env = env_field @@ -62,7 +62,21 @@ module Context = struct field_o "toolchain" (Dune_lang.Syntax.since syntax (1, 5) >>> Context_name.decode) and+ fdo_target_exe = - field_o "fdo" (Dune_lang.Syntax.since syntax (2, 0) >>> string) + let f file = + let ext = Filename.extension file in + if ext = ".exe" then + Path.(relative root file) + else + User_error.raise + [ Pp.textf + "`fdo %s` expects executable filename ending with .exe \ + extension, not %s. \n\ + Please specify the name of the executable to optimize, \ + including path from ." + file ext + ] + in + field_o "fdo" (Dune_lang.Syntax.since syntax (2, 0) >>> map string ~f) and+ paths = let f l = match @@ -89,19 +103,6 @@ module Context = struct "`targets` and `host` options cannot be used in the same \ context." ]); - ( match fdo_target_exe with - | None -> () - | Some file -> - let ext = Filename.extension file in - if not (ext = ".exe") then - User_error.raise ~loc - [ Pp.textf - "`fdo %s` expects executable filename ending with .exe \ - extension, not %s. \n\ - Please specify the name of the executable to optimize, \ - including path from ." - file ext - ] ); { targets ; profile ; loc diff --git a/src/dune/workspace.mli b/src/dune/workspace.mli index bdcc1044e83..8cc3ab5791c 100644 --- a/src/dune/workspace.mli +++ b/src/dune/workspace.mli @@ -20,7 +20,7 @@ module Context : sig ; name : Context_name.t ; host_context : Context_name.t option ; paths : (string * Ordered_set_lang.t) list - ; fdo_target_exe : string option + ; fdo_target_exe : Path.t option } end diff --git a/test/blackbox-tests/test-cases/fdo/run.t b/test/blackbox-tests/test-cases/fdo/run.t index 3b218e1d1dd..f4769b25d11 100644 --- a/test/blackbox-tests/test-cases/fdo/run.t +++ b/test/blackbox-tests/test-cases/fdo/run.t @@ -69,15 +69,10 @@ guaranteed to fail if ocamlfdo attempts to load the profile. $ OCAMLFDO_USE_PROFILE=never dune build src/foo.exe --workspace dune-workspace.4 $ OCAMLFDO_USE_PROFILE=never dune build src-with-profile/foo.exe --workspace dune-workspace.5 - Warning: Linker script generation with ocamlfdo cannot get hot function - layout from profile, because either OCAMLFDO_USE_PROFILE=never or - src-with-profile/foo.exe.fdo-profile not found. Hot functions layout from - file src-with-profile/foo.exe.linker-script-hot will be used. - Hint: To ignore src-with-profile/foo.exe.linker-script-hot, rename it. $ OCAMLFDO_USE_PROFILE=always dune build src/foo.exe --workspace dune-workspace.4 - Error: Cannot build Foo: OCAMLFDO_USE_PROFILE=always but profile file - src/foo.exe.fdo-profile does not exist. + Error: OCAMLFDO_USE_PROFILE=always but profile file src/foo.exe.fdo-profile + does not exist. [1] $ OCAMLFDO_USE_PROFILE=always dune build src-with-profile/foo.exe --workspace dune-workspace.5 2>&1 | grep 'Error: ' From 865bfcc9b0d0a1c2c04a5cf0695642cd2d34936f Mon Sep 17 00:00:00 2001 From: Rudi Grinberg Date: Tue, 29 Oct 2019 21:51:45 +0900 Subject: [PATCH 14/14] Proper Context_name.t usage Well, the error handling can be improved to take locations into account but this will do for now. Signed-off-by: Rudi Grinberg --- src/dune/context.ml | 6 ++++-- src/dune/workspace.ml | 14 ++++++++++++-- 2 files changed, 16 insertions(+), 4 deletions(-) diff --git a/src/dune/context.ml b/src/dune/context.ml index 44550e76c6e..17292adcf21 100644 --- a/src/dune/context.ml +++ b/src/dune/context.ml @@ -224,7 +224,8 @@ let check_fdo_support has_native ocfg ~name = [ Pp.textf "fdo requires ocamlopt version >= 4.10, current version is %s \ (context: %s)" - name version_string + (Context_name.to_string name) + version_string ] in if not has_native then err (); @@ -243,7 +244,8 @@ let check_fdo_support has_native ocfg ~name = [ Pp.textf "fdo requires ocamlopt version >= 4.10, current version %s has \ partial support. Some optimizations are disabled! (context: %s)" - name version_string + (Context_name.to_string name) + version_string ] let create ~(kind : Kind.t) ~path ~env ~env_nodes ~name ~merlin ~targets diff --git a/src/dune/workspace.ml b/src/dune/workspace.ml index 8f43691665e..30e80d2aad9 100644 --- a/src/dune/workspace.ml +++ b/src/dune/workspace.ml @@ -129,7 +129,11 @@ module Context = struct and+ root = field_o "root" string and+ merlin = field_b "merlin" and+ base = Common.t ~profile in - let default = switch ^ Common.fdo_suffix base in + let default = + (* TODO this needs proper error handling with locations *) + let name = Context_name.to_string switch ^ Common.fdo_suffix base in + Context_name.parse_string_exn (Loc.none, name) + in let name = Option.value ~default name in let base = { base with targets = Target.add base.targets x; name } in { base; switch; root; merlin } @@ -145,7 +149,13 @@ module Context = struct ( Dune_lang.Syntax.since syntax (1, 10) >>= fun () -> Context_name.decode ) in - let default = common.name ^ Common.fdo_suffix common in + let default = + (* TODO proper error handling with locs *) + let name = + Context_name.to_string common.name ^ Common.fdo_suffix common + in + Context_name.parse_string_exn (Loc.none, name) + in let name = Option.value ~default name in { common with targets = Target.add common.targets x; name } end