diff options
Diffstat (limited to 'lib/profile.ml')
| -rw-r--r-- | lib/profile.ml | 96 |
1 files changed, 48 insertions, 48 deletions
diff --git a/lib/profile.ml b/lib/profile.ml index dd7e977e..7bf71d0b 100644 --- a/lib/profile.ml +++ b/lib/profile.ml @@ -6,7 +6,7 @@ (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) -(* $Id: profile.ml 7538 2005-11-08 17:14:52Z herbelin $ *) +(* $Id$ *) open Gc @@ -17,8 +17,7 @@ let float_of_time t = float_of_int t /. 100. let time_of_float f = int_of_float (f *. 100.) let get_time () = - let {Unix.tms_utime = ut;Unix.tms_stime = st} = Unix.times () in - time_of_float (ut +. st) + time_of_float (Sys.time ()) (* Since ocaml 3.01, gc statistics are in float *) let get_alloc () = @@ -113,12 +112,12 @@ let ajoute_to_list ((name,n) as e) l = with Not_found -> e::l let magic = 1249 - + let merge_profile filename (curr_table, curr_outside, curr_total as new_data) = let (old_table, old_outside, old_total) = - try + try let c = open_in filename in - if input_binary_int c <> magic + if input_binary_int c <> magic then Printf.printf "Incompatible recording file: %s\n" filename; let old_data = input_value c in close_in c; @@ -134,7 +133,7 @@ let merge_profile filename (curr_table, curr_outside, curr_total as new_data) = begin (try let c = - open_out_gen + open_out_gen [Open_creat;Open_wronly;Open_trunc;Open_binary] 0o644 filename in output_binary_int c magic; output_value c updated_data; @@ -157,7 +156,10 @@ let merge_profile filename (curr_table, curr_outside, curr_total as new_data) = (* Unix measure of time is approximative and shoitt delays are often unperceivable; therefore, total times are measured in one (big) step to avoid rounding errors and to get the best possible - approximation *) + approximation. + Note: Sys.time is the same as: + Unix.(let x = times () in x.tms_utime +. x.tms_stime) + *) (* ---------- start profile for f1 @@ -186,7 +188,7 @@ overheadA| ... real 2' | ... ---------- end 2nd f2 overheadC| ... - ---------- [2'w2] 2nd call to get_time for 2nd f2 + ---------- [2'w2] 2nd call to get_time for 2nd f2 overheadD| ... ---------- end profile for f2 real 1 | ... @@ -242,7 +244,7 @@ let time_overhead_A_D () = ajoute_totalloc p (e.totalloc-.totalloc0); p.intcount <- p.intcount + e.intcount - intcount0 + 1; p.immcount <- p.immcount + 1; - if not (p==e) then + if not (p==e) then (match !dummy_stack with [] -> assert false | _::s -> stack := s); dummy_last_alloc := get_alloc () done; @@ -279,7 +281,7 @@ let compute_alloc lo = lo /. (float_of_int word_length) let format_profile (table, outside, total) = print_newline (); - Printf.printf + Printf.printf "%-23s %9s %9s %10s %10s %10s\n" "Function name" "Own time" "Tot. time" "Own alloc" "Tot. alloc" "Calls "; let l = Sort.list (fun (_,{tottime=p}) (_,{tottime=p'}) -> p > p') table in @@ -293,7 +295,7 @@ let format_profile (table, outside, total) = e.owncount e.intcount) l; Printf.printf "%-23s %9.2f %9.2f %10.0f %10.0f %6d\n" - "others" + "others" (float_of_time outside.owntime) (float_of_time outside.tottime) (compute_alloc outside.ownalloc) (compute_alloc outside.totalloc) @@ -305,7 +307,7 @@ let format_profile (table, outside, total) = (compute_alloc total.ownalloc) (compute_alloc total.totalloc); Printf.printf - "Time in seconds and allocation in words (1 word = %d bytes)\n" + "Time in seconds and allocation in words (1 word = %d bytes)\n" word_length let recording_file = ref "" @@ -319,7 +321,7 @@ let adjust_time ov_bc ov_ad e = tottime = e.tottime - int_of_float (abcd_all +. bc_imm); owntime = e.owntime - int_of_float (ad_imm +. bc_imm) } -let close_profile print = +let close_profile print = let dw = spent_alloc () in let t = get_time () in match !stack with @@ -390,7 +392,7 @@ let profile1 e f a = ajoute_totalloc p (e.totalloc -. totalloc0); p.intcount <- p.intcount + e.intcount - intcount0 + 1; p.immcount <- p.immcount + 1; - if not (p==e) then + if not (p==e) then (match !stack with [] -> assert false | _::s -> stack := s); last_alloc := get_alloc (); r @@ -404,7 +406,7 @@ let profile1 e f a = ajoute_totalloc p (e.totalloc -. totalloc0); p.intcount <- p.intcount + e.intcount - intcount0 + 1; p.immcount <- p.immcount + 1; - if not (p==e) then + if not (p==e) then (match !stack with [] -> assert false | _::s -> stack := s); last_alloc := get_alloc (); raise exn @@ -432,7 +434,7 @@ let profile2 e f a b = ajoute_totalloc p (e.totalloc -. totalloc0); p.intcount <- p.intcount + e.intcount - intcount0 + 1; p.immcount <- p.immcount + 1; - if not (p==e) then + if not (p==e) then (match !stack with [] -> assert false | _::s -> stack := s); last_alloc := get_alloc (); r @@ -446,7 +448,7 @@ let profile2 e f a b = ajoute_totalloc p (e.totalloc -. totalloc0); p.intcount <- p.intcount + e.intcount - intcount0 + 1; p.immcount <- p.immcount + 1; - if not (p==e) then + if not (p==e) then (match !stack with [] -> assert false | _::s -> stack := s); last_alloc := get_alloc (); raise exn @@ -474,7 +476,7 @@ let profile3 e f a b c = ajoute_totalloc p (e.totalloc -. totalloc0); p.intcount <- p.intcount + e.intcount - intcount0 + 1; p.immcount <- p.immcount + 1; - if not (p==e) then + if not (p==e) then (match !stack with [] -> assert false | _::s -> stack := s); last_alloc := get_alloc (); r @@ -488,7 +490,7 @@ let profile3 e f a b c = ajoute_totalloc p (e.totalloc -. totalloc0); p.intcount <- p.intcount + e.intcount - intcount0 + 1; p.immcount <- p.immcount + 1; - if not (p==e) then + if not (p==e) then (match !stack with [] -> assert false | _::s -> stack := s); last_alloc := get_alloc (); raise exn @@ -516,7 +518,7 @@ let profile4 e f a b c d = ajoute_totalloc p (e.totalloc -. totalloc0); p.intcount <- p.intcount + e.intcount - intcount0 + 1; p.immcount <- p.immcount + 1; - if not (p==e) then + if not (p==e) then (match !stack with [] -> assert false | _::s -> stack := s); last_alloc := get_alloc (); r @@ -530,7 +532,7 @@ let profile4 e f a b c d = ajoute_totalloc p (e.totalloc -. totalloc0); p.intcount <- p.intcount + e.intcount - intcount0 + 1; p.immcount <- p.immcount + 1; - if not (p==e) then + if not (p==e) then (match !stack with [] -> assert false | _::s -> stack := s); last_alloc := get_alloc (); raise exn @@ -558,7 +560,7 @@ let profile5 e f a b c d g = ajoute_totalloc p (e.totalloc -. totalloc0); p.intcount <- p.intcount + e.intcount - intcount0 + 1; p.immcount <- p.immcount + 1; - if not (p==e) then + if not (p==e) then (match !stack with [] -> assert false | _::s -> stack := s); last_alloc := get_alloc (); r @@ -572,7 +574,7 @@ let profile5 e f a b c d g = ajoute_totalloc p (e.totalloc -. totalloc0); p.intcount <- p.intcount + e.intcount - intcount0 + 1; p.immcount <- p.immcount + 1; - if not (p==e) then + if not (p==e) then (match !stack with [] -> assert false | _::s -> stack := s); last_alloc := get_alloc (); raise exn @@ -600,7 +602,7 @@ let profile6 e f a b c d g h = ajoute_totalloc p (e.totalloc -. totalloc0); p.intcount <- p.intcount + e.intcount - intcount0 + 1; p.immcount <- p.immcount + 1; - if not (p==e) then + if not (p==e) then (match !stack with [] -> assert false | _::s -> stack := s); last_alloc := get_alloc (); r @@ -614,7 +616,7 @@ let profile6 e f a b c d g h = ajoute_totalloc p (e.totalloc -. totalloc0); p.intcount <- p.intcount + e.intcount - intcount0 + 1; p.immcount <- p.immcount + 1; - if not (p==e) then + if not (p==e) then (match !stack with [] -> assert false | _::s -> stack := s); last_alloc := get_alloc (); raise exn @@ -642,7 +644,7 @@ let profile7 e f a b c d g h i = ajoute_totalloc p (e.totalloc -. totalloc0); p.intcount <- p.intcount + e.intcount - intcount0 + 1; p.immcount <- p.immcount + 1; - if not (p==e) then + if not (p==e) then (match !stack with [] -> assert false | _::s -> stack := s); last_alloc := get_alloc (); r @@ -656,7 +658,7 @@ let profile7 e f a b c d g h i = ajoute_totalloc p (e.totalloc -. totalloc0); p.intcount <- p.intcount + e.intcount - intcount0 + 1; p.immcount <- p.immcount + 1; - if not (p==e) then + if not (p==e) then (match !stack with [] -> assert false | _::s -> stack := s); last_alloc := get_alloc (); raise exn @@ -664,22 +666,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 +687,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; @@ -695,24 +695,24 @@ let obj_stats a = (!c, !s + !b, !m) module H = Hashtbl.Make( - struct - type t = Obj.t - let equal = (==) - let hash o = Hashtbl.hash (magic o : int) + struct + type t = Obj.t + let equal = (==) + 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 +720,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; |