Skip to content

Commit

Permalink
[cache] break reference in m_deps
Browse files Browse the repository at this point in the history
  • Loading branch information
kLabz committed Jul 18, 2023
1 parent 27053ae commit 03a93d2
Show file tree
Hide file tree
Showing 7 changed files with 34 additions and 19 deletions.
4 changes: 3 additions & 1 deletion src/codegen/codegen.ml
Original file line number Diff line number Diff line change
Expand Up @@ -381,13 +381,15 @@ module Dump = struct
| None -> platform_name_macro com
| Some s -> s
in
let cc = CommonCache.get_cache com in
let dump_dependencies_path = [dump_path com;target_name;"dependencies"] in
let buf,close = create_dumpfile [] dump_dependencies_path in
let print fmt = Printf.kprintf (fun s -> Buffer.add_string buf s) fmt in
let dep = Hashtbl.create 0 in
List.iter (fun m ->
print "%s:\n" (Path.UniqueKey.lazy_path m.m_extra.m_file);
PMap.iter (fun _ m2 ->
PMap.iter (fun _ mpath ->
let m2 = cc#find_module mpath in
let file = Path.UniqueKey.lazy_path m2.m_extra.m_file in
print "\t%s\n" file;
let l = try Hashtbl.find dep file with Not_found -> [] in
Expand Down
10 changes: 8 additions & 2 deletions src/compiler/server.ml
Original file line number Diff line number Diff line change
Expand Up @@ -307,7 +307,9 @@ let check_module sctx ctx m p =
end
in
let check_dependencies () =
PMap.iter (fun _ m2 -> match check m2 with
PMap.iter (fun _ mpath ->
let m2 = cc#find_module mpath in
match check m2 with
| None -> ()
| Some reason -> raise (Dirty (DependencyDirty(m2.m_path,reason)))
) m.m_extra.m_deps;
Expand Down Expand Up @@ -393,6 +395,7 @@ let check_module sctx ctx m p =
context. *)
let add_modules sctx ctx m p =
let com = ctx.Typecore.com in
let cc = CommonCache.get_cache com in
let rec add_modules tabs m0 m =
if m.m_extra.m_added < ctx.com.compilation_step then begin
(match m0.m_extra.m_kind, m.m_extra.m_kind with
Expand All @@ -407,7 +410,10 @@ let add_modules sctx ctx m p =
) m.m_types;
TypeloadModule.ModuleLevel.add_module ctx m p;
PMap.iter (Hashtbl.replace com.resources) m.m_extra.m_binded_res;
PMap.iter (fun _ m2 -> add_modules (tabs ^ " ") m0 m2) m.m_extra.m_deps
PMap.iter (fun _ mpath ->
let m2 = cc#find_module mpath in
add_modules (tabs ^ " ") m0 m2
) m.m_extra.m_deps
)
end
in
Expand Down
22 changes: 13 additions & 9 deletions src/context/memory.ml
Original file line number Diff line number Diff line change
Expand Up @@ -33,12 +33,14 @@ let update_module_type_deps deps md =
) md.m_types;
!deps

let rec scan_module_deps m h =
let rec scan_module_deps cc m h =
if Hashtbl.mem h m.m_id then
()
else begin
Hashtbl.add h m.m_id m;
PMap.iter (fun _ m -> scan_module_deps m h) m.m_extra.m_deps
PMap.iter (fun _ mpath ->
let m = cc#find_module mpath in
scan_module_deps cc m h) m.m_extra.m_deps
end

let module_sign key md =
Expand All @@ -59,9 +61,9 @@ let collect_leaks m deps out =
let get_out out =
Obj.repr Common.memory_marker :: Obj.repr Typecore.memory_marker :: PMap.fold (fun m acc -> Obj.repr m :: acc) out []

let get_module_memory cs all_modules m =
let get_module_memory cc all_modules m =
let mdeps = Hashtbl.create 0 in
scan_module_deps m mdeps;
scan_module_deps cc m mdeps;
let deps = ref [Obj.repr null_module] in
let out = ref all_modules in
let deps = Hashtbl.fold (fun _ md deps ->
Expand Down Expand Up @@ -132,7 +134,7 @@ let get_memory_json (cs : CompilationCache.t) mreq =
let cc = cs#get_context sign in
let all_modules = List.fold_left (fun acc m -> PMap.add m.m_id m acc) PMap.empty cs#get_modules in
let l = Hashtbl.fold (fun _ m acc ->
(m,(get_module_memory cs all_modules m)) :: acc
(m,(get_module_memory cc all_modules m)) :: acc
) cc#get_modules [] in
let l = List.sort (fun (_,(size1,_)) (_,(size2,_)) -> compare size2 size1) l in
let leaks = ref [] in
Expand Down Expand Up @@ -171,7 +173,7 @@ let get_memory_json (cs : CompilationCache.t) mreq =
let cc = cs#get_context sign in
let m = cc#find_module path in
let all_modules = List.fold_left (fun acc m -> PMap.add m.m_id m acc) PMap.empty cs#get_modules in
let _,(_,deps,out,_) = get_module_memory cs all_modules m in
let _,(_,deps,out,_) = get_module_memory cc all_modules m in
let deps = update_module_type_deps deps m in
let out = get_out out in
let types = List.map (fun md ->
Expand Down Expand Up @@ -237,14 +239,15 @@ let display_memory com =
print ("Total Allocated Memory " ^ fmt_size (mem.Gc.heap_words * (Sys.word_size asr 8)));
print ("Free Memory " ^ fmt_size (mem.Gc.free_words * (Sys.word_size asr 8)));
let c = com.cs in
let cc = CommonCache.get_cache com in
print ("Total cache size " ^ size c);
(* print (" haxelib " ^ size c.c_haxelib); *)
(* print (" parsed ast " ^ size c.c_files ^ " (" ^ string_of_int (Hashtbl.length c.c_files) ^ " files stored)"); *)
(* print (" typed modules " ^ size c.c_modules ^ " (" ^ string_of_int (Hashtbl.length c.c_modules) ^ " modules stored)"); *)
let module_list = c#get_modules in
let all_modules = List.fold_left (fun acc m -> PMap.add m.m_id m acc) PMap.empty module_list in
let modules = List.fold_left (fun acc m ->
let (size,r) = get_module_memory c all_modules m in
let (size,r) = get_module_memory cc all_modules m in
(m,size,r) :: acc
) [] module_list in
let cur_key = ref "" and tcount = ref 0 and mcount = ref 0 in
Expand Down Expand Up @@ -272,8 +275,9 @@ let display_memory com =
());
if verbose then begin
print (Printf.sprintf " %d total deps" (List.length deps));
PMap.iter (fun _ md ->
print (Printf.sprintf " dep %s%s" (s_type_path md.m_path) (module_sign key md));
PMap.iter (fun _ mpath ->
let md = cc#find_module mpath in
print (Printf.sprintf " dep %s%s" (s_type_path mpath) (module_sign key md));
) m.m_extra.m_deps;
end;
flush stdout
Expand Down
11 changes: 7 additions & 4 deletions src/core/json/genjson.ml
Original file line number Diff line number Diff line change
Expand Up @@ -718,10 +718,13 @@ let generate_module cc m =
| MSGood -> "Good"
| MSBad reason -> Printer.s_module_skip_reason reason
| MSUnknown -> "Unknown");
"dependencies",jarray (PMap.fold (fun m acc -> (jobject [
"path",jstring (s_type_path m.m_path);
"sign",jstring (Digest.to_hex m.m_extra.m_sign);
]) :: acc) m.m_extra.m_deps []);
"dependencies",jarray (PMap.fold (fun mpath acc ->
let m = cc#find_module mpath in
(jobject [
"path",jstring (s_type_path mpath);
"sign",jstring (Digest.to_hex m.m_extra.m_sign);
]) :: acc
) m.m_extra.m_deps []);
"dependents",jarray (List.map (fun m -> (jobject [
"path",jstring (s_type_path m.m_path);
"sign",jstring (Digest.to_hex m.m_extra.m_sign);
Expand Down
2 changes: 1 addition & 1 deletion src/core/tFunctions.ml
Original file line number Diff line number Diff line change
Expand Up @@ -234,7 +234,7 @@ let null_abstract = {

let add_dependency ?(skip_postprocess=false) m mdep =
if m != null_module && m != mdep then begin
m.m_extra.m_deps <- PMap.add mdep.m_id mdep m.m_extra.m_deps;
m.m_extra.m_deps <- PMap.add mdep.m_id mdep.m_path m.m_extra.m_deps;
(* In case the module is cached, we'll have to run post-processing on it again (issue #10635) *)
if not skip_postprocess then m.m_extra.m_processed <- 0
end
Expand Down
2 changes: 1 addition & 1 deletion src/core/tPrinting.ml
Original file line number Diff line number Diff line change
Expand Up @@ -605,7 +605,7 @@ module Printer = struct
"m_cache_state",s_module_cache_state me.m_cache_state;
"m_added",string_of_int me.m_added;
"m_checked",string_of_int me.m_checked;
"m_deps",s_pmap string_of_int (fun m -> snd m.m_path) me.m_deps;
"m_deps",s_pmap string_of_int (fun m -> snd m) me.m_deps;
"m_processed",string_of_int me.m_processed;
"m_kind",s_module_kind me.m_kind;
"m_binded_res",""; (* TODO *)
Expand Down
2 changes: 1 addition & 1 deletion src/core/tType.ml
Original file line number Diff line number Diff line change
Expand Up @@ -390,7 +390,7 @@ and module_def_extra = {
mutable m_added : int;
mutable m_checked : int;
mutable m_processed : int;
mutable m_deps : (int,module_def) PMap.t;
mutable m_deps : (int,path) PMap.t;
mutable m_kind : module_kind;
mutable m_binded_res : (string, string) PMap.t;
mutable m_if_feature : (string *(tclass * tclass_field * bool)) list;
Expand Down

0 comments on commit 03a93d2

Please sign in to comment.