├── .gitignore ├── .travis.yml ├── CHANGES.md ├── LICENSE.md ├── README.md ├── TODO.md ├── dune-project ├── papi.opam ├── src ├── dune ├── native │ └── stubs.c ├── papi.ml ├── papi.mli ├── papi_top.ml ├── papi_top.mli └── papi_top_init.ml └── test ├── dune └── test.ml /.gitignore: -------------------------------------------------------------------------------- 1 | _build 2 | *.install 3 | *.native 4 | *.byte 5 | 6 | .merlin 7 | 8 | tmp 9 | *~ 10 | \.\#* 11 | \#*# 12 | 13 | gmon.out 14 | rondom 15 | -------------------------------------------------------------------------------- /.travis.yml: -------------------------------------------------------------------------------- 1 | dist: xenial 2 | sudo: false 3 | language: c 4 | install: wget https://raw.githubusercontent.com/ocaml/ocaml-ci-scripts/master/.travis-opam.sh 5 | script: bash -ex .travis-opam.sh 6 | env: 7 | global: 8 | - PACKAGE="papi" 9 | matrix: 10 | - OCAML_VERSION=4.05 11 | - OCAML_VERSION=4.06 12 | - OCAML_VERSION=4.07 13 | notifications: 14 | email: false 15 | -------------------------------------------------------------------------------- /CHANGES.md: -------------------------------------------------------------------------------- 1 | ## v0.1.1 2019-04-10 2 | 3 | dune 4 | 5 | ## v0.1.0 2019-03-05 6 | 7 | First release. 8 | -------------------------------------------------------------------------------- /LICENSE.md: -------------------------------------------------------------------------------- 1 | Copyright (c) 2019 David Kaloper Meršinjak 2 | 3 | Permission to use, copy, modify, and/or distribute this software for any 4 | purpose with or without fee is hereby granted, provided that the above 5 | copyright notice and this permission notice appear in all copies. 6 | 7 | THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES 8 | WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF 9 | MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR 10 | ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES 11 | WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN 12 | ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF 13 | OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. 14 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # papi — Performance Application Programming Interface for OCaml 2 | 3 | %%VERSION%% 4 | 5 | Papi provides OCaml bindings to 6 | [PAPI (Performance Application Programming Interface)][papi-home], a C library 7 | for portable access to hardware performance counters. 8 | 9 | The bindings closely follow PAPI's [own interface][papi-docs]. As a consequence, 10 | the multitude of errors that PAPI can signal are propagated to OCaml. User is 11 | advised to at least skim the PAPI documentation. 12 | 13 | Papi depends on the PAPI C library, version 5.4 or above. 14 | 15 | Papi is distributed under the ISC license. 16 | 17 | Homepage: https://github.com/pqwy/ocaml-papi 18 | 19 | [papi-home]: http://icl.cs.utk.edu/papi 20 | [papi-docs]: http://icl.cs.utk.edu/projects/papi/wiki/Main_Page 21 | 22 | ## Documentation 23 | 24 | Interface files or [online][doc]. 25 | 26 | [doc]: https://pqwy.github.io/ocaml-papi/doc/papi/ 27 | 28 | 29 | [![Build Status](https://travis-ci.org/pqwy/ocaml-papi.svg?branch=master)](https://travis-ci.org/pqwy/ocaml-papi) 30 | -------------------------------------------------------------------------------- /TODO.md: -------------------------------------------------------------------------------- 1 | * So far only the fixed, "PRESET" events are exposed. 2 | Add event enumeration and expose variable events? 3 | * Expose components? 4 | -------------------------------------------------------------------------------- /dune-project: -------------------------------------------------------------------------------- 1 | (lang dune 1.7) 2 | (name papi) 3 | (version %%VERSION_NUM%%) 4 | -------------------------------------------------------------------------------- /papi.opam: -------------------------------------------------------------------------------- 1 | opam-version: "2.0" 2 | maintainer: ["David Kaloper Meršinjak "] 3 | authors: ["David Kaloper Meršinjak "] 4 | license: "ISC" 5 | homepage: "https://github.com/pqwy/ocaml-papi" 6 | doc: "https://pqwy.github.io/ocaml-papi/doc" 7 | dev-repo: "git+https://github.com/pqwy/ocaml-papi.git" 8 | bug-reports: "https://github.com/pqwy/ocaml-papi/issues" 9 | synopsis: "Performance Application Programming Interface (PAPI) bindings" 10 | 11 | build: [ [ "dune" "subst" ] {dev} 12 | [ "dune" "build" "-p" name "-j" jobs ] 13 | [ "dune" "runtest" "-p" name "-j" jobs ] {with-test} ] 14 | 15 | depends: [ 16 | "ocaml" {>= "4.08"} 17 | "dune" {build & >= "1.7"} 18 | "cppo" {build & >= "1.1.0"} 19 | "fmt" {with-test} 20 | ] 21 | 22 | depexts: [ 23 | ["libpapi-dev"] {os-distribution = "debian"} 24 | ["libpapi-dev"] {os-distribution = "ubuntu"} 25 | ["papi-devel"] {os-distribution = "centos"} 26 | ["papi"] {os-distribution = "arch"} 27 | ] 28 | 29 | description: """ 30 | Papi provides OCaml bindings to PAPI, a C library for portable access to 31 | hardware performance counters. 32 | """ 33 | -------------------------------------------------------------------------------- /src/dune: -------------------------------------------------------------------------------- 1 | (library 2 | (public_name papi) 3 | (synopsis "Performance Application Programming Interface (PAPI) bindings") 4 | (modules papi) 5 | (c_names stubs) 6 | (c_flags (-Wall -Wextra -O3 -Wno-implicit-fallthrough -Wno-unused-variable)) 7 | (c_library_flags (-lpapi))) 8 | 9 | (include_subdirs unqualified) 10 | 11 | (library 12 | (public_name papi.top) 13 | (synopsis "PAPI toplevel support") 14 | (name papi_top) 15 | (modules papi_top) 16 | (preprocess (action (run %{bin:cppo} -V OCAML:%{ocaml_version} %{input-file}))) 17 | (libraries papi compiler-libs.toplevel)) 18 | 19 | (install 20 | (section lib) 21 | (files (papi_top_init.ml as top/papi_top_init.ml))) 22 | -------------------------------------------------------------------------------- /src/native/stubs.c: -------------------------------------------------------------------------------- 1 | /* Copyright (c) 2019 David Kaloper Meršinjak. All rights reserved. 2 | See LICENSE.md */ 3 | 4 | #include 5 | #include 6 | #include 7 | #include 8 | #include 9 | #include 10 | #include 11 | #include 12 | 13 | #define __unit value unit __attribute__((unused)) 14 | #define __int_option(x, def) (Is_block (x) ? Long_val (Field (x, 0)) : def) 15 | 16 | /* Ordering must match the ordering of `event' constructors! */ 17 | static int event_table [] = { 18 | PAPI_L1_DCM, PAPI_L1_ICM, PAPI_L2_DCM, PAPI_L2_ICM, PAPI_L3_DCM, PAPI_L3_ICM, 19 | PAPI_L1_TCM, PAPI_L2_TCM, PAPI_L3_TCM, PAPI_CA_SNP, PAPI_CA_SHR, PAPI_CA_CLN, 20 | PAPI_CA_INV, PAPI_CA_ITV, PAPI_L3_LDM, PAPI_L3_STM, PAPI_BRU_IDL, 21 | PAPI_FXU_IDL, PAPI_FPU_IDL, PAPI_LSU_IDL, PAPI_TLB_DM, PAPI_TLB_IM, 22 | PAPI_TLB_TL, PAPI_L1_LDM, PAPI_L1_STM, PAPI_L2_LDM, PAPI_L2_STM, PAPI_BTAC_M, 23 | PAPI_PRF_DM, PAPI_L3_DCH, PAPI_TLB_SD, PAPI_CSR_FAL, PAPI_CSR_SUC, 24 | PAPI_CSR_TOT, PAPI_MEM_SCY, PAPI_MEM_RCY, PAPI_MEM_WCY, PAPI_STL_ICY, 25 | PAPI_FUL_ICY, PAPI_STL_CCY, PAPI_FUL_CCY, PAPI_HW_INT, PAPI_BR_UCN, 26 | PAPI_BR_CN, PAPI_BR_TKN, PAPI_BR_NTK, PAPI_BR_MSP, PAPI_BR_PRC, PAPI_FMA_INS, 27 | PAPI_TOT_IIS, PAPI_TOT_INS, PAPI_INT_INS, PAPI_FP_INS, PAPI_LD_INS, 28 | PAPI_SR_INS, PAPI_BR_INS, PAPI_VEC_INS, PAPI_RES_STL, PAPI_FP_STAL, 29 | PAPI_TOT_CYC, PAPI_LST_INS, PAPI_SYC_INS, PAPI_L1_DCH, PAPI_L2_DCH, 30 | PAPI_L1_DCA, PAPI_L2_DCA, PAPI_L3_DCA, PAPI_L1_DCR, PAPI_L2_DCR, PAPI_L3_DCR, 31 | PAPI_L1_DCW, PAPI_L2_DCW, PAPI_L3_DCW, PAPI_L1_ICH, PAPI_L2_ICH, PAPI_L3_ICH, 32 | PAPI_L1_ICA, PAPI_L2_ICA, PAPI_L3_ICA, PAPI_L1_ICR, PAPI_L2_ICR, PAPI_L3_ICR, 33 | PAPI_L1_ICW, PAPI_L2_ICW, PAPI_L3_ICW, PAPI_L1_TCH, PAPI_L2_TCH, PAPI_L3_TCH, 34 | PAPI_L1_TCA, PAPI_L2_TCA, PAPI_L3_TCA, PAPI_L1_TCR, PAPI_L2_TCR, PAPI_L3_TCR, 35 | PAPI_L1_TCW, PAPI_L2_TCW, PAPI_L3_TCW, PAPI_FML_INS, PAPI_FAD_INS, 36 | PAPI_FDV_INS, PAPI_FSQ_INS, PAPI_FNV_INS, PAPI_FP_OPS, PAPI_SP_OPS, 37 | PAPI_DP_OPS, PAPI_VEC_SP, PAPI_VEC_DP, PAPI_REF_CYC, 38 | /* PAPI_END */ 39 | }; 40 | 41 | /* Ordering must match the ordering of `error' constructors! */ 42 | static int error_table [] = { 43 | PAPI_EINVAL, PAPI_ENOMEM, PAPI_ESYS, PAPI_ECMP, 44 | PAPI_ECLOST, PAPI_EBUG, PAPI_ENOEVNT, PAPI_ECNFLCT, PAPI_ENOTRUN, PAPI_EISRUN, 45 | PAPI_ENOEVST, PAPI_ENOTPRESET, PAPI_ENOCNTR, PAPI_EMISC, PAPI_EPERM, PAPI_ENOINIT, 46 | PAPI_ENOCMP, PAPI_ENOSUPP, PAPI_ENOIMPL, PAPI_EBUF, PAPI_EINVAL_DOM, PAPI_EATTR, 47 | PAPI_ECOUNT, PAPI_ECOMBO, 48 | }; 49 | 50 | __attribute__ ((__noreturn__)) 51 | static void caml_raise_sys_error_string (const char *msg) { 52 | caml_raise_sys_error (caml_copy_string (msg)); 53 | } 54 | 55 | static int n_events = sizeof (event_table) / sizeof (int); 56 | 57 | static int __event_of_ml_event (value v) { 58 | int e = Int_val (v); 59 | if (e < n_events) return event_table [e]; 60 | caml_raise_sys_error_string ("Unknown Papi.event constructor."); 61 | } 62 | 63 | static int n_errors = sizeof (error_table) / sizeof (int); 64 | 65 | static int __error_of_ml_error (value v) { 66 | int e = Int_val (v); 67 | if (e < n_errors) return error_table [e]; 68 | caml_raise_sys_error_string ("Unknown Papi.error constructor."); 69 | } 70 | 71 | static int __ml_error_of_error (int e) { 72 | for (int i = 0; i < n_errors; i++) 73 | if (error_table [i] == e) return Val_int (i); 74 | caml_raise_sys_error_string ("Unknown PAPI error."); 75 | } 76 | 77 | __attribute__ ((__noreturn__)) 78 | static void __raise_papi (int err, const char *f) { 79 | CAMLparam0(); 80 | CAMLlocal1(arg); 81 | const value *exn = caml_named_value ("PAPI_EXCEPTION_CTOR"); 82 | if (!exn) exit (1); 83 | arg = caml_alloc_tuple (2); 84 | Field (arg, 0) = __ml_error_of_error (err); 85 | Field (arg, 1) = caml_copy_string (f); 86 | caml_raise_with_arg (*exn, arg); 87 | } 88 | 89 | static inline int __ret (int ret, const char *f) { 90 | if (ret < 0) __raise_papi (ret, f); 91 | return ret; 92 | } 93 | 94 | CAMLprim value caml_papi_library_init (__unit) { 95 | if (PAPI_is_initialized () == PAPI_NOT_INITED) { 96 | __ret (PAPI_library_init (PAPI_VER_CURRENT), "Papi.init"); 97 | if (PAPI_is_initialized () == PAPI_NOT_INITED) 98 | caml_raise_sys_error_string ("Papi.init: cannot initialize PAPI"); 99 | } 100 | return Val_unit; 101 | } 102 | 103 | CAMLprim value caml_papi_shutdown (__unit) { 104 | PAPI_shutdown (); 105 | return Val_unit; 106 | } 107 | 108 | CAMLprim value caml_papi_hw_counters (__unit) { 109 | return Val_int (__ret (PAPI_get_opt (PAPI_MAX_HWCTRS, NULL), "hw_counters")); 110 | } 111 | 112 | CAMLprim value caml_papi_strerror (value e) { 113 | if (PAPI_is_initialized () == PAPI_NOT_INITED) 114 | __raise_papi (PAPI_ENOINIT, "Papi.strerror"); 115 | char *msg = PAPI_strerror (__error_of_ml_error (e)); 116 | return caml_copy_string (msg ? msg : ""); 117 | } 118 | 119 | #define EVENT_INFO_ACCESSOR(name, var, expr) \ 120 | CAMLprim value caml_papi_event_ ## name (value e) { \ 121 | PAPI_event_info_t var = {0}; \ 122 | __ret (PAPI_get_event_info (__event_of_ml_event (e), &var), \ 123 | "get_event_info"); \ 124 | return (expr); \ 125 | } 126 | 127 | EVENT_INFO_ACCESSOR(name, i, 128 | caml_copy_string (i.symbol + ((strncmp ("PAPI_", i.symbol, 5) == 0) ? 5 : 0))) 129 | EVENT_INFO_ACCESSOR(descr, i, caml_copy_string (i.long_descr)) 130 | /* EVENT_INFO_ACCESSOR(short_descr, i, caml_copy_string (i.short_descr)) */ 131 | 132 | CAMLprim value caml_papi_create_eventset (__unit) { 133 | int es = PAPI_NULL; 134 | __ret (PAPI_create_eventset (&es), "Papi.create"); 135 | return Val_int (es); 136 | } 137 | 138 | CAMLprim value caml_papi_cleanup_eventset (value es) { 139 | int i = Int_val (es); 140 | __ret (PAPI_cleanup_eventset (i), "Papi.cleanup"); 141 | return Val_unit; 142 | } 143 | 144 | CAMLprim value caml_papi_destroy_eventset (value es) { 145 | int i = Int_val (es); 146 | __ret (PAPI_destroy_eventset (&i), "Papi.destroy"); 147 | return Val_unit; 148 | } 149 | 150 | CAMLprim value caml_papi_add_event (value es, value event) { 151 | int res = PAPI_add_event (Int_val (es), __event_of_ml_event (event)); 152 | __ret (res, "Papi.add"); 153 | return Val_unit; 154 | } 155 | 156 | CAMLprim value caml_papi_remove_event (value es, value event) { 157 | int res = PAPI_remove_event (Int_val (es), __event_of_ml_event (event)); 158 | __ret (res, "Papi.remove"); 159 | return Val_unit; 160 | } 161 | 162 | CAMLprim value caml_papi_query_event (value event) { 163 | int res = PAPI_query_event (__event_of_ml_event (event)); 164 | return (res == PAPI_OK ? Val_true : Val_false); 165 | } 166 | 167 | static inline int __ml_num_events (value es) { 168 | return __ret (PAPI_num_events (Int_val (es)), "Papi.num_events"); 169 | } 170 | 171 | CAMLprim value caml_papi_num_events (value es) { 172 | return Val_int (__ml_num_events (es)); 173 | } 174 | 175 | CAMLprim value caml_papi_start (value es) { 176 | __ret (PAPI_start (Int_val (es)), "Papi.start"); 177 | return Val_unit; 178 | } 179 | 180 | CAMLprim value caml_papi_stop (value es) { 181 | __ret (PAPI_stop (Int_val (es), NULL), "Papi.stop"); 182 | return Val_unit; 183 | } 184 | 185 | CAMLprim value caml_papi_reset (value es) { 186 | __ret (PAPI_reset (Int_val (es)), "Papi.reset"); 187 | return Val_unit; 188 | } 189 | 190 | CAMLprim value caml_papi_read (value es, value off, value vs) { 191 | CAMLparam1 (vs); 192 | 193 | mlsize_t o = __int_option (off, 0), 194 | size = caml_array_length (vs), 195 | n = __ml_num_events (es); 196 | 197 | if (size <= o || size - o < n) 198 | caml_invalid_argument ("Papi.read"); 199 | 200 | long long vals [n]; 201 | __ret (PAPI_read (Int_val (es), vals), "Papi.read"); 202 | 203 | for (mlsize_t i = 0; i < n; i++) 204 | Store_double_field (vs, i + o, (double) vals [i]); 205 | 206 | CAMLreturn (Val_unit); 207 | } 208 | 209 | CAMLprim value caml_papi_accum (value es, value off, value vs) { 210 | CAMLparam1 (vs); 211 | 212 | mlsize_t o = __int_option (off, 0), 213 | size = caml_array_length (vs), 214 | n = __ml_num_events (es); 215 | 216 | if (size <= o || size - o < n) 217 | caml_invalid_argument ("Papi.accum"); 218 | 219 | long long vals [n]; 220 | memset (vals, 0, n * sizeof (long long)); 221 | __ret (PAPI_accum (Int_val (es), vals), "Papi.accum"); 222 | 223 | for (mlsize_t i = 0; i < n; i++) 224 | Store_double_field (vs, i + o, 225 | Double_field (vs, i + o) + (double) vals [i]); 226 | 227 | CAMLreturn (Val_unit); 228 | } 229 | -------------------------------------------------------------------------------- /src/papi.ml: -------------------------------------------------------------------------------- 1 | (* Copyright (c) 2019 David Kaloper Meršinjak. All rights reserved. 2 | See LICENSE.md *) 3 | 4 | (* Ordering must match the ordering of `error_table[]'! *) 5 | type error = 6 | EINVAL | ENOMEM | ESYS | ECMP | ECLOST | EBUG | ENOEVNT | ECNFLCT | ENOTRUN 7 | | EISRUN | ENOEVST | ENOTPRESET | ENOCNTR | EMISC | EPERM | ENOINIT | ENOCMP 8 | | ENOSUPP | ENOIMPL | EBUF | EINVAL_DOM | EATTR | ECOUNT | ECOMBO 9 | 10 | exception Error of (error * string) 11 | let () = Callback.register_exception "PAPI_EXCEPTION_CTOR" (Error (EMISC, "")); 12 | 13 | (* Ordering must match the ordering of `event_table[]'! *) 14 | type event = 15 | L1_DCM | L1_ICM | L2_DCM | L2_ICM | L3_DCM | L3_ICM | L1_TCM | L2_TCM 16 | | L3_TCM | CA_SNP | CA_SHR | CA_CLN | CA_INV | CA_ITV | L3_LDM | L3_STM 17 | | BRU_IDL | FXU_IDL | FPU_IDL | LSU_IDL | TLB_DM | TLB_IM | TLB_TL | L1_LDM 18 | | L1_STM | L2_LDM | L2_STM | BTAC_M | PRF_DM | L3_DCH | TLB_SD | CSR_FAL 19 | | CSR_SUC | CSR_TOT | MEM_SCY | MEM_RCY | MEM_WCY | STL_ICY | FUL_ICY 20 | | STL_CCY | FUL_CCY | HW_INT | BR_UCN | BR_CN | BR_TKN | BR_NTK | BR_MSP 21 | | BR_PRC | FMA_INS | TOT_IIS | TOT_INS | INT_INS | FP_INS | LD_INS | SR_INS 22 | | BR_INS | VEC_INS | RES_STL | FP_STAL | TOT_CYC | LST_INS | SYC_INS | L1_DCH 23 | | L2_DCH | L1_DCA | L2_DCA | L3_DCA | L1_DCR | L2_DCR | L3_DCR | L1_DCW 24 | | L2_DCW | L3_DCW | L1_ICH | L2_ICH | L3_ICH | L1_ICA | L2_ICA | L3_ICA 25 | | L1_ICR | L2_ICR | L3_ICR | L1_ICW | L2_ICW | L3_ICW | L1_TCH | L2_TCH 26 | | L3_TCH | L1_TCA | L2_TCA | L3_TCA | L1_TCR | L2_TCR | L3_TCR | L1_TCW 27 | | L2_TCW | L3_TCW | FML_INS | FAD_INS | FDV_INS | FSQ_INS | FNV_INS | FP_OPS 28 | | SP_OPS | DP_OPS | VEC_SP | VEC_DP | REF_CYC 29 | 30 | let events = [| 31 | L1_DCM; L1_ICM; L2_DCM; L2_ICM; L3_DCM; L3_ICM; L1_TCM; L2_TCM; L3_TCM; 32 | CA_SNP; CA_SHR; CA_CLN; CA_INV; CA_ITV; L3_LDM; L3_STM; BRU_IDL; FXU_IDL; 33 | FPU_IDL; LSU_IDL; TLB_DM; TLB_IM; TLB_TL; L1_LDM; L1_STM; L2_LDM; L2_STM; 34 | BTAC_M; PRF_DM; L3_DCH; TLB_SD; CSR_FAL; CSR_SUC; CSR_TOT; MEM_SCY; MEM_RCY; 35 | MEM_WCY; STL_ICY; FUL_ICY; STL_CCY; FUL_CCY; HW_INT; BR_UCN; BR_CN; BR_TKN; 36 | BR_NTK; BR_MSP; BR_PRC; FMA_INS; TOT_IIS; TOT_INS; INT_INS; FP_INS; LD_INS; 37 | SR_INS; BR_INS; VEC_INS; RES_STL; FP_STAL; TOT_CYC; LST_INS; SYC_INS; L1_DCH; 38 | L2_DCH; L1_DCA; L2_DCA; L3_DCA; L1_DCR; L2_DCR; L3_DCR; L1_DCW; L2_DCW; 39 | L3_DCW; L1_ICH; L2_ICH; L3_ICH; L1_ICA; L2_ICA; L3_ICA; L1_ICR; L2_ICR; 40 | L3_ICR; L1_ICW; L2_ICW; L3_ICW; L1_TCH; L2_TCH; L3_TCH; L1_TCA; L2_TCA; 41 | L3_TCA; L1_TCR; L2_TCR; L3_TCR; L1_TCW; L2_TCW; L3_TCW; FML_INS; FAD_INS; 42 | FDV_INS; FSQ_INS; FNV_INS; FP_OPS; SP_OPS; DP_OPS; VEC_SP; VEC_DP; REF_CYC 43 | |] 44 | 45 | type eventset = int 46 | external init : unit -> unit = "caml_papi_library_init" 47 | external shutdown : unit -> unit = "caml_papi_shutdown" 48 | external hw_counters : unit -> int = "caml_papi_hw_counters" 49 | external create : unit -> eventset = "caml_papi_create_eventset" 50 | external cleanup : eventset -> unit = "caml_papi_cleanup_eventset" 51 | external destroy : eventset -> unit = "caml_papi_destroy_eventset" 52 | external add : eventset -> event -> unit = "caml_papi_add_event" 53 | external query : event -> bool = "caml_papi_query_event" 54 | external num_events : eventset -> int = "caml_papi_num_events" 55 | external start : eventset -> unit = "caml_papi_start" 56 | external stop : eventset -> unit = "caml_papi_stop" 57 | external reset : eventset -> unit = "caml_papi_reset" 58 | external read : eventset -> ?off:int -> float array -> unit = "caml_papi_read" 59 | external accum : eventset -> ?off:int -> float array -> unit = "caml_papi_accum" 60 | external strerror : error -> string = "caml_papi_strerror" 61 | external name : event -> string = "caml_papi_event_name" 62 | external description : event -> string = "caml_papi_event_descr" 63 | 64 | let pf = Format.fprintf 65 | (* let pp_eventset ppf = pf ppf "%d" *) 66 | let pp_event ppf e = pf ppf "@[%s@ (%s)@]" (name e) (description e) 67 | let pp_error ppf err = 68 | let descr = try strerror err with 69 | Error (ENOINIT, _) -> "Please call Papi.init" in 70 | Format.pp_print_string ppf descr 71 | let pp_exn_error ppf (err, f) = pf ppf "@[%s:@ %a@]" f pp_error err 72 | -------------------------------------------------------------------------------- /src/papi.mli: -------------------------------------------------------------------------------- 1 | (* Copyright (c) 2019 David Kaloper Meršinjak. All rights reserved. 2 | See LICENSE.md *) 3 | 4 | (** Performance Application Programming Interface (PAPI) bindings. 5 | 6 | This module binds []. PAPI provides portable access to hardware 7 | performance counters. For more information, see the 8 | {{: http://icl.cs.utk.edu/papi/}homepage}. 9 | 10 | {b Note.} All functions in this module except {!shutdown} raise {!Error} 11 | whenever the underlying PAPI call signals an error. 12 | 13 | {b Note.} All functions except {!init} and {!shutdown} raise 14 | [Error (ENOINIT, _)] before initialisation. 15 | 16 | For examples of use, consult {{!examples}examples}. 17 | 18 | {e %%VERSION%% — {{:%%PKG_HOMEPAGE%% }homepage}} *) 19 | 20 | 21 | (** {1 Errors} *) 22 | 23 | type error = 24 | EINVAL | ENOMEM | ESYS | ECMP | ECLOST | EBUG | ENOEVNT | ECNFLCT | ENOTRUN 25 | | EISRUN | ENOEVST | ENOTPRESET | ENOCNTR | EMISC | EPERM | ENOINIT | ENOCMP 26 | | ENOSUPP | ENOIMPL | EBUF | EINVAL_DOM | EATTR | ECOUNT | ECOMBO 27 | (** PAPI errors. 28 | 29 | See the header file [papi.h] for descriptions of errors. *) 30 | 31 | exception Error of (error * string) 32 | (** PAPI errors are signalled by raising [Error ((err, fname))], 33 | where [fname] is the name of the failing function. *) 34 | 35 | val pp_error : Format.formatter -> error -> unit 36 | (** [pp_error ppf err] pretty-prints [err] on [ppf]. *) 37 | 38 | val pp_exn_error : Format.formatter -> error * string -> unit 39 | (** [pp_exn_error ppf arg] pretty-prints the [Error] argument [arg] on [ppf]. *) 40 | 41 | 42 | (** {1 Initialisation} *) 43 | 44 | external init : unit -> unit = "caml_papi_library_init" 45 | (** Initializes PAPI by calling [PAPI_library_init]. 46 | Idempotent: repeated calls are ignored. *) 47 | 48 | external shutdown : unit -> unit = "caml_papi_shutdown" 49 | (** Releases PAPI state by calling [PAPI_shutdown]. Idempotent. *) 50 | 51 | external hw_counters : unit -> int = "caml_papi_hw_counters" 52 | (** [hw_counters ()] is the number of available hardware counters. *) 53 | 54 | 55 | (** {1 Events} *) 56 | 57 | type event = 58 | L1_DCM | L1_ICM | L2_DCM | L2_ICM | L3_DCM | L3_ICM | L1_TCM | L2_TCM 59 | | L3_TCM | CA_SNP | CA_SHR | CA_CLN | CA_INV | CA_ITV | L3_LDM | L3_STM 60 | | BRU_IDL | FXU_IDL | FPU_IDL | LSU_IDL | TLB_DM | TLB_IM | TLB_TL | L1_LDM 61 | | L1_STM | L2_LDM | L2_STM | BTAC_M | PRF_DM | L3_DCH | TLB_SD | CSR_FAL 62 | | CSR_SUC | CSR_TOT | MEM_SCY | MEM_RCY | MEM_WCY | STL_ICY | FUL_ICY 63 | | STL_CCY | FUL_CCY | HW_INT | BR_UCN | BR_CN | BR_TKN | BR_NTK | BR_MSP 64 | | BR_PRC | FMA_INS | TOT_IIS | TOT_INS | INT_INS | FP_INS | LD_INS | SR_INS 65 | | BR_INS | VEC_INS | RES_STL | FP_STAL | TOT_CYC | LST_INS | SYC_INS | L1_DCH 66 | | L2_DCH | L1_DCA | L2_DCA | L3_DCA | L1_DCR | L2_DCR | L3_DCR | L1_DCW 67 | | L2_DCW | L3_DCW | L1_ICH | L2_ICH | L3_ICH | L1_ICA | L2_ICA | L3_ICA 68 | | L1_ICR | L2_ICR | L3_ICR | L1_ICW | L2_ICW | L3_ICW | L1_TCH | L2_TCH 69 | | L3_TCH | L1_TCA | L2_TCA | L3_TCA | L1_TCR | L2_TCR | L3_TCR | L1_TCW 70 | | L2_TCW | L3_TCW | FML_INS | FAD_INS | FDV_INS | FSQ_INS | FNV_INS | FP_OPS 71 | | SP_OPS | DP_OPS | VEC_SP | VEC_DP | REF_CYC 72 | (** PAPI [PRESET] events. 73 | 74 | The header file [papiStdEventDefs.h], installed by PAPI, is the 75 | authoritative description of events. 76 | 77 | Another way to obtain event descriptions is to call {!description}, or 78 | pretty-print them with {!pp_event}. *) 79 | 80 | external name : event -> string = "caml_papi_event_name" 81 | (** [name e] is a human-readable name for [e]. 82 | 83 | It returns [PAPI_event_info_t.name], without the prefix ["PAPI_"]. *) 84 | 85 | external description : event -> string = "caml_papi_event_descr" 86 | (** [description e] is a human-readable description of [e]. 87 | 88 | It returns [PAPI_event_info_t.long_descr]. *) 89 | 90 | external query : event -> bool = "caml_papi_query_event" 91 | (** [query e] is [true] iff the hardware supports the event [e]. *) 92 | 93 | val pp_event : Format.formatter -> event -> unit 94 | (** [pp_event ppf e] pretty-prints a human-readable description on [e] on [ppf]. *) 95 | 96 | val events : event array 97 | (** [events] contains all defined {{!event}events}. *) 98 | 99 | (** {1 Event sets} *) 100 | 101 | type eventset 102 | (** Sets of events. 103 | 104 | {b Note.} Eventsets are handles to resources held by PAPI. The handles are 105 | recycled. Calls to {!destroy} followed by {!create} can therefore return 106 | handles identical to previously destroyed handles, making destroyed 107 | eventsets {e live} again. 108 | *) 109 | 110 | external create : unit -> eventset = "caml_papi_create_eventset" 111 | (** [create ()] is a new {!eventset} [es]. 112 | 113 | Calls [PAPI_create_eventset]. *) 114 | 115 | external cleanup : eventset -> unit = "caml_papi_cleanup_eventset" 116 | (** [cleanup es] removes counters from [es]. 117 | 118 | Calls [PAPI_cleanup_eventset]. *) 119 | 120 | external destroy : eventset -> unit = "caml_papi_destroy_eventset" 121 | (** [destroy es] releases the resources backing [es]. 122 | 123 | Calls [PAPI_destroy_eventset]. *) 124 | 125 | external add : eventset -> event -> unit = "caml_papi_add_event" 126 | (** [add es e] adds the event [e] to [es]. 127 | 128 | Calls [PAPI_add_event]. *) 129 | 130 | external num_events : eventset -> int = "caml_papi_num_events" 131 | (** [num_events es] is the number of {{!event}events} currently attached to 132 | [es]. *) 133 | 134 | external start : eventset -> unit = "caml_papi_start" 135 | (** [start es] starts counting the events in [es]. 136 | 137 | Calls [PAPI_start]. *) 138 | 139 | external stop : eventset -> unit = "caml_papi_stop" 140 | (** [stop es] stops counting the events in [es]. 141 | 142 | Calls [PAPI_stop]. *) 143 | 144 | external reset : eventset -> unit = "caml_papi_reset" 145 | (** [reset es] resets the counters of events in [es]. 146 | 147 | Calls [PAPI_reset]. *) 148 | 149 | external read : eventset -> ?off:int -> float array -> unit = "caml_papi_read" 150 | (** [read es ~off values] [es]' event counters to [values]. 151 | 152 | These values are written to [values.(off), ..., values.(off + n - 1)] where 153 | [n] is [num_events es]. [off] defaults to [0]. 154 | 155 | Calls [PAPI_read]. *) 156 | 157 | external accum : eventset -> ?off:int -> float array -> unit = "caml_papi_accum" 158 | (** [accum es ~off values] adds [es]' event counters to [values] and resets 159 | them. 160 | 161 | These values are written to [values.(off), ..., values.(off + n - 1)] where 162 | [n] is [num_events es]. [off] defaults to [0]. 163 | 164 | Calls [PAPI_accum]. *) 165 | 166 | 167 | (** {1:examples Examples} 168 | 169 | Read the TSC and the actual number of cycles: 170 | {[ 171 | open Papi 172 | 173 | let _ = init () 174 | let _ = 175 | let es = create () 176 | and vs = Array.create_float 2 in 177 | List.iter (add es) [REF_CYC; TOT_CYC]; 178 | start es; 179 | long_running_fun (); 180 | read es vs; 181 | stop es; cleanup es; destroy es; 182 | Fmt.pr "reference: %f, total: %f\n" vs.(0) vs.(1) 183 | ]} 184 | 185 | Create bracket that reads a set of events: 186 | 187 | {[ 188 | open Papi 189 | 190 | let _ = init () 191 | let count_events ~events f = 192 | let es = create () 193 | and vs = Array.create_float (List.length events) in 194 | List.iter (add es) events; 195 | start es; 196 | let res = f () in 197 | read es vs; 198 | stop es; cleanup es; destroy es; 199 | (res, vs) 200 | ]} 201 | 202 | *) 203 | 204 | (* external description : event -> string = "caml_papi_event_descr" *) 205 | (* external short_description : event -> string = "caml_papi_event_short_descr" *) 206 | -------------------------------------------------------------------------------- /src/papi_top.ml: -------------------------------------------------------------------------------- 1 | (* Copyright (c) 2019 David Kaloper Meršinjak. All rights reserved. 2 | See LICENSE.md *) 3 | 4 | #if OCAML_VERSION >= (4,14,0) 5 | let _ = Toploop.use_silently Format.err_formatter (Toploop.File "papi_top_init.ml") 6 | #else 7 | let _ = Toploop.use_silently Format.err_formatter "papi_top_init.ml" 8 | #endif 9 | -------------------------------------------------------------------------------- /src/papi_top.mli: -------------------------------------------------------------------------------- 1 | (* Copyright (c) 2019 David Kaloper Meršinjak. All rights reserved. 2 | See LICENSE.md *) 3 | 4 | (** [#require "papi.top"] from toploop to install pretty-printers. *) 5 | -------------------------------------------------------------------------------- /src/papi_top_init.ml: -------------------------------------------------------------------------------- 1 | (* Copyright (c) 2019 David Kaloper Meršinjak. All rights reserved. 2 | See LICENSE.md *) 3 | 4 | let () = Papi.init () ;; 5 | 6 | #install_printer Papi.pp_event 7 | #install_printer Papi.pp_error 8 | #install_printer Papi.pp_exn_error 9 | -------------------------------------------------------------------------------- /test/dune: -------------------------------------------------------------------------------- 1 | (test (name test) (libraries papi fmt)) 2 | -------------------------------------------------------------------------------- /test/test.ml: -------------------------------------------------------------------------------- 1 | (* Copyright (c) 2019 David Kaloper Meršinjak. All rights reserved. 2 | See LICENSE.md *) 3 | 4 | 5 | (* let _ = *) 6 | (* Format.printf "counters: %d\ncomponents: %d\n%!" *) 7 | (* (Papi.counters ()) (Papi.components ()) *) 8 | 9 | 10 | let (%) f g x = f (g x) 11 | let pr fmt = Format.printf fmt 12 | 13 | let events = Papi.[TOT_CYC; L1_DCM; L1_ICM; L1_TCM; L2_DCM; L2_ICM; L2_TCM] 14 | 15 | let trap f = try f () with Papi.Error (e, n) as exn -> 16 | Format.printf "%s: %a\n%!" n Papi.pp_error e; raise exn 17 | 18 | let _ = Papi.init () 19 | 20 | let create ?events:(es = []) () = 21 | let open Papi in 22 | let set = create () in 23 | match List.partition query es with 24 | ([], _) -> 25 | pr "* No events available."; 26 | cleanup set; destroy set; 27 | None 28 | | (es1, es2) -> 29 | List.iter (add set) es1; 30 | List.iter (pr "+ Added event: %s\n%!" % name) es1; 31 | List.iter (pr "* Event unavailable: %s\n%!" % name) es2; 32 | Some set 33 | 34 | let _ = trap @@ fun () -> 35 | match create ~events () with 36 | Some set -> 37 | let res = Array.create_float (Papi.num_events set) in 38 | for i = 0 to Papi.num_events set - 1 do res.(i) <- 0. done; 39 | Papi.start set; 40 | for _ = 0 to 100 do 41 | Papi.read set res; 42 | Fmt.(pr "%a\n%!" (Dump.array float) res) 43 | done; 44 | Papi.(stop set; cleanup set; destroy set) 45 | | None -> () 46 | --------------------------------------------------------------------------------