Hello, Here is a test of gctweak.ml on the "now famous" binary-tree shootout bench ... As you can see it is a 30% speed up which is not too bad, just adding a file on the compilation command line !
I reattached the file, because I correct a few comments in it ... and a syntax error that is only visible when not using camlp4 in ocaml-3.11.2 ( { get () with ... } is valid with camlp4 and invalid without ???) ... Anyway, more work on Gctweak is still needed ... raffa...@d45-lama:~/Caml$ ocamlopt -o binary_tree gctweak.ml binary_tree.ml ; time ./binary_tree 20 stretch tree of depth 21 check: -1 2097152 trees of depth 4 check: -2097152 524288 trees of depth 6 check: -524288 131072 trees of depth 8 check: -131072 32768 trees of depth 10 check: -32768 8192 trees of depth 12 check: -8192 2048 trees of depth 14 check: -2048 512 trees of depth 16 check: -512 128 trees of depth 18 check: -128 32 trees of depth 20 check: -32 long lived tree of depth 20 check: -1 real 0m19.212s user 0m18.960s sys 0m0.180s raffa...@d45-lama:~/Caml$ ocamlopt -o binary_tree binary_tree.ml ; time ./binary_tree 20 stretch tree of depth 21 check: -1 2097152 trees of depth 4 check: -2097152 524288 trees of depth 6 check: -524288 131072 trees of depth 8 check: -131072 32768 trees of depth 10 check: -32768 8192 trees of depth 12 check: -8192 2048 trees of depth 14 check: -2048 512 trees of depth 16 check: -512 128 trees of depth 18 check: -128 32 trees of depth 20 check: -32 long lived tree of depth 20 check: -1 real 0m27.484s user 0m27.270s sys 0m0.110s Here is the run with debug := 1 and you see that minor heap size is guessed at 524288, with almost no promoted word (model = 1 means no promoted word) raffa...@d45-lama:~/Caml$ ocamlopt -o binary_tree gctweak.ml binary_tree.ml ; time ./binary_tree 20 MHS DOUBLED <- 65536 (model 3.996155) MHS DOUBLED <- 131072 (model 3.000397) stretch tree of depth 21 check: -1 MHS DOUBLED <- 262144 (model 2.495375) MHS DOUBLED <- 524288 (model 1.027698) 2097152 trees of depth 4 check: -2097152 524288 trees of depth 6 check: -524288 131072 trees of depth 8 check: -131072 32768 trees of depth 10 check: -32768 8192 trees of depth 12 check: -8192 2048 trees of depth 14 check: -2048 512 trees of depth 16 check: -512 128 trees of depth 18 check: -128 32 trees of depth 20 check: -32 long lived tree of depth 20 check: -1 real 0m19.342s user 0m19.100s sys 0m0.170s -- Christophe Raffalli Universite de Savoie Batiment Le Chablais, bureau 21 73376 Le Bourget-du-Lac Cedex tel: (33) 4 79 75 81 03 fax: (33) 4 79 75 87 42 mail: christophe.raffa...@univ-savoie.fr www: http://www.lama.univ-savoie.fr/~RAFFALLI --------------------------------------------- IMPORTANT: this mail is signed using PGP/MIME At least Enigmail/Mozilla, mutt or evolution can check this signature. The public key is stored on www.keyserver.net ---------------------------------------------
open Gc (* adjustable parameters, should be a functor ? *) let space_overhead = 100 let gamma = 3.0 (* time in major slice attached to a minor GC / time for minor GC : should use a real estimation, here just a guess !!! *) let reactivity = 0.6 (* between 0.5 and 1.0, less or equal than 0.5 is not very reasonable: it is likely to double the minor_heap_size at each major GC, Decrease if reactivity is not important to you *) let retraction_coef = 0.9 (* between 0.0 and 1.0. the smaller, the less oscillation in the minor heap size. 0.0: never decrease minor heap *) let debug = ref 1 (* between 0 and 4, 2 and above is for debugging only *) let max_minor_heap_size = 1 lsl 25 (* the names is clear, rounded to the power of 2 below *) let major_heap_increment_ratio = 0.5 (* proportional heap increment ratio *) (* End of tuning constants *) (* Justification: We use a model saying that the time in each GC slice is T = K * (m + gamma * r * m * f) where m = minor heap size (goes away in O()) gamma = define above r = ratio of promoted word at each minor cycle f = (space_overhead + 100) / space_overhead used as an estimation of free space in major heap after collection K a time constant in the sum abobe: - K * m is the time in the minor GC - K * gamma * r * m * f is the time in the major GC slice for each minor GC If gamma * f is more than 1 (which is likely), it is easy to see that increasing m, if it decreases r enough, will both increase overall speed and time is a GC slice, increasing therefore both speed and reactivity. More precisely, the model says that this is OK to double the size of the minor heap when 1 + gamma * f * r > 2*(1 + gamma * f * r') where r is the ratio associated to m and r' is the ratio associated to 2*m. The code below keeps and update a table of ponderated average value of 1 + gamma * f * r for all used heap size and tries to make sensible decision looking at it. *) let param = get () let _ = set { param with space_overhead = space_overhead } let main_coef = (* gamma * f *) gamma *. (float) (space_overhead + 100) /.(float) (space_overhead) let ratio_double = 1.0 /. reactivity let ratio_half = ratio_double /. retraction_coef (* tranlated log2 of the minor heap size, used at initialization only *) let index m = let rec fn i m = if m <= 32768 then i else fn (i + 1) (m / 2) in fn 0 m (* a table to store 1 + gamma * f * r for each heap size *) let max_index = index max_minor_heap_size let model_table = Array.create (max_index+1) None let old_heap_words = ref (quick_stat ()).heap_words let old_promoted_words = ref 0.0 let old_minor_collections = ref 0 let minor_heap_size = ref param.minor_heap_size let minor_heap_index_size = ref (index param.minor_heap_size) let _ = create_alarm (fun () -> let s = quick_stat () in (* tweak minor heap size *) let promoted_words = s.promoted_words in let minor_collections = s.minor_collections in let delta_promoted_words = promoted_words -. !old_promoted_words in let delta_minor_collections = minor_collections - !old_minor_collections in old_promoted_words := promoted_words; old_minor_collections := minor_collections; let ratio = delta_promoted_words /. (float) delta_minor_collections /. (float) !minor_heap_size in let new_model = 1.0 +. gamma *. ratio in let i = !minor_heap_index_size in let mean_model = match model_table.(i) with None -> new_model | Some r -> (r +. new_model) /. 2.0 in model_table.(i) <- Some mean_model; if !debug > 2 then begin let i = ref 0 in while !i <= max_index && model_table.(!i) <> None do match model_table.(!i) with | None -> assert false | Some r -> Printf.fprintf stderr "model(%d) = %f - " !i r; incr i done; Printf.fprintf stderr "\n"; flush stderr; end; let lower_double, lower_half = if i <= 0 then true, false else match model_table.(i-1) with | None -> false, true | Some r -> let x = 2.0 *. mean_model /. r in (i < max_index) && x < ratio_double, x > ratio_half in let upper_double, upper_half = if i >= max_index then false, true else match model_table.(i+1) with | None -> true, false | Some r -> let x = 2.0 *. r /. mean_model in x < ratio_double, (i > 0) && x > ratio_half in if !debug > 2 then begin Printf.fprintf stderr "ld = %b, lh = %b, ud = %b, uh = %b\n" lower_double lower_half upper_double upper_half; flush stderr; end; if (lower_half && not upper_double) || (upper_half && not lower_double) then begin minor_heap_size := !minor_heap_size / 2; minor_heap_index_size := i - 1; if !debug > 0 then begin Printf.fprintf stderr "MHS HALFED <- %d (model %f)\n" !minor_heap_size mean_model; flush stderr; end; set { (get ()) with minor_heap_size = !minor_heap_size } end else if (lower_double && not upper_half) || (upper_double && not lower_half) then begin minor_heap_size := !minor_heap_size * 2; minor_heap_index_size := i + 1; if !debug > 0 then begin Printf.fprintf stderr "MHS DOUBLED <- %d (model %f)\n" !minor_heap_size mean_model; flush stderr; end; set { (get ()) with minor_heap_size = !minor_heap_size } end else if !debug > 1 then begin Printf.fprintf stderr "MHS UNCHANGED (model %f) mean_model\n" mean_model; flush stderr; end; (* tweak major heap increment to be a fraction of major heap size *) if !old_heap_words <> s.heap_words then begin old_heap_words := s.heap_words; let major_heap_increment = max (124*1024) (int_of_float (float s.heap_words *. major_heap_increment_ratio) )in (* Printf.fprintf stderr "MHI <- %d \n" major_heap_increment; flush stderr; *) set { (get ()) with major_heap_increment = major_heap_increment; } end; )
signature.asc
Description: OpenPGP digital signature
_______________________________________________ Caml-list mailing list. Subscription management: http://yquem.inria.fr/cgi-bin/mailman/listinfo/caml-list Archives: http://caml.inria.fr Beginner's list: http://groups.yahoo.com/group/ocaml_beginners Bug reports: http://caml.inria.fr/bin/caml-bugs