Re: [Caml-list] Re: Is OCaml fast?

[Christophe Raffalli <christophe.raffalli@univ-savoie.fr>]

[-- Attachment #1.1: Type: text/plain, Size: 3043 bytes --]

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 ...

raffalli@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
raffalli@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)

raffalli@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.Raffalli@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
---------------------------------------------

[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #1.2: gctweak.ml --]
[-- Type: text/x-ocaml; name="gctweak.ml", Size: 6155 bytes --]

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;
)



[-- Attachment #2: OpenPGP digital signature --]
[-- Type: application/pgp-signature, Size: 262 bytes --]