diff --git a/src-json/define.json b/src-json/define.json index 28d13c75039..e21240a3ab5 100644 --- a/src-json/define.json +++ b/src-json/define.json @@ -261,6 +261,11 @@ "platforms": ["hl"], "params": ["version"] }, + { + "name": "HxbTimes", + "define": "hxb-times", + "doc": "Display hxb timing when used with `--times`." + }, { "name": "HxcppApiLevel", "define": "hxcpp-api-level", diff --git a/src/compiler/hxb/hxbLib.ml b/src/compiler/hxb/hxbLib.ml index 4b52fb28d5b..0e22a81a44d 100644 --- a/src/compiler/hxb/hxbLib.ml +++ b/src/compiler/hxb/hxbLib.ml @@ -2,7 +2,7 @@ open Globals open Common open ExtString -class hxb_library file_path = object(self) +class hxb_library file_path hxb_times = object(self) inherit abstract_hxb_lib val zip = lazy (Zip.open_in file_path) @@ -19,7 +19,7 @@ class hxb_library file_path = object(self) let close = Timer.timer ["hxblib";"read"] in List.iter (function | ({ Zip.filename = "StringPool.hxb" | "StringPool.macro.hxb" as filename} as entry) -> - let reader = new HxbReader.hxb_reader (["hxb";"internal"],"StringPool") (HxbReader.create_hxb_reader_stats()) None in + let reader = new HxbReader.hxb_reader (["hxb";"internal"],"StringPool") (HxbReader.create_hxb_reader_stats()) None hxb_times in let zip = Lazy.force zip in let data = Bytes.unsafe_of_string (Zip.read_entry zip entry) in ignore(reader#read (new HxbReaderApi.hxb_reader_api_null) data STR); @@ -74,4 +74,4 @@ let create_hxb_lib com file_path = with Not_found -> failwith ("hxb lib " ^ file_path ^ " not found") in - new hxb_library file + new hxb_library file (Common.defined com Define.HxbTimes) diff --git a/src/compiler/hxb/hxbReader.ml b/src/compiler/hxb/hxbReader.ml index 258e724237f..7286185fa71 100644 --- a/src/compiler/hxb/hxbReader.ml +++ b/src/compiler/hxb/hxbReader.ml @@ -149,6 +149,7 @@ class hxb_reader (mpath : path) (stats : hxb_reader_stats) (string_pool : string array option) + (timers_enabled : bool) = object(self) val mutable api = Obj.magic "" val mutable current_module = null_module @@ -2000,7 +2001,7 @@ class hxb_reader method private read_chunk_data kind = let path = String.concat "_" (ExtLib.String.nsplit (s_type_path mpath) ".") in let id = ["hxb";"read";string_of_chunk_kind kind;path] in - let close = Timer.timer id in + let close = if timers_enabled then Timer.timer id else fun() -> () in try self#read_chunk_data' kind with Invalid_argument msg -> begin diff --git a/src/compiler/server.ml b/src/compiler/server.ml index 8c03403ef8e..502582f920b 100644 --- a/src/compiler/server.ml +++ b/src/compiler/server.ml @@ -417,7 +417,7 @@ class hxb_reader_api_server | GoodModule m -> m | BinaryModule mc -> - let reader = new HxbReader.hxb_reader path com.hxb_reader_stats (Some cc#get_string_pool_arr) in + let reader = new HxbReader.hxb_reader path com.hxb_reader_stats (Some cc#get_string_pool_arr) (Common.defined com Define.HxbTimes) in let f_next chunks until = let t_hxb = Timer.timer ["server";"module cache";"hxb read"] in let r = reader#read_chunks_until (self :> HxbReaderApi.hxb_reader_api) chunks until in @@ -567,7 +567,7 @@ and type_module sctx com delay mpath p = checking dependencies. This means that the actual decoding never has any reason to fail. *) begin match check_module sctx mpath mc.mc_extra p with | None -> - let reader = new HxbReader.hxb_reader mpath com.hxb_reader_stats (Some cc#get_string_pool_arr) in + let reader = new HxbReader.hxb_reader mpath com.hxb_reader_stats (Some cc#get_string_pool_arr) (Common.defined com Define.HxbTimes) in let api = match com.hxb_reader_api with | Some api -> api diff --git a/src/context/display/displayJson.ml b/src/context/display/displayJson.ml index 7818c4ff03b..8c85e6aa722 100644 --- a/src/context/display/displayJson.ml +++ b/src/context/display/displayJson.ml @@ -139,7 +139,7 @@ class hxb_reader_api_com cc#find_module m_path with Not_found -> let mc = cc#get_hxb_module m_path in - let reader = new HxbReader.hxb_reader mc.mc_path com.hxb_reader_stats (Some cc#get_string_pool_arr) in + let reader = new HxbReader.hxb_reader mc.mc_path com.hxb_reader_stats (Some cc#get_string_pool_arr) (Common.defined com Define.HxbTimes) in fst (reader#read_chunks_until (self :> HxbReaderApi.hxb_reader_api) mc.mc_chunks (if headers_only then MTF else EOM)) method basic_types = diff --git a/src/context/display/displayTexpr.ml b/src/context/display/displayTexpr.ml index 35197e67233..4ed9021e977 100644 --- a/src/context/display/displayTexpr.ml +++ b/src/context/display/displayTexpr.ml @@ -177,7 +177,7 @@ let check_display_file ctx cs = | NoModule | BadModule _ -> raise Not_found | BinaryModule mc -> let api = (new TypeloadModule.hxb_reader_api_typeload ctx.com ctx.g TypeloadModule.load_module' p :> HxbReaderApi.hxb_reader_api) in - let reader = new HxbReader.hxb_reader path ctx.com.hxb_reader_stats (Some cc#get_string_pool_arr) in + let reader = new HxbReader.hxb_reader path ctx.com.hxb_reader_stats (Some cc#get_string_pool_arr) (Common.defined ctx.com Define.HxbTimes) in let m = reader#read_chunks api mc.mc_chunks in m | GoodModule m -> diff --git a/src/typing/typeloadModule.ml b/src/typing/typeloadModule.ml index f7e7db517be..99618e9e3b4 100644 --- a/src/typing/typeloadModule.ml +++ b/src/typing/typeloadModule.ml @@ -779,7 +779,7 @@ let rec load_hxb_module com g path p = let read file bytes string_pool = try let api = (new hxb_reader_api_typeload com g load_module' p :> HxbReaderApi.hxb_reader_api) in - let reader = new HxbReader.hxb_reader path com.hxb_reader_stats string_pool in + let reader = new HxbReader.hxb_reader path com.hxb_reader_stats string_pool (Common.defined com Define.HxbTimes) in let read = reader#read api bytes in let m = read EOT in delay g PConnectField (fun () ->