1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
|
(**************************************************************************)
(* *)
(* OCaml *)
(* *)
(* Stephen Dolan, University of Cambridge *)
(* *)
(* Copyright 2014 Stephen Dolan. *)
(* *)
(* All rights reserved. This file is distributed under the terms of *)
(* the GNU Lesser General Public License version 2.1, with the *)
(* special exception on linking described in the file LICENSE. *)
(* *)
(**************************************************************************)
let overhead block slot obj =
1. -. float_of_int((block / slot) * obj) /. float_of_int block
let max_overhead = 0.101
(*
Prevention of false sharing requires certain sizeclasses to be present. This
ensures they are generated.
Runtime has a constructor for atomics (`caml_atomic_make_contended`), which
aligns them with cache lines to avoid false sharing. The implementation
relies on the fact that pools are cache-aligned by design and slots of
appropriate size maintain this property. To be precise, slots whose size is a
multiple of cache line are laid out in such a way, that their boundaries
coincide with boundaries between cache lines.
*)
let required_for_contended_atomic = function
| 16 | 32 -> true
| _ -> false
let rec blocksizes block slot = function
| 0 -> []
| obj ->
if overhead block slot obj > max_overhead
|| required_for_contended_atomic obj
then
if overhead block obj obj < max_overhead then
obj :: blocksizes block obj (obj - 1)
else
failwith (Format.sprintf
"%d-word objects cannot fit in %d-word arena below %.1f%% overhead"
obj block (100. *. max_overhead))
else blocksizes block slot (obj - 1)
let rec findi_acc i p = function
| [] -> raise Not_found
| x :: xs -> if p x then i else findi_acc (i + 1) p xs
let findi = findi_acc 0
let arena = 4096
let header_size = 4
let max_slot = 128
let avail_arena = arena - header_size
let sizes = List.rev (blocksizes avail_arena max_int max_slot)
let rec size_slots n =
if n > max_slot then
[]
else
findi (fun x -> n <= x) sizes :: size_slots (n + 1)
let rec wastage =
sizes |> List.map (fun s -> avail_arena mod s)
open Format
let rec print_overheads n = function
| [] -> ()
| s :: ss when n > s -> print_overheads n ss
| (s :: _) as ss ->
printf "%3d/%-3d: %.1f%%\n" n s (100. *. overhead avail_arena s n);
print_overheads (n+1) ss
(* let () = print_overheads 1 sizes *)
let rec print_list ppf = function
| [] -> ()
| [x] -> fprintf ppf "%d" x
| x :: xs -> fprintf ppf "%d,@ %a" x print_list xs
let _ =
printf "/* This file is generated by tools/gen_sizeclasses.ml */\n";
printf "#define POOL_WSIZE %d\n" arena;
printf "#define POOL_HEADER_WSIZE %d\n" header_size;
printf "#define SIZECLASS_MAX %d\n" max_slot;
printf "#define NUM_SIZECLASSES %d\n" (List.length sizes);
printf "static const unsigned int \
wsize_sizeclass[NUM_SIZECLASSES] =@[<2>{ %a };@]\n" print_list sizes;
printf "static const unsigned char \
wastage_sizeclass[NUM_SIZECLASSES] =@[<2>{ %a };@]\n" print_list wastage;
printf "static const unsigned char \
sizeclass_wsize[SIZECLASS_MAX + 1] =@[<2>{ %a };@]\n"
print_list (255 :: size_slots 1);
|
