diff options
| -rw-r--r-- | lib/profile.ml | 32 | ||||
| -rw-r--r-- | lib/util.ml | 26 |
2 files changed, 27 insertions, 31 deletions
diff --git a/lib/profile.ml b/lib/profile.ml index fdea309b8..78caf0148 100644 --- a/lib/profile.ml +++ b/lib/profile.ml @@ -664,22 +664,20 @@ let profile7 e f a b c d g h i = (* Some utilities to compute the logical and physical sizes and depth of ML objects *) -open Obj - let c = ref 0 let s = ref 0 let b = ref 0 let m = ref 0 let rec obj_stats d t = - if is_int t then m := max d !m - else if tag t >= no_scan_tag then - if tag t = string_tag then - (c := !c + size t; b := !b + 1; m := max d !m) - else if tag t = double_tag then + if Obj.is_int t then m := max d !m + else if Obj.tag t >= Obj.no_scan_tag then + if Obj.tag t = Obj.string_tag then + (c := !c + Obj.size t; b := !b + 1; m := max d !m) + else if Obj.tag t = Obj.double_tag then (s := !s + 2; b := !b + 1; m := max d !m) - else if tag t = double_array_tag then - (s := !s + 2 * size t; b := !b + 1; m := max d !m) + else if Obj.tag t = Obj.double_array_tag then + (s := !s + 2 * Obj.size t; b := !b + 1; m := max d !m) else (b := !b + 1; m := max d !m) else let n = Obj.size t in @@ -687,7 +685,7 @@ let rec obj_stats d t = block_stats (d + 1) (n - 1) t and block_stats d i t = - if i >= 0 then (obj_stats d (field t i); block_stats d (i-1) t) + if i >= 0 then (obj_stats d (Obj.field t i); block_stats d (i-1) t) let obj_stats a = c := 0; s:= 0; b:= 0; m:= 0; @@ -698,21 +696,21 @@ module H = Hashtbl.Make( struct type t = Obj.t let equal = (==) - let hash o = Hashtbl.hash (magic o : int) + let hash o = Hashtbl.hash (Obj.magic o : int) end) let tbl = H.create 13 let rec obj_shared_size s t = - if is_int t then s + if Obj.is_int t then s else if H.mem tbl t then s else begin H.add tbl t (); let n = Obj.size t in - if tag t >= no_scan_tag then - if tag t = string_tag then (c := !c + n; s + 1) - else if tag t = double_tag then s + 3 - else if tag t = double_array_tag then s + 2 * n + 1 + if Obj.tag t >= Obj.no_scan_tag then + if Obj.tag t = Obj.string_tag then (c := !c + n; s + 1) + else if Obj.tag t = Obj.double_tag then s + 3 + else if Obj.tag t = Obj.double_array_tag then s + 2 * n + 1 else s + 1 else block_shared_size (s + n + 1) (n - 1) t @@ -720,7 +718,7 @@ let rec obj_shared_size s t = and block_shared_size s i t = if i < 0 then s - else block_shared_size (obj_shared_size s (field t i)) (i-1) t + else block_shared_size (obj_shared_size s (Obj.field t i)) (i-1) t let obj_shared_size a = H.clear tbl; diff --git a/lib/util.ml b/lib/util.ml index cdd351930..9f29d55bd 100644 --- a/lib/util.ml +++ b/lib/util.ml @@ -1442,8 +1442,6 @@ let memon_eq eq n f = module Size = struct - open Obj - (*s Pointers already visited are stored in a hash-table, where comparisons are done using physical equality. *) @@ -1451,7 +1449,7 @@ module Size = struct struct type t = Obj.t let equal = (==) - let hash o = Hashtbl.hash (magic o : int) + let hash o = Hashtbl.hash (Obj.magic o : int) end) let node_table = (H.create 257 : unit H.t) @@ -1465,27 +1463,27 @@ module Size = struct (*s Objects are traversed recursively, as soon as their tags are less than [no_scan_tag]. [count] records the numbers of words already visited. *) - let size_of_double = size (repr 1.0) + let size_of_double = Obj.size (Obj.repr 1.0) let count = ref 0 let rec traverse t = if not (in_table t) then begin add_in_table t; - if is_block t then begin - let n = size t in - let tag = tag t in - if tag < no_scan_tag then begin + if Obj.is_block t then begin + let n = Obj.size t in + let tag = Obj.tag t in + if tag < Obj.no_scan_tag then begin count := !count + 1 + n; for i = 0 to n - 1 do - let f = field t i in - if is_block f then traverse f + let f = Obj.field t i in + if Obj.is_block f then traverse f done - end else if tag = string_tag then + end else if tag = Obj.string_tag then count := !count + 1 + n - else if tag = double_tag then + else if tag = Obj.double_tag then count := !count + size_of_double - else if tag = double_array_tag then + else if tag = Obj.double_array_tag then count := !count + 1 + size_of_double * n else incr count @@ -1498,7 +1496,7 @@ module Size = struct let size_w o = reset_table (); count := 0; - traverse (repr o); + traverse (Obj.repr o); !count let size_b o = (size_w o) * (Sys.word_size / 8) |