From 6678053c2e8cddb73645b0a0f469d6ed86d065dd Mon Sep 17 00:00:00 2001
From: Simon Cruanes <simon.cruanes.2007@m4x.org>
Date: Mon, 4 Dec 2023 22:27:02 -0500
Subject: [PATCH 1/2] Add a new OpamTrace module and instrument known slow
 parts of the codebase

---
 master_changes.md                |   1 +
 src/client/opamAuxCommands.ml    |   1 +
 src/client/opamCliMain.ml        |   8 ++-
 src/client/opamClient.ml         |  15 +++++
 src/client/opamCommands.ml       |   3 +
 src/client/opamListCommand.ml    |   2 +
 src/client/opamSolution.ml       |   4 ++
 src/client/opamSwitchCommand.ml  |  25 +++++++
 src/core/opamCached.ml           |   4 ++
 src/core/opamConsole.ml          |  51 ++++++++------
 src/core/opamFilename.ml         |   2 +
 src/core/opamProcess.ml          |  14 +++-
 src/core/opamStd.ml              |   1 +
 src/core/opamTrace.ml            | 110 +++++++++++++++++++++++++++++++
 src/core/opamTrace.mli           |   9 +++
 src/format/opamFile.ml           |  14 +++-
 src/format/opamFormat.ml         |   1 +
 src/format/opamPackage.ml        |   3 +
 src/format/opamPp.ml             |   3 +-
 src/format/opamSwitch.ml         |   3 +
 src/repository/opamDownload.ml   |   4 +-
 src/repository/opamRepository.ml |   4 ++
 src/solver/opamCudf.ml           |   3 +
 src/solver/opamSolver.ml         |   5 ++
 src/state/opamFileTools.ml       |   2 +
 src/state/opamGlobalState.ml     |   1 +
 src/state/opamRepositoryState.ml |   1 +
 src/state/opamStateConfig.ml     |   7 ++
 src/state/opamSwitchState.ml     |   3 +
 src/state/opamSysInteract.ml     |  18 +++--
 src/state/opamUpdate.ml          |  13 ++++
 31 files changed, 306 insertions(+), 29 deletions(-)
 create mode 100644 src/core/opamTrace.ml
 create mode 100644 src/core/opamTrace.mli

diff --git a/master_changes.md b/master_changes.md
index 01e9bc108ab..3b7edeb2f06 100644
--- a/master_changes.md
+++ b/master_changes.md
@@ -97,6 +97,7 @@ users)
 ## Shell
 
 ## Internal
+  * Add tracing for opam itself, enabled if `TRACE_FILE` is set in the environment [#5757 @c-cube]
 
 ## Internal: Windows
 
diff --git a/src/client/opamAuxCommands.ml b/src/client/opamAuxCommands.ml
index cbcc6851b5d..49152e7ea1f 100644
--- a/src/client/opamAuxCommands.ml
+++ b/src/client/opamAuxCommands.ml
@@ -395,6 +395,7 @@ let simulate_local_pinnings ?quiet ?(for_view=false) st to_pin =
 
 let simulate_autopin st ?quiet ?(for_view=false) ?locked ?recurse ?subpath
     atom_or_local_list =
+  OpamTrace.with_span "AuxCommands.simulate_autopin" @@ fun () ->
   let atoms, to_pin, obsolete_pins, already_pinned_set =
     autopin_aux st ?quiet ~for_view ?recurse ?subpath ?locked atom_or_local_list
   in
diff --git a/src/client/opamCliMain.ml b/src/client/opamCliMain.ml
index 121cb2e3c37..0ca9a295daf 100644
--- a/src/client/opamCliMain.ml
+++ b/src/client/opamCliMain.ml
@@ -121,6 +121,7 @@ let rec preprocess_argv cli yes_args confirm args =
 
 (* Handle git-like plugins *)
 let check_and_run_external_commands () =
+  OpamTrace.with_span "CliMain.check_and_run_external_commands" @@ fun () ->
   (* Pre-process the --yes and --cli options *)
   let (cli, yes, confirm_level, argv) =
     match Array.to_list Sys.argv with
@@ -439,6 +440,7 @@ let rec main_catch_all f =
     exit exit_code
 
 let run () =
+  OpamTrace.setup ~trace_file:None ();
   OpamStd.Option.iter OpamVersion.set_git OpamGitVersion.version;
   OpamSystem.init ();
   OpamArg.preinit_opam_env_variables ();
@@ -456,7 +458,10 @@ let run () =
   let to_new_cmdliner_api (term, info) = Cmd.v info term in
   let default, default_info = default in
   let commands = List.map to_new_cmdliner_api commands in
-  match Cmd.eval_value ~catch:false ~argv (Cmd.group ~default default_info commands) with
+  match
+    OpamTrace.with_span "CliMain.Cmd.eval_value" @@ fun () ->
+    Cmd.eval_value ~catch:false ~argv (Cmd.group ~default default_info commands)
+  with
   | Error _ -> exit (OpamStd.Sys.get_exit_code `Bad_arguments)
   | Ok _    -> exit (OpamStd.Sys.get_exit_code `Success)
 
@@ -464,6 +469,7 @@ let json_out () =
   match OpamClientConfig.(!r.json_out) with
   | None   -> ()
   | Some s ->
+    OpamTrace.with_span "cli-main.json-out" @@ fun () ->
     let file_name () =
       match OpamStd.String.cut_at s '%' with
       | None -> OpamFilename.of_string s
diff --git a/src/client/opamClient.ml b/src/client/opamClient.ml
index 7d44490cf71..2debbd55c9b 100644
--- a/src/client/opamClient.ml
+++ b/src/client/opamClient.ml
@@ -19,6 +19,7 @@ let slog = OpamConsole.slog
 
 (* Splits a list of atoms into the installed and uninstalled ones*)
 let get_installed_atoms t atoms =
+  OpamTrace.with_span "Client.get_installed_atoms" @@ fun () ->
   List.fold_left (fun (packages, not_installed) atom ->
       try
         let nv =
@@ -66,6 +67,7 @@ let update_dev_packages_t ?autolock ?(only_installed=false) atoms t =
 let compute_upgrade_t
     ?(strict_upgrade=true) ?(auto_install=false) ?(only_installed=false)
     ~all ~formula atoms t =
+  OpamTrace.with_span "Client.compute_upgrade" @@ fun () ->
   let packages = OpamFormula.packages_of_atoms t.packages atoms in
   let names = OpamPackage.Name.Set.of_list (List.rev_map fst atoms) in
   let atoms =
@@ -340,6 +342,7 @@ let upgrade_t
     t
 
 let upgrade t ?formula ?check ?only_installed ~all names =
+  OpamTrace.with_span "Client.upgrade" @@ fun () ->
   let atoms = OpamSolution.sanitize_atom_list t names in
   let t = update_dev_packages_t ~autolock:true ?only_installed atoms t in
   upgrade_t ?check ~strict_upgrade:(not all) ?only_installed ~all
@@ -347,6 +350,7 @@ let upgrade t ?formula ?check ?only_installed ~all names =
 
 let fixup ?(formula=OpamFormula.Empty) t =
   (* @LG reimplement as an alias for 'opam upgrade --criteria=fixup --best-effort --update-invariant *)
+  OpamTrace.with_span "Client.fixup" @@ fun () ->
   log "FIXUP";
   let resolve pkgs =
     pkgs,
@@ -409,6 +413,7 @@ let fixup ?(formula=OpamFormula.Empty) t =
 
 let update
     gt ~repos_only ~dev_only ?(all=false) names =
+  OpamTrace.with_span "Client.update" @@ fun () ->
   log "UPDATE %a" (slog @@ String.concat ", ") names;
   let rt = OpamRepositoryState.load `Lock_none gt in
   let st, repos_only =
@@ -550,6 +555,7 @@ let update
   rt
 
 let init_checks ?(hard_fail_exn=true) init_config =
+  OpamTrace.with_span "Client.init_checks" @@ fun () ->
   (* Check for the external dependencies *)
   let check_external_dep name =
     OpamSystem.resolve_command name <> None
@@ -636,6 +642,7 @@ let init_checks ?(hard_fail_exn=true) init_config =
   else not (soft_fail || hard_fail)
 
 let windows_checks ?cygwin_setup config =
+  OpamTrace.with_span "Client.windows_checks" @@ fun () ->
   let vars = OpamFile.Config.global_variables config in
   let env =
     List.map (fun (v, c, s) -> v, (lazy (Some c), s)) vars
@@ -900,6 +907,7 @@ let reinit ?(init_config=OpamInitDefaults.init_config()) ~interactive
     ?dot_profile ?update_config ?env_hook ?completion ?inplace
     ?(check_sandbox=true) ?(bypass_checks=false) ?cygwin_setup
     config shell =
+  OpamTrace.with_span "Client.reinit" @@ fun () ->
   let root = OpamStateConfig.(!r.root_dir) in
   let config = update_with_init_config config init_config in
   let config = windows_checks ?cygwin_setup config in
@@ -945,6 +953,7 @@ let init
     ?(check_sandbox=true)
     ?cygwin_setup
     shell =
+  OpamTrace.with_span "Client.init" @@ fun () ->
   log "INIT %a"
     (slog @@ OpamStd.Option.to_string OpamRepositoryBackend.to_string) repo;
   let root = OpamStateConfig.(!r.root_dir) in
@@ -1069,6 +1078,7 @@ let init
   gt, rt, default_compiler
 
 let check_installed ~build ~post t atoms =
+  OpamTrace.with_span "Client.check_installed" @@ fun () ->
   let available = (Lazy.force t.available_packages) in
   let uninstalled = OpamPackage.Set.Op.(available -- t.installed) in
   let pkgs =
@@ -1125,6 +1135,7 @@ let check_installed ~build ~post t atoms =
     ) pkgs OpamPackage.Map.empty
 
 let assume_built_restrictions ?available_packages t atoms =
+  OpamTrace.with_span "Client.assume_built_restrictions" @@ fun () ->
   let missing = check_installed ~build:false ~post:false t atoms in
   let atoms =
     if OpamPackage.Map.is_empty missing then atoms else
@@ -1179,6 +1190,7 @@ let assume_built_restrictions ?available_packages t atoms =
   { t with available_packages }, fixed_atoms
 
 let filter_unpinned_locally t atoms f =
+  OpamTrace.with_span "Client.filter_unpinned_locally" @@ fun () ->
   OpamStd.List.filter_map (fun at ->
       let n,_ = at in
       if OpamSwitchState.is_pinned t n &&
@@ -1198,6 +1210,7 @@ let filter_unpinned_locally t atoms f =
 let install_t t ?ask ?(ignore_conflicts=false) ?(depext_only=false)
     ?(download_only=false) atoms ?(formula=OpamFormula.Empty)
     add_to_roots ~deps_only ~assume_built =
+  OpamTrace.with_span "Client.install" @@ fun () ->
   log "INSTALL %a" (slog OpamFormula.string_of_atoms) atoms;
   let available_packages = Lazy.force t.available_packages in
 
@@ -1455,6 +1468,7 @@ let install t ?formula ?autoupdate ?add_to_roots
     ~ignore_conflicts ~depext_only ~deps_only ~download_only ~assume_built
 
 let remove_t ?ask ~autoremove ~force ?(formula=OpamFormula.Empty) atoms t =
+  OpamTrace.with_span "Client.remove" @@ fun () ->
   log "REMOVE autoremove:%b %a" autoremove
     (slog OpamFormula.string_of_atoms) atoms;
 
@@ -1543,6 +1557,7 @@ let remove t ~autoremove ~force ?formula names =
   remove_t ~autoremove ~force ?formula atoms t
 
 let reinstall_t t ?ask ?(force=false) ~assume_built atoms =
+  OpamTrace.with_span "Client.reinstall" @@ fun () ->
   log "reinstall %a" (slog OpamFormula.string_of_atoms) atoms;
 
   let packages = OpamFormula.packages_of_atoms t.packages atoms in
diff --git a/src/client/opamCommands.ml b/src/client/opamCommands.ml
index aecce33a15e..d808d7f1052 100644
--- a/src/client/opamCommands.ml
+++ b/src/client/opamCommands.ml
@@ -940,6 +940,7 @@ let show cli =
   let show global_options fields show_empty raw where
       list_files file normalise no_lint just_file all_versions sort atom_locs
       () =
+  OpamTrace.with_span "Commands.show" @@ fun () ->
     let print_just_file opamf opam =
       if not no_lint then OpamFile.OPAM.print_errors opam;
       let opam =
@@ -2569,6 +2570,7 @@ let with_repos_rt gt repos f =
 
 let switch_doc = "Manage multiple installation prefixes."
 let switch cli =
+  OpamTrace.with_span "Commands.switch" @@ fun () ->
   let shell = OpamStd.Sys.guess_shell_compat () in
   let doc = switch_doc in
   let commands = [
@@ -4403,6 +4405,7 @@ let admin =
 (* Note: for cli versionning check, all commands must be constructed with
    [OpamArg.mk_command] or [OpamArg.mk_command_ret]. *)
 let commands cli =
+  OpamTrace.with_span "Commands.commands" @@ fun () ->
   let show = show cli in
   let remove = remove cli in
   let repository = repository cli in
diff --git a/src/client/opamListCommand.ml b/src/client/opamListCommand.ml
index 327e8c1569d..d2633dbd036 100644
--- a/src/client/opamListCommand.ml
+++ b/src/client/opamListCommand.ml
@@ -664,6 +664,7 @@ let default_package_listing_format = {
 }
 
 let display st format packages =
+  OpamTrace.with_span "ListCommand.display" @@ fun () ->
   let packages =
     if format.all_versions then packages else
       OpamPackage.Name.Set.fold (fun name ->
@@ -714,6 +715,7 @@ let display st format packages =
     OpamConsole.print_table ?cut:format.wrap stdout ~sep:format.separator
 
 let get_switch_state gt rt =
+  OpamTrace.with_span "ListCommand.get_switch_state" @@ fun () ->
   match OpamStateConfig.get_switch_opt () with
   | None -> OpamSwitchState.load_virtual gt rt
   | Some sw -> OpamSwitchState.load `Lock_none gt rt sw
diff --git a/src/client/opamSolution.ml b/src/client/opamSolution.ml
index 4b7576483af..554fa320a00 100644
--- a/src/client/opamSolution.ml
+++ b/src/client/opamSolution.ml
@@ -246,6 +246,7 @@ let display_error (n, error) =
 
 module Json = struct
   let output_request request user_action =
+    OpamTrace.with_span "Solution.Json.output_request" @@ fun () ->
     if OpamClientConfig.(!r.json_out = None) then () else
     let atoms =
       List.map (fun a -> `String (OpamFormula.short_string_of_atom a))
@@ -264,6 +265,7 @@ module Json = struct
     OpamJson.append "request" j
 
   let output_solution t solution =
+    OpamTrace.with_span "Solution.Json.output_solution" @@ fun () ->
     if OpamClientConfig.(!r.json_out = None) then () else
     match solution with
     | Success solution ->
@@ -1302,6 +1304,7 @@ let apply ?ask t ~requested ?print_requested ?add_roots
     ?(skip=OpamPackage.Map.empty)
     ?(assume_built=false)
     ?(download_only=false) ?force_remove solution0 =
+  OpamTrace.with_span "Solution.apply" @@ fun () ->
   let names = OpamPackage.names_of_packages requested in
   let print_requested = OpamStd.Option.default names print_requested in
   log "apply";
@@ -1454,6 +1457,7 @@ let apply ?ask t ~requested ?print_requested ?add_roots
   )
 
 let resolve t action ?reinstall ~requested request =
+  OpamTrace.with_span "Solution.resolve" @@ fun () ->
   if OpamClientConfig.(!r.json_out <> None) then
     OpamJson.append "switch" (OpamSwitch.to_json t.switch);
   OpamRepositoryState.check_last_update ();
diff --git a/src/client/opamSwitchCommand.ml b/src/client/opamSwitchCommand.ml
index 10466bd666a..17d62e0df0a 100644
--- a/src/client/opamSwitchCommand.ml
+++ b/src/client/opamSwitchCommand.ml
@@ -20,6 +20,7 @@ let log fmt = OpamConsole.log "SWITCH" fmt
 let slog = OpamConsole.slog
 
 let list gt ~print_short =
+  OpamTrace.with_span "SwitchCommand.list" @@ fun () ->
   log "list";
   let gt = OpamGlobalState.fix_switch_list gt in
   if print_short then
@@ -27,7 +28,11 @@ let list gt ~print_short =
       (List.sort compare (OpamFile.Config.installed_switches gt.config))
   else
   let installed_switches =
+    OpamTrace.with_span "SwitchCommand.installed_switches" @@ fun () ->
     OpamGlobalState.fold_switches (fun sw sel acc ->
+        OpamTrace.with_span "fold-switch"
+          ~data:["sw", `String (OpamSwitch.to_string sw)] @@ fun () ->
+
         let opams =
           OpamPackage.Set.fold (fun nv acc ->
               match
@@ -146,6 +151,7 @@ let list gt ~print_short =
   | _ -> ()
 
 let clear_switch ?(keep_debug=false) (gt: rw global_state) switch =
+  OpamTrace.with_span "SwitchCommands.clear_switch" @@ fun () ->
   let module C = OpamFile.Config in
   let config = gt.config in
   let config =
@@ -170,6 +176,7 @@ let clear_switch ?(keep_debug=false) (gt: rw global_state) switch =
   with OpamSystem.Internal_error _ -> gt
 
 let remove gt ?(confirm = true) switch =
+  OpamTrace.with_span "SwitchCommands.remove" @@ fun () ->
   log "remove switch=%a" (slog OpamSwitch.to_string) switch;
   if not (OpamGlobalState.switch_exists gt switch) then (
     OpamConsole.msg "The compiler switch %s does not exist.\n"
@@ -185,6 +192,7 @@ let remove gt ?(confirm = true) switch =
   else gt
 
 let set_invariant_raw st invariant =
+  OpamTrace.with_span "SwitchCommands.set_invariant_raw" @@ fun () ->
   let switch_config = {st.switch_config with invariant = Some invariant} in
   let st = {st with switch_invariant = invariant; switch_config } in
   if not (OpamStateConfig.(!r.dryrun) || OpamClientConfig.(!r.show)) then
@@ -194,6 +202,7 @@ let set_invariant_raw st invariant =
 
 let install_compiler
     ?(additional_installs=[]) ?(deps_only=false) ?(ask=false) t =
+  OpamTrace.with_span "SwitchCommands.install_compiler" @@ fun () ->
   let invariant = t.switch_invariant in
   if invariant = OpamFormula.Empty && additional_installs = [] then begin
     (if not OpamClientConfig.(!r.show) &&
@@ -290,6 +299,9 @@ let install_compiler
 
 let create
     gt ~rt ?synopsis ?repos ~update_config ~invariant switch post =
+  OpamTrace.with_span "SwitchCommands.create"
+    ~data:["sw", `String (OpamSwitch.to_string switch)] @@ fun () ->
+
   let update_config = update_config && not (OpamSwitch.is_external switch) in
   let comp_dir = OpamPath.Switch.root gt.root switch in
   let simulate = OpamStateConfig.(!r.dryrun) || OpamClientConfig.(!r.show) in
@@ -359,6 +371,7 @@ let create
     OpamGlobalState.drop gt
 
 let switch lock gt switch =
+  OpamTrace.with_span "SwitchCommands.switch" @@ fun () ->
   log "switch switch=%a" (slog OpamSwitch.to_string) switch;
   if OpamGlobalState.switch_exists gt switch then
     OpamRepositoryState.with_ `Lock_none gt @@ fun rt ->
@@ -378,6 +391,7 @@ let switch lock gt switch =
     (OpamStd.Format.itemize OpamSwitch.to_string installed_switches)
 
 let switch_previous lock gt =
+  OpamTrace.with_span "SwitchCommands.switch_previous" @@ fun () ->
   match OpamFile.Config.previous_switch gt.config with
   | Some switch_name ->
     OpamConsole.msg
@@ -391,6 +405,7 @@ let switch_previous lock gt =
       "No previously used switch could be found"
 
 let import_t ?ask importfile t =
+  OpamTrace.with_span "SwitchCommands.import" @@ fun () ->
   log "import switch";
 
   let extra_files = importfile.OpamFile.SwitchExport.extra_files in
@@ -531,6 +546,7 @@ let import_t ?ask importfile t =
   t
 
 let freeze_url src_dir nv url =
+  OpamTrace.with_span "SwitchCommands.freeze_url" @@ fun () ->
   let url_t = OpamFile.URL.url url in
   match url_t.backend with
   | #OpamUrl.version_control ->
@@ -560,6 +576,7 @@ let freeze_url src_dir nv url =
       (OpamPackage.Name.to_string nv.name)
 
 let freeze_opam src_dir nv opam =
+  OpamTrace.with_span "SwitchCommands.freeze_opam" @@ fun () ->
   let url =
     OpamStd.Option.map
       (fun url -> freeze_url src_dir nv url)
@@ -576,6 +593,7 @@ let freeze_opam src_dir nv opam =
 
 let export rt ?(freeze=false) ?(full=false)
     ?(switch=OpamStateConfig.get_switch ()) filename =
+  OpamTrace.with_span "SwitchCommands.export" @@ fun () ->
   let root = OpamStateConfig.(!r.root_dir) in
   let export =
     OpamFilename.with_flock `Lock_none (OpamPath.Switch.lock root switch)
@@ -650,10 +668,12 @@ let export rt ?(freeze=false) ?(full=false)
   | Some f -> OpamFile.SwitchExport.write f export
 
 let show () =
+  OpamTrace.with_span "SwitchCommands.show" @@ fun () ->
   OpamConsole.msg "%s\n"
     (OpamSwitch.to_string (OpamStateConfig.get_switch ()))
 
 let reinstall init_st =
+  OpamTrace.with_span "SwitchCommands.reinstall" @@ fun () ->
   let switch = init_st.switch in
   log "reinstall switch=%a" (slog OpamSwitch.to_string) switch;
   let gt = init_st.switch_global in
@@ -680,6 +700,8 @@ let reinstall init_st =
     st
 
 let import st filename =
+  OpamTrace.with_span "SwitchCommands.import" @@ fun () ->
+
   let import_str = match filename with
     | None   -> OpamSystem.string_of_channel stdin
     | Some f -> OpamFilename.read (OpamFile.filename f)
@@ -698,6 +720,7 @@ let import st filename =
   import_t importfile st
 
 let set_invariant ?(force=false) st invariant =
+  OpamTrace.with_span "SwitchCommands.set_invariant" @@ fun () ->
   let satisfied = OpamFormula.satisfies_depends st.installed invariant in
   let names =
     OpamPackage.Name.Set.of_list (List.map fst (OpamFormula.atoms invariant))
@@ -717,6 +740,7 @@ let set_invariant ?(force=false) st invariant =
   set_invariant_raw st invariant
 
 let get_compiler_packages ?repos rt =
+  OpamTrace.with_span "SwitchCommands.get_compiler_packages" @@ fun () ->
   let repos = match repos with
     | None -> OpamGlobalState.repos_list rt.repos_global
     | Some r -> r
@@ -732,6 +756,7 @@ let get_compiler_packages ?repos rt =
   |> OpamPackage.keys
 
 let guess_compiler_invariant ?repos rt strings =
+  OpamTrace.with_span "SwitchCommands.guess_compiler_invariant" @@ fun () ->
   let repos = match repos with
     | None -> OpamGlobalState.repos_list rt.repos_global
     | Some r -> r
diff --git a/src/core/opamCached.ml b/src/core/opamCached.ml
index 7b0b9c28f96..b8638d727bf 100644
--- a/src/core/opamCached.ml
+++ b/src/core/opamCached.ml
@@ -57,6 +57,9 @@ end = struct
   let marshal_from_file file fd =
     let chrono = OpamConsole.timer () in
     let f ic =
+      OpamTrace.with_span "Cached.marshal_from_file"
+          ~data:["sz", `Float (float_of_int @@ in_channel_length ic)]
+      @@ fun () ->
       try
         let (cache: t) = Marshal.from_channel ic in
         log "Loaded %a in %.3fs" (slog OpamFilename.to_string) file (chrono ());
@@ -82,6 +85,7 @@ end = struct
     | None -> None
 
   let save cache_file t =
+    OpamTrace.with_span "Cached.save" @@ fun () ->
     if OpamCoreConfig.(!r.safe_mode) then
       log "Running in safe mode, not upgrading the %s cache" X.name
     else
diff --git a/src/core/opamConsole.ml b/src/core/opamConsole.ml
index bbc19c35a56..8e8dea2ad5c 100644
--- a/src/core/opamConsole.ml
+++ b/src/core/opamConsole.ml
@@ -509,19 +509,22 @@ let clear_status =
   else
     clear_status_unix
 
+let flush_out ch =
+  flush (if ch = `stdout then stderr else stdout)
+
 let print_message =
   if Sys.win32 then
-    fun ch fmt ->
-      flush (if ch = `stdout then stderr else stdout);
+    fun ~force_flush ch fmt ->
+      if force_flush then flush_out ch;
       clear_status ();
       (* win32_print_message *always* flushes *)
       Printf.ksprintf (win32_print_message ch) fmt
   else
-    fun ch fmt ->
+    fun ~force_flush ch fmt ->
       let output_string =
         let output_string ch s =
           output_string ch s;
-          flush ch
+        if force_flush then flush ch
         in
         match ch with
         | `stdout -> flush stderr; output_string stdout
@@ -594,23 +597,23 @@ let slog to_string f x = Format.pp_print_string f (to_string x)
 
 let error fmt =
   Printf.ksprintf (fun str ->
-    print_message `stderr "%a %s\n" (acolor `red) "[ERROR]"
+    print_message ~force_flush:true `stderr "%a %s\n" (acolor `red) "[ERROR]"
       (OpamStd.Format.reformat ~start_column:8 ~indent:8 str)
   ) fmt
 
 let warning fmt =
   Printf.ksprintf (fun str ->
-    print_message `stderr "%a %s\n" (acolor `yellow) "[WARNING]"
+    print_message ~force_flush:true `stderr "%a %s\n" (acolor `yellow) "[WARNING]"
       (OpamStd.Format.reformat ~start_column:10 ~indent:10 str)
   ) fmt
 
 let note fmt =
   Printf.ksprintf (fun str ->
-    print_message `stderr "%a %s\n" (acolor `blue) "[NOTE]"
+    print_message ~force_flush:true `stderr "%a %s\n" (acolor `blue) "[NOTE]"
       (OpamStd.Format.reformat ~start_column:7 ~indent:7 str)
   ) fmt
 
-let errmsg fmt = print_message `stderr fmt
+let errmsg fmt = print_message ~force_flush:true `stderr fmt
 
 let error_and_exit reason fmt =
   Printf.ksprintf (fun str ->
@@ -618,11 +621,13 @@ let error_and_exit reason fmt =
     OpamStd.Sys.exit_because reason
   ) fmt
 
-let msg fmt = print_message `stdout fmt
+let msg fmt = print_message ~force_flush:true `stdout fmt
+let msg_no_flush fmt = print_message ~force_flush:false `stdout fmt
 
 let formatted_msg ?indent fmt =
   Printf.ksprintf
-    (fun s -> print_message `stdout "%s" (OpamStd.Format.reformat ?indent s))
+    (fun s -> print_message ~force_flush:true `stdout "%s"
+      (OpamStd.Format.reformat ?indent s))
     fmt
 
 let last_status = ref ""
@@ -680,7 +685,7 @@ let header_msg fmt =
       let wpad = header_width () - String.length str - 2 in
       let wpadl = 4 in
       let wpadr = wpad - wpadl - if utf8_extended () then 4 else 0 in
-      print_message `stdout "\n%s %s%s%s\n"
+      print_message ~force_flush:true `stdout "\n%s %s%s%s\n"
         (colorise `cyan (String.sub padding 0 wpadl))
         (colorise `bold str)
         (if wpadr > 0 then
@@ -704,7 +709,7 @@ let header_error fmt =
           let wpad = header_width () - String.length head - 8 in
           let wpadl = 4 in
           let wpadr = wpad - wpadl in
-          print_message `stderr "\n%s %s %s %s\n%s\n"
+          print_message ~force_flush:true `stderr "\n%s %s %s %s\n%s\n"
             (colorise `red (String.sub padding 0 wpadl))
             (colorise `bold "ERROR")
             (colorise `bold head)
@@ -805,6 +810,7 @@ let pause fmt =
     Printf.ifprintf () fmt
 
 let confirm ?(require_unsafe_yes=false) ?(default=true) fmt =
+  OpamTrace.with_span "Console.confirm" @@ fun () ->
   Printf.ksprintf (fun s ->
       if OpamCoreConfig.(!r.safe_mode) then false else
       let prompt =
@@ -846,6 +852,7 @@ let read fmt =
     ) fmt
 
 let print_table ?cut oc ~sep table =
+  OpamTrace.with_span "Console.print_table" @@ fun () ->
   let open OpamStd.Format in
   let cut =
     match cut with
@@ -854,7 +861,7 @@ let print_table ?cut oc ~sep table =
   in
   let output_string s =
     if oc = stdout then
-      msg "%s\n" s
+      msg_no_flush "%s\n" s
     else if oc = stderr then
       errmsg "%s\n" s
     else begin
@@ -874,15 +881,19 @@ let print_table ?cut oc ~sep table =
     in
     clean [] (List.rev sl)
   in
-  let print_line l = match cut with
+
+  let terminal_columns = OpamStd.Sys.terminal_columns () in
+
+  let print_line l =
+    match cut with
     | `None ->
       let s = List.map (replace_newlines "\\n") l |> String.concat sep in
       output_string s;
     | `Truncate ->
       let s = List.map (replace_newlines " ") l |> String.concat sep in
-      output_string (cut_at_visual s (OpamStd.Sys.terminal_columns ()));
+      output_string (cut_at_visual s terminal_columns);
     | `Wrap wrap_sep ->
-      let width = OpamStd.Sys.terminal_columns () in
+      let width = terminal_columns in
       let base_indent = 10 in
       let sep_len = visual_length sep in
       let wrap_sep_len = visual_length wrap_sep in
@@ -959,7 +970,9 @@ let print_table ?cut oc ~sep table =
       in
       output_string str;
   in
-  List.iter (fun l -> print_line (cleanup_trailing l)) table
+  List.iter (fun l -> print_line (cleanup_trailing l)) table;
+  OpamTrace.instant "console.print_table.flush";
+  flush oc
 
 let menu ?default ?unsafe_yes ?yes ~no ~options fmt =
   assert (List.length options < 10);
@@ -990,9 +1003,9 @@ let menu ?default ?unsafe_yes ?yes ~no ~options fmt =
             nums_options)
     in
     let nlines = List.length Re.(all (compile (char '\n')) text) in
-    msg "%s" text;
+    msg_no_flush "%s" text;
     let select a =
-      msg "%s\n" OpamStd.(List.assoc Compare.equal a options_nums); a
+      msg_no_flush "%s\n" OpamStd.(List.assoc Compare.equal a options_nums); a
     in
     let default_s = OpamStd.(List.assoc Compare.equal default options_nums) in
     let no_s = OpamStd.(List.assoc Compare.equal no options_nums) in
diff --git a/src/core/opamFilename.ml b/src/core/opamFilename.ml
index d925d439179..7283e30002f 100644
--- a/src/core/opamFilename.ml
+++ b/src/core/opamFilename.ml
@@ -435,6 +435,8 @@ let patch ?preprocess filename dirname =
 let flock flag ?dontblock file = OpamSystem.flock flag ?dontblock (to_string file)
 
 let with_flock flag ?dontblock file f =
+  OpamTrace.with_span "Filename.with_flock"
+      ~data:["f", `String (to_string file)] @@ fun () ->
   let lock = OpamSystem.flock flag ?dontblock (to_string file) in
   try
     let (fd, ch) =
diff --git a/src/core/opamProcess.ml b/src/core/opamProcess.ml
index 3160272412a..47ad3ccfd66 100644
--- a/src/core/opamProcess.ml
+++ b/src/core/opamProcess.ml
@@ -501,6 +501,8 @@ let empty_result = {
 
 (* XXX: the function might block for ever for some channels kinds *)
 let read_lines f =
+  OpamTrace.with_span "Process.read_lines"
+      ~data:["f", `String f] @@ fun () ->
   try
     let ic = open_in f in
     let lines = ref [] in
@@ -696,7 +698,12 @@ let safe_wait fallback_pid f x =
   try let r = aux () in cleanup (); r
   with e -> cleanup (); raise e
 
-let wait p =
+let wait (p:t) =
+  OpamTrace.with_span "process.wait"
+      ~data:["p", `String p.p_name; "args",
+      `String (String.concat " "p.p_args)]
+  @@ fun () ->
+
   set_verbose_process p;
   let _, return = safe_wait p.p_pid (Unix.waitpid []) p.p_pid in
   exit_status p return
@@ -749,6 +756,11 @@ let dry_wait_one = function
   | _ -> raise (Invalid_argument "dry_wait_one")
 
 let run command =
+  OpamTrace.with_span "Process.run"
+      ~data:["cmd", `String command.cmd;
+             "args", `String (String.concat " " command.args)]
+  @@ fun () ->
+
   let command =
     { command with
       cmd_stdin = OpamStd.Option.Op.(command.cmd_stdin ++ Some (not Sys.win32)) }
diff --git a/src/core/opamStd.ml b/src/core/opamStd.ml
index 15292be99a5..f1f39390271 100644
--- a/src/core/opamStd.ml
+++ b/src/core/opamStd.ml
@@ -1102,6 +1102,7 @@ module OpamSys = struct
     )
 
   let guess_shell_compat () =
+    OpamTrace.with_span "Std.guess_shell_compat" @@ fun () ->
     let parent_guess () =
       let ppid = Unix.getppid () in
       let dir = Filename.concat "/proc" (string_of_int ppid) in
diff --git a/src/core/opamTrace.ml b/src/core/opamTrace.ml
new file mode 100644
index 00000000000..28d712d8452
--- /dev/null
+++ b/src/core/opamTrace.ml
@@ -0,0 +1,110 @@
+module Json = OpamJson
+
+type state = {
+  mutable first_item: bool;
+  oc: out_channel;
+}
+
+let output : state option ref = ref None
+
+let start_time_s_ : float = Unix.gettimeofday ()
+
+let[@inline] now_s () : float =
+  Unix.gettimeofday() -. start_time_s_
+
+(** time in microseconds *)
+let[@inline] now_us () : float =
+  let t = Unix.gettimeofday () -. start_time_s_ in
+  t *. 1e6
+
+let[@inline] pid () : float = float_of_int @@ Unix.getpid ()
+let[@inline] tid () : float = float_of_int 0
+
+let last_gc_ = ref (now_s ())
+
+let counter_json_ name cnts : Json.t =
+  let cnts = List.map (fun (k,v) -> k, `Float v) cnts in
+  `O [
+    "ts", `Float (now_us ()); "pid", `Float (pid()); "tid", `Float (tid());
+    "ph", `String "C"; "name", `String name; "args", `O cnts
+  ]
+
+let emit_single_entry_ (self:state) (j:Json.t) =
+  if self.first_item then (
+    self.first_item <- false;
+  ) else (
+    output_string self.oc ",\n";
+  );
+  let str = Json.to_string ~minify:true j in
+  output_string self.oc str
+
+let[@inline never] emit_entry_ (self:state) (j:Json.t) =
+  emit_single_entry_ self j;
+
+  let now = now_s () in
+  if now -. !last_gc_ > 0.2 then (
+    (* emit GC stats *)
+    last_gc_ := now;
+    let minor, major, _ = Gc.counters() in
+    let j = counter_json_ "gc" [
+      "minor", minor;
+      "major", major
+    ] in
+    emit_single_entry_ self j
+  )
+
+let instant_json_ ?(data=[]) msg : Json.t =
+  `O [
+    "ts", `Float (now_us ()); "pid", `Float (pid()); "tid", `Float (tid());
+    "ph", `String "I"; "name", `String msg; "args", `O data
+  ]
+
+let[@inline] instant ?data msg = match !output with
+  | None -> ()
+  | Some out ->
+    let j = instant_json_ ?data msg in
+    emit_entry_ out j
+
+let[@inline] counter msg cnts = match !output with
+  | None -> ()
+  | Some out ->
+    let j = counter_json_ msg cnts in
+    emit_entry_ out j
+
+let with_span_json_ ?(data=[]) name start : Json.t =
+  let stop = now_us () in
+  `O [
+    "ts", `Float start; "pid", `Float (pid()); "tid", `Float (tid());
+    "ph", `String "X"; "args", `O data;
+    "name", `String name; "dur", `Float (stop -. start);
+  ]
+
+let[@inline] with_span ?data name f =
+  match !output with
+  | None -> f()
+  | Some out ->
+    let start = now_us () in
+    try
+      let x = f() in
+      let j = with_span_json_ ?data name start in
+      emit_entry_ out j;
+      x
+    with e ->
+      let j = with_span_json_ ?data name start in
+      emit_entry_ out j;
+      raise e
+
+(* ## setup ## *)
+
+let setup ~trace_file () : unit =
+  match trace_file, Sys.getenv_opt "TRACE_FILE" with
+  | None, None -> ()
+  | Some file, _
+  | None, Some file ->
+    let oc = open_out_bin file in
+    output_char oc '[';
+    at_exit (fun () ->
+      output_char oc ']';
+      flush oc;
+      close_out_noerr oc);
+    output := Some {oc; first_item=true}
diff --git a/src/core/opamTrace.mli b/src/core/opamTrace.mli
new file mode 100644
index 00000000000..10340c9afce
--- /dev/null
+++ b/src/core/opamTrace.mli
@@ -0,0 +1,9 @@
+(** Tracing *)
+
+val setup : trace_file:string option -> unit -> unit
+
+val with_span : ?data:(string * OpamJson.t) list -> string -> (unit -> 'a) -> 'a
+
+val instant : ?data:(string * OpamJson.t) list -> string -> unit
+
+val counter : string -> (string * float) list -> unit
diff --git a/src/format/opamFile.ml b/src/format/opamFile.ml
index b3f27154cf2..980a9c849de 100644
--- a/src/format/opamFile.ml
+++ b/src/format/opamFile.ml
@@ -108,6 +108,7 @@ module MakeIO (F : IO_Arg) = struct
   let slog = OpamConsole.slog
 
   let write f v =
+    OpamTrace.with_span "OpamFile.write" @@ fun () ->
     let filename = OpamFilename.to_string f in
     let chrono = OpamConsole.timer () in
     let write =
@@ -856,7 +857,8 @@ module Syntax = struct
      re-writing files with a guarantee that it hasn't been rewritten in the
      meantime *)
 
-  let parser_main lexbuf filename =
+  let parser_main lexbuf filename : opamfile =
+    OpamTrace.with_span "OpamFile.Syntax.parser_main" @@ fun () ->
     let error msg =
       let curr = lexbuf.Lexing.lex_curr_p in
       let start = lexbuf.Lexing.lex_start_p in
@@ -904,7 +906,9 @@ module Syntax = struct
 
   let to_string_with_preserved_format
       filename ?(format_from=filename) ?format_from_string
-      ~empty ?(sections=[]) ~fields pp t =
+      ~empty ?(sections=[]) ~fields pp t : string =
+    OpamTrace.with_span "OpamFile.Syntax.to_string_with_preserved_format"
+      @@ fun () ->
     let current_str_opt =
       match format_from_string with
       | Some s -> Some s
@@ -1178,19 +1182,25 @@ module SyntaxFile(X: SyntaxFileArg) : IO_FILE with type t := X.t = struct
     | opamfile -> opamfile
 
     let of_channel filename (ic:in_channel) =
+      OpamTrace.with_span "OpamFile.of_channel"
+          ~data:["f", `String (OpamFilename.to_string filename)] @@ fun () ->
       let opamfile = Syntax.of_channel filename ic |> catch_future_syntax_error in
       Pp.parse X.pp ~pos:(pos_file filename) opamfile
       |> snd
 
     let to_channel filename oc t =
+      OpamTrace.with_span "OpamFile.to_channel"
+          ~data:["f", `String (to_string filename)] @@ fun () ->
       Syntax.to_channel filename oc (to_opamfile filename t)
 
     let of_string (filename:filename) str =
+      OpamTrace.with_span "OpamFile.of_string" @@ fun () ->
       let opamfile = Syntax.of_string filename str |> catch_future_syntax_error in
       Pp.parse X.pp ~pos:(pos_file filename) opamfile
       |> snd
 
     let to_string filename t =
+      OpamTrace.with_span "OpamFile.to_string" @@ fun () ->
       Syntax.to_string filename (to_opamfile filename t)
   end
 
diff --git a/src/format/opamFormat.ml b/src/format/opamFormat.ml
index ef1db0a7c5a..b7d4894960b 100644
--- a/src/format/opamFormat.ml
+++ b/src/format/opamFormat.ml
@@ -704,6 +704,7 @@ module I = struct
   type ('a, 'value) fields_def = (string * ('a, 'value) field_parser) list
 
   let fields ?name ~empty ?(sections=[]) ?(mandatory_fields=[]) ppas =
+    OpamTrace.with_span "OpamFormat.fields" @@ fun () ->
     let parse ~pos items =
       (* For consistency, always read fields in ppa order, ignoring file
          order. Some parsers may depend on it. *)
diff --git a/src/format/opamPackage.ml b/src/format/opamPackage.ml
index f9b3d93c852..a318b63f39f 100644
--- a/src/format/opamPackage.ml
+++ b/src/format/opamPackage.ml
@@ -226,6 +226,9 @@ let of_archive f =
 let list dir =
   log "list %a" (slog OpamFilename.Dir.to_string) dir;
   if OpamFilename.exists_dir dir then (
+    OpamTrace.with_span "pkg.list-dir"
+      ~data:["dir", `String (OpamFilename.Dir.to_string dir)] @@ fun () ->
+
     let files = OpamFilename.rec_files dir in
     List.fold_left (fun set f ->
         match of_filename f with
diff --git a/src/format/opamPp.ml b/src/format/opamPp.ml
index 634947d9a5f..62a352df65a 100644
--- a/src/format/opamPp.ml
+++ b/src/format/opamPp.ml
@@ -88,7 +88,8 @@ let unexpected ?pos () = raise (Unexpected pos)
 
 (** Basic pp usage *)
 
-let parse pp ~pos x = try pp.parse ~pos x with
+let parse pp ~pos x =
+  try pp.parse ~pos x with
   | Bad_version _ | Bad_format _ | Bad_format_list _ as e ->
     raise (add_pos pos e)
   | Unexpected (Some pos) -> bad_format ~pos "expected %s" pp.ppname
diff --git a/src/format/opamSwitch.ml b/src/format/opamSwitch.ml
index c6704f911a0..ec9e4dca915 100644
--- a/src/format/opamSwitch.ml
+++ b/src/format/opamSwitch.ml
@@ -20,6 +20,9 @@ let is_external s =
 let external_dirname = "_opam"
 
 let check s =
+  OpamTrace.with_span "opamSwitch.check"
+      ~data:["len", `Float (float_of_int (String.length s))] @@ fun () ->
+
   if String.compare s "" = 0 &&
     let re =
       Re.(compile @@
diff --git a/src/repository/opamDownload.ml b/src/repository/opamDownload.ml
index f67e7a827ba..34dd568ea41 100644
--- a/src/repository/opamDownload.ml
+++ b/src/repository/opamDownload.ml
@@ -57,7 +57,7 @@ let ftp_args = [
   CIdent "url", None;
 ]
 
-let download_args ~url ~out ~retry ?checksum ~compress () =
+let download_args ~url ~out ~retry ?checksum ~compress () : string list =
   let cmd, _ = Lazy.force OpamRepositoryConfig.(!r.download_tool) in
   let cmd =
     match cmd with
@@ -117,6 +117,8 @@ let tool_return url ret =
       else Done ()
 
 let download_command ~compress ?checksum ~url ~dst () =
+  OpamTrace.with_span "Download.download_command"
+      ~data:["url", `String (OpamUrl.to_string url)] @@ fun () ->
   let cmd, args =
     match
       download_args
diff --git a/src/repository/opamRepository.ml b/src/repository/opamRepository.ml
index 2ebe5ccc501..15018e7826e 100644
--- a/src/repository/opamRepository.ml
+++ b/src/repository/opamRepository.ml
@@ -376,6 +376,8 @@ let revision dirname url =
 
 let pull_file label ?cache_dir ?(cache_urls=[])  ?(silent_hits=false)
     file checksums remote_urls =
+  OpamTrace.with_span "repository.pull-file"
+    ~data:["f", `String (OpamFilename.to_string file)] @@ fun () ->
   (match cache_dir with
    | Some cache_dir ->
      let text = OpamProcess.make_command_text label "dl" in
@@ -438,6 +440,7 @@ let packages_with_prefixes repo_root =
   OpamPackage.prefixes (OpamRepositoryPath.packages_dir repo_root)
 
 let validate_repo_update repo repo_root update =
+  OpamTrace.with_span "repository.validate-repo-update" @@ fun () ->
   match
     repo.repo_trust,
     OpamRepositoryConfig.(!r.validation_hook),
@@ -529,6 +532,7 @@ let cleanup_repo_update upd =
     | _ -> ()
 
 let update repo repo_root =
+  OpamTrace.with_span "repository.update" @@ fun () ->
   log "update %a" (slog OpamRepositoryBackend.to_string) repo;
   let module B = (val find_backend repo: OpamRepositoryBackend.S) in
   B.fetch_repo_update repo.repo_name repo_root repo.repo_url @@+ function
diff --git a/src/solver/opamCudf.ml b/src/solver/opamCudf.ml
index 9f6f8390ef8..8205418799b 100644
--- a/src/solver/opamCudf.ml
+++ b/src/solver/opamCudf.ml
@@ -1524,6 +1524,7 @@ let call_external_solver ~version_map univ req =
     Dose_algo.Depsolver.Sat(None,Cudf.load_universe [])
 
 let check_request ?(explain=true) ~version_map univ req =
+  OpamTrace.with_span "Cudf.check_request" @@ fun () ->
   let chrono = OpamConsole.timer () in
   log "Checking request...";
   let result = Dose_algo.Depsolver.check_request ~explain (to_cudf univ req) in
@@ -1546,6 +1547,7 @@ let check_request ?(explain=true) ~version_map univ req =
 
 (* Return the universe in which the system has to go *)
 let get_final_universe ~version_map univ req =
+  OpamTrace.with_span "Cudf.get_final_universe" @@ fun () ->
   let fail msg =
     let f = dump_cudf_error ~version_map univ req in
     let msg =
@@ -1593,6 +1595,7 @@ let actions_of_diff (install, remove) =
   actions
 
 let resolve ~extern ~version_map universe request =
+  OpamTrace.with_span "Cudf.resolve" @@ fun () ->
   log "resolve request=%a" (slog string_of_request) request;
   let resp =
     let check () = check_request ~version_map universe request in
diff --git a/src/solver/opamSolver.ml b/src/solver/opamSolver.ml
index bd68b18327f..8b789f4d9b8 100644
--- a/src/solver/opamSolver.ml
+++ b/src/solver/opamSolver.ml
@@ -331,6 +331,7 @@ let opam2cudf_set universe version_map packages =
       OpamCudf.Set.empty
 
 let load_cudf_packages opam_universe ?version_map opam_packages =
+  OpamTrace.with_span "Solver.load_cudf_packages" @@ fun () ->
   let chrono = OpamConsole.timer () in
   let version_map = match version_map with
     | Some vm -> vm
@@ -367,6 +368,7 @@ let map_to_cudf_universe cudf_packages_map =
 
 (* load a cudf universe from an opam one *)
 let load_cudf_universe opam_universe ?version_map opam_packages =
+  OpamTrace.with_span "Solver.load_cudf_universe" @@ fun () ->
   let load_f = load_cudf_packages opam_universe ?version_map opam_packages in
   fun ?add_invariant ?depopts ~build ~post () ->
     log "Load cudf universe (depopts:%a, build:%b, post:%b)"
@@ -436,6 +438,7 @@ let cycle_conflict ~version_map univ cycles =
   OpamCudf.cycle_conflict ~version_map univ cycles
 
 let resolve universe request =
+  OpamTrace.with_span "Solver.resolve" @@ fun () ->
   log "resolve request=%a" (slog string_of_request) request;
   let all_packages = universe.u_available ++ universe.u_installed in
   let version_map = cudf_versions_map universe in
@@ -464,6 +467,7 @@ let resolve universe request =
     opam_invariant_package version_map universe.u_invariant
   in
   let solution =
+    OpamTrace.with_span "Solver.resolve.solution" @@ fun () ->
     try
       Cudf.add_package cudf_universe invariant_pkg;
       Cudf.add_package cudf_universe deprequest_pkg;
@@ -585,6 +589,7 @@ let dependency_graph
   g
 
 let dependency_sort ~depopts ~build ~post universe packages =
+  OpamTrace.with_span "Solver.dependency_sort" @@ fun () ->
   let cudf_universe, cudf_packages =
     load_cudf_universe_with_packages
       ~depopts ~build ~post universe universe.u_packages packages
diff --git a/src/state/opamFileTools.ml b/src/state/opamFileTools.ml
index df182e48893..0ec58c1bb06 100644
--- a/src/state/opamFileTools.ml
+++ b/src/state/opamFileTools.ml
@@ -1180,6 +1180,8 @@ let add_aux_files ?dir ~files_subdir_hashes opam =
     opam
 
 let read_opam dir =
+  OpamTrace.with_span "FileTools.read_opam"
+      ~data:["dir", `String (OpamFilename.Dir.to_string dir)] @@ fun () ->
   let (opam_file: OpamFile.OPAM.t OpamFile.t) =
     OpamFile.make (dir // "opam")
   in
diff --git a/src/state/opamGlobalState.ml b/src/state/opamGlobalState.ml
index 811d20da2e1..7b07292361e 100644
--- a/src/state/opamGlobalState.ml
+++ b/src/state/opamGlobalState.ml
@@ -196,6 +196,7 @@ let write gt =
   OpamFile.Config.write (OpamPath.config gt.root) gt.config
 
 let fix_switch_list gt =
+  OpamTrace.with_span "GlobalState.fix_switch_list" @@ fun () ->
   let known_switches0 = switches gt in
   let known_switches =
     match OpamStateConfig.get_switch_opt () with
diff --git a/src/state/opamRepositoryState.ml b/src/state/opamRepositoryState.ml
index f3f84343bb5..ab08956e32c 100644
--- a/src/state/opamRepositoryState.ml
+++ b/src/state/opamRepositoryState.ml
@@ -253,6 +253,7 @@ let find_package_opt rt repo_list nv =
     None repo_list
 
 let build_index rt repo_list =
+  OpamTrace.with_span "RepositoryState.build_index" @@ fun () ->
   List.fold_left (fun acc repo_name ->
       try
         let repo_opams = OpamRepositoryName.Map.find repo_name rt.repo_opams in
diff --git a/src/state/opamStateConfig.ml b/src/state/opamStateConfig.ml
index 6d1eea5ac7a..c01863f4406 100644
--- a/src/state/opamStateConfig.ml
+++ b/src/state/opamStateConfig.ml
@@ -229,6 +229,7 @@ let is_newer_than_self ?lock_kind gt =
   is_readonly_opamroot_t ?lock_kind gt <> Some false
 
 let load_if_possible_raw ?lock_kind root version (read,read_wo_err) f =
+  OpamTrace.with_span "StateConfig.load_if_possible_raw" @@ fun () ->
   match is_readonly_opamroot_raw ?lock_kind version with
   | None ->
     OpamConsole.error_and_exit `Locked
@@ -270,6 +271,7 @@ let load ?lock_kind opamroot =
 module Switch = struct
 
   let load_raw ?lock_kind root config readf switch =
+    OpamTrace.with_span "StateConfig.Switch.load_raw" @@ fun () ->
     load_if_possible_t ?lock_kind root config readf
       (OpamPath.Switch.switch_config root switch)
 
@@ -293,6 +295,7 @@ module Switch = struct
       switch
 
   let safe_read_selections ?lock_kind gt switch =
+    OpamTrace.with_span "StateConfig.safe_read_selections" @@ fun () ->
     load_if_possible ?lock_kind gt
       OpamFile.SwitchSelections.(safe read_opt BestEffort.read_opt empty)
       (OpamPath.Switch.selections gt.root switch)
@@ -302,6 +305,7 @@ end
 (* repos *)
 module Repos = struct
   let safe_read ?lock_kind gt =
+    OpamTrace.with_span "StateConfig.Repos.safe_read" @@ fun () ->
     load_if_possible ?lock_kind gt
       OpamFile.Repos_config.(safe read_opt BestEffort.read_opt empty)
       (OpamPath.repos_config gt.root)
@@ -331,6 +335,7 @@ let downgrade_2_1_switch f =
           |> OpamFile.Switch_config.read_from_string)
 
 let local_switch_exists root switch =
+  OpamTrace.with_span "StateConfig.local_switch_exists" @@ fun () ->
   (* we don't use safe loading function to avoid errors displaying *)
   let f = OpamPath.Switch.switch_config root switch in
   match OpamFile.Switch_config.BestEffort.read_opt f with
@@ -348,6 +353,7 @@ let local_switch_exists root switch =
         else false
 
 let resolve_local_switch root s =
+  OpamTrace.with_span "opamStateConfig.resolve_local_switch" @@ fun () ->
   let switch_root = OpamSwitch.get_root root s in
   if OpamSwitch.is_external s && OpamFilename.dirname_dir switch_root = root
   then OpamSwitch.of_string (OpamFilename.remove_prefix_dir root switch_root)
@@ -366,6 +372,7 @@ let get_current_switch_from_cwd root =
 
 (* do we want `load_defaults` to fail / run a format upgrade ? *)
 let load_defaults ?lock_kind root_dir =
+  OpamTrace.with_span "opam-state.load-defaults" @@ fun () ->
   let current_switch =
     match E.switch () with
     | Some "" | None -> get_current_switch_from_cwd root_dir
diff --git a/src/state/opamSwitchState.ml b/src/state/opamSwitchState.ml
index 1f1649062b2..07c995124fa 100644
--- a/src/state/opamSwitchState.ml
+++ b/src/state/opamSwitchState.ml
@@ -230,6 +230,7 @@ let depexts_unavailable_raw sys_packages nv =
   | _ -> None
 
 let load lock_kind gt rt switch =
+  OpamTrace.with_span "SwitchState.load" @@ fun () ->
   OpamFormatUpgrade.as_necessary_repo_switch_light_upgrade lock_kind `Switch gt;
   let chrono = OpamConsole.timer () in
   log "LOAD-SWITCH-STATE %@ %a" (slog OpamSwitch.to_string) switch;
@@ -617,6 +618,7 @@ let load lock_kind gt rt switch =
   st
 
 let load_virtual ?repos_list ?(avail_default=true) gt rt =
+  OpamTrace.with_span "SwitchState.load_virtual" @@ fun () ->
   let repos_list = match repos_list with
     | Some rl -> rl
     | None -> OpamGlobalState.repos_list gt
@@ -943,6 +945,7 @@ let universe st
     ?reinstall
     ~requested
     user_action =
+  OpamTrace.with_span "SwitchState.universe" @@ fun () ->
   let chrono = OpamConsole.timer () in
   let names = OpamPackage.names_of_packages requested in
   let requested_allpkgs =
diff --git a/src/state/opamSysInteract.ml b/src/state/opamSysInteract.ml
index df7a96cf33a..92f45a5e908 100644
--- a/src/state/opamSysInteract.ml
+++ b/src/state/opamSysInteract.ml
@@ -15,6 +15,8 @@ let log fmt = OpamConsole.log "XSYS" fmt
 
 let run_command
     ?vars ?(discard_err=false) ?allow_stdin ?verbose ?(dryrun=false) cmd args =
+  OpamTrace.with_span "sys-interact.run-command"
+    ~data:["cmd", `String cmd] @@ fun () ->
   let clean_output =
     if not discard_err then
       fun k -> k None
@@ -378,6 +380,7 @@ let yum_cmd = lazy begin
 end
 
 let packages_status ?(env=OpamVariable.Map.empty) config packages =
+  OpamTrace.with_span "sys-interact.packages_status" @@ fun () ->
   let (+++) pkg set = OpamSysPkg.Set.add (OpamSysPkg.of_string pkg) set in
   (* Some package managers don't permit to request on available packages. In
      this case, we consider all non installed packages as [available]. *)
@@ -467,6 +470,7 @@ let packages_status ?(env=OpamVariable.Map.empty) config packages =
   in
   let compute_sets_for_arch ~pacman =
     let get_avail_w_virtuals () =
+      OpamTrace.with_span "SysInteract.compute-sets-for-archs" @@ fun () ->
       let package_provided str =
         OpamSysPkg.of_string
           (match OpamStd.String.cut_at str '=' with
@@ -492,9 +496,12 @@ let packages_status ?(env=OpamVariable.Map.empty) config packages =
       *)
       (* Discard stderr to not have it pollute output. Plus, exit code is the
          number of packages not found. *)
-      run_command ~discard_err:true pacman ["-Si"]
-      |> snd
-      |> List.fold_left (fun (avail, provides, latest) l ->
+      let _, p = run_command ~discard_err:true pacman ["-Si"] in
+
+      OpamTrace.with_span "parse_pacman_output"
+          ~data:["n", `Float (float_of_int (List.length p))]
+      @@ fun () ->
+      List.fold_left (fun (avail, provides, latest) l ->
           match OpamStd.String.split l ' ' with
           | "Name"::":"::p::_ ->
             p +++ avail, provides, Some (OpamSysPkg.of_string p)
@@ -508,7 +515,7 @@ let packages_status ?(env=OpamVariable.Map.empty) config packages =
             in
             ps ++ avail, provides, None
           | _ -> avail, provides, latest)
-        (OpamSysPkg.Set.empty, OpamSysPkg.Map.empty, None)
+        (OpamSysPkg.Set.empty, OpamSysPkg.Map.empty, None) p
       |> (fun (a,p,_) -> a,p)
     in
     let get_installed str_pkgs =
@@ -518,6 +525,8 @@ let packages_status ?(env=OpamVariable.Map.empty) config packages =
          >extra/cmark 0.29.0-1
          >    CommonMark parsing and rendering library and program in C
       *)
+      OpamTrace.with_span "SysInteract.get_installed" @@ fun () ->
+
       let re_pkg =
         Re.(compile @@ seq
               [ bol;
@@ -991,6 +1000,7 @@ let package_manager_name ?env config =
   | [] -> assert false
 
 let sudo_run_command ?(env=OpamVariable.Map.empty) ?vars cmd args =
+  OpamTrace.with_span "sys-interact.sudo-run-cmd" @@ fun () ->
   let cmd, args =
     let not_root = Unix.getuid () <> 0  in
     match cmd, OpamSysPoll.os env with
diff --git a/src/state/opamUpdate.ml b/src/state/opamUpdate.ml
index 515a8d06454..33cda61320d 100644
--- a/src/state/opamUpdate.ml
+++ b/src/state/opamUpdate.ml
@@ -48,6 +48,9 @@ let eval_redirect gt repo repo_root =
     | None -> None
 
 let repository rt repo =
+  OpamTrace.with_span "Update.repository"
+      ~data:["name", `String (OpamRepositoryName.to_string repo.repo_name)]
+  @@ fun () ->
   let max_loop = 10 in
   let gt = rt.repos_global in
   if repo.repo_url = OpamUrl.empty then Done None else
@@ -161,6 +164,10 @@ let repository rt repo =
 
 let repositories rt repos =
   let command repo =
+    OpamTrace.with_span "Update.repository"
+      ~data:["name", `String (OpamRepositoryName.to_string repo.repo_name)]
+    @@ fun () ->
+
     OpamProcess.Job.catch
       (fun ex ->
          OpamStd.Exn.fatal ex;
@@ -198,6 +205,8 @@ let repositories rt repos =
   failed, rt
 
 let fetch_dev_package url srcdir ?(working_dir=false) ?subpath nv =
+  OpamTrace.with_span "Update.fetch_dev_package"
+      ~data:["pkg", `String (OpamPackage.to_string nv)] @@ fun () ->
   let remote_url = OpamFile.URL.url url in
   let mirrors = remote_url :: OpamFile.URL.mirrors url in
   let checksum = OpamFile.URL.checksum url in
@@ -433,6 +442,7 @@ let dev_package st ?autolock ?working_dir nv =
       (fun st -> st), match result with Result () -> true | _ -> false
 
 let dev_packages st ?autolock ?(working_dir=OpamPackage.Set.empty) packages =
+  OpamTrace.with_span "Update.dev_packages" @@ fun () ->
   log "update-dev-packages";
   let command nv =
     let working_dir = OpamPackage.Set.mem nv working_dir in
@@ -471,6 +481,7 @@ let dev_packages st ?autolock ?(working_dir=OpamPackage.Set.empty) packages =
   success, st, updated_set
 
 let pinned_packages st ?autolock ?(working_dir=OpamPackage.Name.Set.empty) names =
+  OpamTrace.with_span "Update.pinned_packages" @@ fun () ->
   log "update-pinned-packages";
   let command name =
     let working_dir = OpamPackage.Name.Set.mem name working_dir in
@@ -539,6 +550,7 @@ let active_caches st nvs =
   global_cache @ repo_cache
 
 let cleanup_source st old_opam_opt new_opam =
+  OpamTrace.with_span "Update.cleanup_source" @@ fun () ->
   let open OpamStd.Option.Op in
   let base_url urlf =
     let u = OpamFile.URL.url urlf in
@@ -559,6 +571,7 @@ let cleanup_source st old_opam_opt new_opam =
       (OpamSwitchState.source_dir st (OpamFile.OPAM.package new_opam))
 
 let download_package_source_t st url nv_dirs =
+  OpamTrace.with_span "Update.downl0ad_package_source" @@ fun () ->
   let cache_dir = OpamRepositoryPath.download_cache st.switch_global.root in
   let cache_urls = active_caches st (List.map fst nv_dirs) in
   let fetch_source_job =

From c64b4848d54345f4af5148c0a1b9c61b35ef031a Mon Sep 17 00:00:00 2001
From: Simon Cruanes <simon.cruanes.2007@m4x.org>
Date: Sun, 10 Dec 2023 21:40:36 -0500
Subject: [PATCH 2/2] perf: optimize OpamString.split

this cuts the time spent on parsing `pacman -Si` significantly down
---
 src/core/opamStd.ml | 24 +++++++++++++++++++++---
 1 file changed, 21 insertions(+), 3 deletions(-)

diff --git a/src/core/opamStd.ml b/src/core/opamStd.ml
index f1f39390271..938fb4ea27b 100644
--- a/src/core/opamStd.ml
+++ b/src/core/opamStd.ml
@@ -692,9 +692,27 @@ module OpamString = struct
   let rcut_at = cut_at_aux String.rindex
 
   let split s c =
-    (* old compat version (Re 1.2.0)
-       {[Re_str.split (Re_str.regexp (Printf.sprintf "[%c]+" c)) s]} *)
-    Re.(split (compile (rep1 (char c)))) s
+    let acc = ref [] in
+    let in_run = ref false in
+    let slice_start = ref 0 in
+
+    for i=0 to String.length s-1 do
+      if String.get s i = c then (
+        if not !in_run then (
+          if i > !slice_start then
+            acc := String.sub s !slice_start (i - !slice_start) :: !acc;
+          in_run := true;
+        )
+      ) else (
+        if !in_run then (
+          in_run := false;
+          slice_start := i;
+        )
+      )
+    done;
+    if not !in_run && !slice_start < String.length s then
+      acc := String.sub s !slice_start (String.length s - !slice_start) :: !acc;
+    List.rev !acc
 
   let split_delim s c =
     let tokens = Re.(split_full (compile (char c)) s) in