Skip to content
Snippets Groups Projects
Commit 743dc315 authored by Guillaume Combette's avatar Guillaume Combette Committed by David Bühler
Browse files

[kernel] Do not use Obj in binary_cache.ml 

The performance impact is small but measurable (about 2% in run time
difference for polarssl and debie1 in open-source-case-studies). That's
the tradeoff for not having to worry about misusing Obj.
parent a7fea67c
No related branches found
No related tags found
No related merge requests found
Hide whitespace changes
Inline Side-by-side
src/libraries/utils/binary_cache.ml
+ 63
− 142
View file @ 743dc315
...@@ -71,173 +71,94 @@ sig ...@@ -71,173 +71,94 @@ sig
val sentinel : t val sentinel : t
end end
(** The Array_k modules (k = 2, 3, 4) below provide a small interface to arrays
of k-tuples. However, for performance reasons, they are implemented as
k-tuples of arrays of the same size. (The difference can be up to 10% on
some benchmarks.)
Note that there used to be an even faster implementation (about 2% on the
same benchmarks) as a flattened array of k times the size. It relied on a
precise understanding of the low-level OCaml memory model (and the Obj
module). However, that made some maintainers worry on the rare occasions
they had to look at this file.
*)
module Array = struct
include Stdlib.Array
let clear : 'a t -> 'a -> unit
= fun t a -> fill t 0 (length t) a
end
module Array_2 = module Array_2 =
struct struct
type ('a, 'b) t type ('a, 'b) t = 'a array * 'b array
let (clear : ('a, 'b) t -> 'a -> 'b -> unit) let (clear : ('a, 'b) t -> 'a -> 'b -> unit)
= fun t a b -> = fun (ta, tb) a b -> Array.(clear ta a; clear tb b)
let t = Obj.repr t in
let size2 = Obj.size t in
let i = ref 0 in
while (!i < size2)
do
let base = !i in
Obj.set_field t (base) (Obj.repr a);
Obj.set_field t (base+1) (Obj.repr b);
i := base + 2;
done
let (make : int -> 'a -> 'b -> ('a, 'b) t) let (make : int -> 'a -> 'b -> ('a, 'b) t)
= fun size a b -> = fun size a b -> Array.(make size a, make size b)
let size2 = 2 * size in
let t = Obj.obj (Obj.new_block 0 size2) in
clear t a b;
t
let (set : ('a, 'b) t -> int -> 'a -> 'b -> unit) let (set : ('a, 'b) t -> int -> 'a -> 'b -> unit)
= fun t i a b -> = fun (ta, tb) i a b -> Array.(set ta i a; set tb i b)
let t = Obj.repr t in
let base = 2 * i in let (get0 : ('a, 'b) t -> int -> 'a)
Obj.set_field t (base) (Obj.repr a); = fun (ta, _) i -> Array.get ta i
Obj.set_field t (base+1) (Obj.repr b)
let (get0 :
('a, 'b) t -> int -> 'a)
= fun t i ->
let t = Obj.repr t in
let base = 2 * i in
Obj.obj (Obj.field t (base))
let (get1 : ('a, 'b) t -> int -> 'b) let (get1 : ('a, 'b) t -> int -> 'b)
= fun t i -> = fun (_, tb) i -> Array.get tb i
let t = Obj.repr t in
let base = 2 * i in
Obj.obj (Obj.field t (base+1))
end end
module Array_3 = module Array_3 =
struct struct
type ('a, 'b, 'c) t type ('a, 'b, 'c) t = 'a array * 'b array * 'c array
let (clear : ('a, 'b, 'c) t -> let (clear : ('a, 'b, 'c) t -> 'a -> 'b -> 'c -> unit)
'a -> 'b -> 'c -> unit) = fun (ta, tb, tc) a b c -> Array.(clear ta a; clear tb b; clear tc c)
= fun t a b c ->
let t = Obj.repr t in
let size3 = Obj.size t in
let i = ref 0 in
while (!i < size3)
do
let base = !i in
Obj.set_field t (base) (Obj.repr a);
Obj.set_field t (base+1) (Obj.repr b);
Obj.set_field t (base+2) (Obj.repr c);
i := base + 3;
done
let (make : int -> 'a -> 'b -> 'c -> ('a, 'b, 'c) t) let (make : int -> 'a -> 'b -> 'c -> ('a, 'b, 'c) t)
= fun size a b c -> = fun size a b c -> Array.(make size a, make size b, make size c)
let size3 = 3 * size in
let t = Obj.obj (Obj.new_block 0 size3) in
clear t a b c;
t
let (set : ('a, 'b, 'c) t -> int -> 'a -> 'b -> 'c -> unit) let (set : ('a, 'b, 'c) t -> int -> 'a -> 'b -> 'c -> unit)
= fun t i a b c -> = fun (ta, tb, tc) i a b c -> Array.(set ta i a; set tb i b; set tc i c)
let t = Obj.repr t in
let base = 3 * i in let (get0 : ('a, 'b, 'c) t -> int -> 'a)
Obj.set_field t (base) (Obj.repr a); = fun (ta, _, _) i -> Array.get ta i
Obj.set_field t (base+1) (Obj.repr b);
Obj.set_field t (base+2) (Obj.repr c)
let (get0 :
('a, 'b, 'c) t -> int -> 'a)
= fun t i ->
let t = Obj.repr t in
let base = 3 * i in
Obj.obj (Obj.field t (base))
let (get1 : ('a, 'b, 'c) t -> int -> 'b) let (get1 : ('a, 'b, 'c) t -> int -> 'b)
= fun t i -> = fun (_, tb, _) i -> Array.get tb i
let t = Obj.repr t in
let base = 3 * i in let (get2 : ('a, 'b, 'c) t -> int -> 'c)
Obj.obj (Obj.field t (base+1)) = fun (_, _, tc) i -> Array.get tc i
let (get2 :
('a, 'b, 'c) t -> int -> 'c)
= fun t i ->
let t = Obj.repr t in
let base = 3 * i in
Obj.obj (Obj.field t (base+2))
end end
module Array_4 = module Array_4 =
struct struct
type ('a, 'b, 'c, 'd) t type ('a, 'b, 'c, 'd) t = 'a array * 'b array * 'c array * 'd array
let (clear : ('a , 'b , 'c , 'd) t -> let (clear : ('a , 'b , 'c , 'd) t -> 'a -> 'b -> 'c -> 'd -> unit)
'a -> 'b -> 'c -> 'd -> unit) = fun (ta, tb, tc, td) a b c d ->
= fun t a b c d -> Array.(clear ta a; clear tb b; clear tc c; clear td d)
let t = Obj.repr t in
let size4 = Obj.size t in let (make : int -> 'a -> 'b -> 'c -> 'd -> ('a , 'b , 'c , 'd) t)
let i = ref 0 in
while (!i < size4)
do
let base = !i in
Obj.set_field t (base) (Obj.repr a);
Obj.set_field t (base+1) (Obj.repr b);
Obj.set_field t (base+2) (Obj.repr c);
Obj.set_field t (base+3) (Obj.repr d);
i := base + 7;
done
let (make : int -> 'a -> 'b -> 'c -> 'd ->
('a , 'b , 'c , 'd) t)
= fun size a b c d -> = fun size a b c d ->
let size4 = 4 * size in Array.(make size a, make size b, make size c, make size d)
let t = Obj.obj (Obj.new_block 0 size4) in
clear t a b c d; let (set : ('a, 'b, 'c, 'd) t -> int -> 'a -> 'b -> 'c -> 'd -> unit)
t = fun (ta, tb, tc, td) i a b c d ->
Array.(set ta i a; set tb i b; set tc i c; set td i d)
let (set :
('a, 'b, 'c, 'd) t -> int -> let (get0 : ('a, 'b, 'c, 'd) t -> int -> 'a)
'a -> 'b -> 'c -> 'd -> unit) = fun (ta, _, _, _) i -> Array.get ta i
= fun t i a b c d ->
let t = Obj.repr t in let (get1 : ('a, 'b, 'c, 'd) t -> int -> 'b)
let base = 4 * i in = fun (_, tb, _, _) i -> Array.get tb i
Obj.set_field t (base) (Obj.repr a);
Obj.set_field t (base+1) (Obj.repr b); let (get2 : ('a, 'b, 'c, 'd) t -> int -> 'c)
Obj.set_field t (base+2) (Obj.repr c); = fun (_, _, tc, _) i -> Array.get tc i
Obj.set_field t (base+3) (Obj.repr d);
;; let (get3 : ('a, 'b, 'c, 'd) t -> int -> 'd)
= fun (_, _, _, td) i -> Array.get td i
let (get0 :
('a, 'b, 'c, 'd) t -> int -> 'a)
= fun t i ->
let t = Obj.repr t in
let base = 4 * i in
Obj.obj (Obj.field t (base))
let (get1 :
('a, 'b, 'c, 'd) t -> int -> 'b)
= fun t i ->
let t = Obj.repr t in
let base = 4 * i in
Obj.obj (Obj.field t (base+1))
let (get2 :
('a, 'b, 'c, 'd) t -> int -> 'c)
= fun t i ->
let t = Obj.repr t in
let base = 4 * i in
Obj.obj (Obj.field t (base+2))
let (get3 :
('a, 'b, 'c, 'd) t -> int -> 'd)
= fun t i ->
let t = Obj.repr t in
let base = 4 * i in
Obj.obj (Obj.field t (base+3))
end end
module Symmetric_Binary (H: Cacheable) (R: Result) = module Symmetric_Binary (H: Cacheable) (R: Result) =
......
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment