76 lines
1.8 KiB
OCaml
76 lines
1.8 KiB
OCaml
exception Icepick_error of string
|
|
|
|
type prime_strategy =
|
|
| Prime_temporal
|
|
| Prime_prefetcht2
|
|
| Prime_prefetchnta
|
|
| Prime_nt_store
|
|
|
|
type access_pattern =
|
|
| Pattern_sequential
|
|
| Pattern_reverse
|
|
| Pattern_strided
|
|
| Pattern_pointer_chase
|
|
|
|
type core_type =
|
|
| Core_any
|
|
| Core_pcore
|
|
| Core_ecore
|
|
|
|
module Topology : sig
|
|
type t
|
|
|
|
val discover : unit -> t
|
|
val l3_ways : t -> int
|
|
val l3_size : t -> int
|
|
val way_size : t -> int
|
|
val max_clos : t -> int
|
|
val ccx_count : t -> int
|
|
val cat_supported : t -> bool
|
|
val mba_supported : t -> bool
|
|
val mba_is_linear : t -> bool
|
|
val max_mba_thrtl : t -> int
|
|
val is_hybrid : t -> bool
|
|
val pcore_count : t -> int
|
|
val ecore_count : t -> int
|
|
end
|
|
|
|
module Region : sig
|
|
type t
|
|
|
|
val lock : Topology.t -> size:int -> clos:int -> ?numa:int -> ?huge_pages:bool -> ?verify:bool ->
|
|
?prime_strategy:prime_strategy -> ?access_pattern:access_pattern ->
|
|
?stride:int -> ?prime_iterations:int -> ?mba_throttle:int ->
|
|
?core_type:core_type -> unit -> t
|
|
val unlock : t -> unit
|
|
val ptr : t -> nativeint
|
|
val size : t -> int
|
|
val clos : t -> int
|
|
val to_bigarray_float64 : t -> (float, Bigarray.float64_elt, Bigarray.c_layout) Bigarray.Array1.t
|
|
end
|
|
|
|
module Latency_stats : sig
|
|
type t = {
|
|
mean_ns : int;
|
|
stddev_ns : int;
|
|
p50_ns : int;
|
|
p99_ns : int;
|
|
p999_ns : int;
|
|
min_ns : int;
|
|
max_ns : int;
|
|
}
|
|
end
|
|
|
|
module Monitor : sig
|
|
type t
|
|
|
|
val start : Region.t -> t
|
|
val start_ex : Region.t -> pmu_poll_ns:int -> probe_ns:int -> miss_thresh:int -> t
|
|
val stop : t -> unit
|
|
val eviction_count : t -> int
|
|
val reprime_count : t -> int
|
|
val is_degraded : t -> bool
|
|
end
|
|
|
|
val verify : Region.t -> Latency_stats.t
|
|
val bench : nativeint -> size:int -> iterations:int -> Latency_stats.t
|