├── .gitignore ├── .ocp-indent ├── CHANGES.md ├── LICENSE.md ├── README.md ├── dune-project ├── src ├── dune ├── statmemprof_driver.ml ├── statmemprof_driver.mli ├── statmemprof_emacs.ml └── statmemprof_emacs.mli └── statmemprof-emacs.opam /.gitignore: -------------------------------------------------------------------------------- 1 | _build 2 | tmp 3 | *~ 4 | \.\#* 5 | \#*# 6 | *.install 7 | *.native 8 | *.byte -------------------------------------------------------------------------------- /.ocp-indent: -------------------------------------------------------------------------------- 1 | strict_with=always,match_clause=4,strict_else=never 2 | -------------------------------------------------------------------------------- /CHANGES.md: -------------------------------------------------------------------------------- 1 | v0.1.0 2017-11-12 2 | ----------------- 3 | 4 | First release. 5 | -------------------------------------------------------------------------------- /LICENSE.md: -------------------------------------------------------------------------------- 1 | MIT License 2 | 3 | Copyright (c) 2017 CNRS and Frédéric Bour 4 | 5 | Permission is hereby granted, free of charge, to any person obtaining a copy 6 | of this software and associated documentation files (the "Software"), to deal 7 | in the Software without restriction, including without limitation the rights 8 | to use, copy, modify, merge, publish, distribute, sublicense, and/or sell 9 | copies of the Software, and to permit persons to whom the Software is 10 | furnished to do so, subject to the following conditions: 11 | 12 | The above copyright notice and this permission notice shall be included in all 13 | copies or substantial portions of the Software. 14 | 15 | THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 16 | IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 17 | FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE 18 | AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER 19 | LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 20 | OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE 21 | SOFTWARE. 22 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | statmemprof-emacs — Emacs client for statistical memory profiler 2 | ------------------------------------------------------------------------------- 3 | %%VERSION%% 4 | 5 | statmemprof-emacs is an Sturgeon/emacs front-end of the statmemprof 6 | statistical memory profiler for OCaml. 7 | 8 | statmemprof-emacs is distributed under the MIT license. 9 | 10 | Homepage: https://github.com/jhjourdan/statmemprof-emacs 11 | 12 | ## Installation 13 | 14 | statmemprof-emacs can be installed with `opam`, when one of the 15 | xxxx-statistical-memprof OCaml switches is installed. These switches 16 | are available on opam. Then you can use the following command: 17 | 18 | opam install statmemprof-emacs 19 | 20 | If you don't use `opam` consult the [`opam`](statmemprof-emacs.opam) file for 21 | build instructions. 22 | 23 | ## Usage 24 | 25 | In the OCaml program you need to profile, you can start the profiling 26 | by executing the following instruction (see the documentation in 27 | statmenprof_emacs.mli for more details): 28 | 29 | Statmemprof_emacs.start 1E-4 30 5 30 | 31 | Then, in emacs, load the file sturgeon.el (coming with you Sturgeon 32 | installation), and type M-x sturgeon-connect. 33 | 34 | Then, you might be asked: 35 | - for a path for the sturgeon-connector command, which will be in 36 | your opam swich's ```bin``` directory; 37 | - a socket to connect to, which emacs auto-complete will help you to 38 | find. 39 | -------------------------------------------------------------------------------- /dune-project: -------------------------------------------------------------------------------- 1 | (lang dune 1.0) 2 | (name statmemprof-emacs) 3 | -------------------------------------------------------------------------------- /src/dune: -------------------------------------------------------------------------------- 1 | (library 2 | (name statmemprof_emacs) 3 | (public_name statmemprof-emacs) 4 | (synopsis "Emacs client for statistical memory profiler") 5 | (wrapped false) 6 | (libraries inuit sturgeon.recipes_server)) 7 | -------------------------------------------------------------------------------- /src/statmemprof_driver.ml: -------------------------------------------------------------------------------- 1 | (*--------------------------------------------------------------------------- 2 | Copyright (c) 2017 CNRS. All rights reserved. Distributed under the MIT 3 | license. 4 | ---------------------------------------------------------------------------*) 5 | 6 | open Memprof 7 | 8 | (* Helper function for mutex with correct handling of exceptions. *) 9 | 10 | let with_lock m f x = 11 | Mutex.lock m; 12 | match f x with 13 | | exception e -> Mutex.unlock m; raise e 14 | | y -> Mutex.unlock m; y 15 | 16 | (* Sampling is deactivated for these threads. *) 17 | 18 | module ISet = Set.Make ( 19 | struct 20 | type t = int 21 | let compare : int -> int -> int = fun x y -> Pervasives.compare x y 22 | end) 23 | 24 | let disabled_threads_ids = ref ISet.empty 25 | let disabled_threads_mutex = Mutex.create () 26 | let add_disabled_thread = with_lock disabled_threads_mutex @@ fun thread -> 27 | disabled_threads_ids := ISet.add (Thread.id thread) !disabled_threads_ids 28 | let remove_disabled_thread = with_lock disabled_threads_mutex @@ fun thread -> 29 | disabled_threads_ids := ISet.remove (Thread.id thread) !disabled_threads_ids 30 | let is_disabled_thread thread = 31 | (* Reading from the reference is atomic, so no need to take the lock 32 | here. *) 33 | ISet.mem (Thread.id thread) !disabled_threads_ids 34 | 35 | let no_sampling f x = 36 | let th = Thread.self () in 37 | if is_disabled_thread th then f x 38 | else begin 39 | add_disabled_thread th; 40 | match f x with 41 | | exception e -> remove_disabled_thread th; raise e 42 | | y -> remove_disabled_thread th; y 43 | end 44 | 45 | (* Data structures for sampled blocks *) 46 | 47 | let min_buf_size = 1024 48 | let empty_ephe = Ephemeron.K1.create () 49 | let samples = ref (Array.make min_buf_size empty_ephe) 50 | let n_samples = ref 0 51 | let samples_lock = Mutex.create () 52 | 53 | (* Data structure management functions. *) 54 | 55 | let clean () = 56 | let s = !samples and sz = !n_samples in 57 | let rec aux i j = 58 | if i >= sz then j 59 | else if Ephemeron.K1.check_key s.(i) then (s.(j) <- s.(i); aux (i+1) (j+1)) 60 | else aux (i+1) j 61 | in 62 | n_samples := aux 0 0; 63 | Array.fill s !n_samples (sz - !n_samples) empty_ephe; 64 | if 8 * !n_samples <= Array.length s && Array.length s > min_buf_size then 65 | samples := Array.sub s 0 (max min_buf_size (2 * !n_samples)) 66 | else if 2 * !n_samples > Array.length s then begin 67 | let s_new = Array.make (2 * !n_samples) empty_ephe in 68 | Array.blit !samples 0 s_new 0 !n_samples; 69 | samples := s_new 70 | end 71 | 72 | let push e = 73 | if !n_samples = Array.length !samples then clean (); 74 | !samples.(!n_samples) <- e; 75 | incr n_samples 76 | 77 | (* Our callback. *) 78 | 79 | let callback : sample_info Memprof.callback = fun info -> 80 | if is_disabled_thread (Thread.self ()) then None 81 | else 82 | let ephe = Ephemeron.K1.create () in 83 | Ephemeron.K1.set_data ephe info; 84 | with_lock samples_lock push ephe; 85 | Some ephe 86 | 87 | (* Control functions *) 88 | 89 | let started = ref false 90 | let start sampling_rate callstack_size min_samples_print = 91 | if !started then failwith "Already started"; 92 | started := true; 93 | Memprof.start { sampling_rate; callstack_size; callback } 94 | 95 | let reset = no_sampling @@ with_lock samples_lock @@ fun () -> 96 | samples := Array.make min_buf_size empty_ephe; 97 | n_samples := 0 98 | 99 | let dump = no_sampling @@ with_lock samples_lock @@ fun () -> 100 | let s, sz = !samples, !n_samples in 101 | let rec aux acc i = 102 | if i >= sz then acc 103 | else match Ephemeron.K1.get_data s.(i) with 104 | | None -> aux acc (i+1) 105 | | Some s -> aux (s :: acc) (i+1) 106 | in 107 | aux [] 0 108 | -------------------------------------------------------------------------------- /src/statmemprof_driver.mli: -------------------------------------------------------------------------------- 1 | (*--------------------------------------------------------------------------- 2 | Copyright (c) 2017 CNRS. All rights reserved. Distributed under the MIT 3 | license. 4 | ---------------------------------------------------------------------------*) 5 | 6 | (** After a call to this functions, blocks allocated by the given 7 | thread will no longer be sampled. *) 8 | val add_disabled_thread : Thread.t -> unit 9 | 10 | (** Removing a thread from the disabled set. *) 11 | val remove_disabled_thread : Thread.t -> unit 12 | 13 | (** Is this thread disabled for sampling? *) 14 | val is_disabled_thread : Thread.t -> bool 15 | 16 | (** [no_sampling f x] executes [f x] by temporarilly disabling 17 | sampling for the current thread. If an exception occurs, sampling 18 | is re-enabled. *) 19 | val no_sampling : ('a -> 'b) -> 'a -> 'b 20 | 21 | (** [reset ()] empties the current set of tracked blocks. *) 22 | val reset : unit -> unit 23 | 24 | (** [dump ()] dumps the current set of tracked blocks. *) 25 | val dump : unit -> Memprof.sample_info list 26 | 27 | (** [start sampling_rate callstack_size min_sample_print] starts the 28 | sampling on the current process. 29 | 30 | [sampling_rate] is the sampling rate of the profiler. Good value: 1e-4. 31 | 32 | [callstack_size] is the size of the fragment of the call stack 33 | which is captured for each sampled allocation. 34 | 35 | [min_sample_print] is the minimum number of samples under which 36 | the location of an allocation is not displayed. 37 | *) 38 | val start : float -> int -> int -> unit 39 | -------------------------------------------------------------------------------- /src/statmemprof_emacs.ml: -------------------------------------------------------------------------------- 1 | (*--------------------------------------------------------------------------- 2 | Copyright (c) 2017 CNRS and Frédéric Bour. All rights reserved. 3 | Distributed under the MIT license. 4 | ---------------------------------------------------------------------------*) 5 | 6 | open Printexc 7 | open Inuit 8 | 9 | (* Reading and printing the set of samples. *) 10 | 11 | type sampleTree = 12 | STC of Memprof.sample_info list * int * 13 | (raw_backtrace_slot, sampleTree) Hashtbl.t 14 | 15 | let add_sampleTree (t:sampleTree) (s:Memprof.sample_info) : sampleTree = 16 | let rec aux idx (STC (sl, n, sth)) = 17 | if idx >= Printexc.raw_backtrace_length s.callstack then 18 | STC(s::sl, n+s.n_samples, sth) 19 | else 20 | let li = Printexc.get_raw_backtrace_slot s.callstack idx in 21 | let child = 22 | try Hashtbl.find sth li 23 | with Not_found -> STC ([], 0, Hashtbl.create 3) 24 | in 25 | Hashtbl.replace sth li (aux (idx+1) child); 26 | STC(sl, n+s.n_samples, sth) 27 | in 28 | aux 0 t 29 | 30 | type sortedSampleTree = 31 | SSTC of int array * int * (raw_backtrace_slot * sortedSampleTree) list 32 | 33 | let acc_si si children = 34 | let acc = Array.make 3 0 in 35 | List.iter (fun s -> 36 | let o = match s.Memprof.kind with 37 | | Memprof.Minor -> 0 38 | | Memprof.Major -> 1 39 | | Memprof.Major_postponed -> 1 40 | | Memprof.Serialized -> 2 41 | in 42 | acc.(o) <- acc.(o) + s.Memprof.n_samples; 43 | ) si; 44 | List.iter (fun (_, SSTC (acc',_,_)) -> 45 | acc.(0) <- acc.(0) + acc'.(0); 46 | acc.(1) <- acc.(1) + acc'.(1); 47 | acc.(2) <- acc.(2) + acc'.(2); 48 | ) children; 49 | acc 50 | 51 | let rec sort_sampleTree (t:sampleTree) : sortedSampleTree = 52 | let STC (sl, n, sth) = t in 53 | let children = 54 | List.sort (fun (_, SSTC (_, n1, _)) (_, SSTC (_, n2, _)) -> n2 - n1) 55 | (Hashtbl.fold (fun li st lst -> (li, sort_sampleTree st)::lst) sth []) 56 | in 57 | SSTC (acc_si sl children, n, children) 58 | 59 | let dump_SST () = 60 | Statmemprof_driver.dump () 61 | |> List.fold_left add_sampleTree (STC ([], 0, Hashtbl.create 3)) 62 | |> sort_sampleTree 63 | 64 | let min_samples = ref 0 65 | 66 | let sturgeon_dump sampling_rate k = 67 | let print_acc k acc = 68 | let n = acc.(0) + acc.(1) + acc.(2) in 69 | let percent x = float x /. float n *. 100.0 in 70 | if n > 0 then begin 71 | Cursor.printf k " ("; 72 | if acc.(0) > 0 then begin 73 | Cursor.printf k "%02.2f%% minor" (percent acc.(0)); 74 | if acc.(0) < n then Cursor.printf k ", " 75 | end; 76 | if acc.(1) > 0 then begin 77 | Cursor.printf k "%02.2f%% major" (percent acc.(1)); 78 | if acc.(2) > 0 then Cursor.printf k ", " 79 | end; 80 | if acc.(2) > 0 then 81 | Cursor.printf k "%02.2f%% unmarshal" (percent acc.(2)); 82 | Cursor.printf k ")" 83 | end 84 | in 85 | let rec aux root (slot, SSTC (si, n, bt)) = 86 | if n >= !min_samples then ( 87 | let children = 88 | if List.exists (fun (_,SSTC(_,n',_)) -> n' >= !min_samples) bt then 89 | Some (fun root' -> List.iter (aux root') bt) 90 | else None 91 | in 92 | let node = Widget.Tree.add ?children root in 93 | begin match Printexc.Slot.location (convert_raw_backtrace_slot slot) with 94 | | Some { filename; line_number; start_char; end_char } -> 95 | Cursor.printf node "%11.2f MB | %s:%d %d-%d" 96 | (float n /. sampling_rate *. float Sys.word_size /. 8e6) 97 | filename line_number start_char end_char 98 | | None -> 99 | Cursor.printf node "%11.2f MB | ?" 100 | (float n /. sampling_rate *. float Sys.word_size /. 8e6) 101 | end; 102 | print_acc node si 103 | ) 104 | in 105 | let (SSTC (si, n, bt)) = dump_SST () in 106 | let root = Widget.Tree.make k in 107 | let node = Widget.Tree.add root ~children:(fun root' -> List.iter (aux root') bt) in 108 | Cursor.printf node "%11.2f MB total " 109 | (float n /. sampling_rate *. float Sys.word_size /. 8e6); 110 | print_acc node si 111 | 112 | let started = ref false 113 | let start sampling_rate callstack_size min_samples_print = 114 | Statmemprof_driver.start sampling_rate callstack_size min_samples_print; 115 | min_samples := min_samples_print; 116 | let name = Filename.basename Sys.executable_name in 117 | let server = 118 | Sturgeon_recipes_server.text_server (name ^ "memprof") 119 | @@ fun ~args:_ shell -> 120 | let cursor = Sturgeon_stui.create_cursor shell ~name in 121 | let menu = Cursor.sub cursor in 122 | Cursor.text cursor "\n"; 123 | let body = Cursor.sub cursor in 124 | Cursor.link menu "[Refresh]" 125 | (fun _ -> Cursor.clear body; sturgeon_dump sampling_rate body); 126 | sturgeon_dump sampling_rate body 127 | in 128 | ignore (Thread.create (fun () -> 129 | Statmemprof_driver.add_disabled_thread (Thread.self ()); 130 | Sturgeon_recipes_server.main_loop server) ()); 131 | 132 | (* HACK : when the worker thread computes, it does not give back the 133 | control to the sturgeon thread easily. As a result, the sturgeon 134 | interface is not responsive. 135 | 136 | We solve this issue by periodically suspending the worker thread 137 | for a very short time. *) 138 | let preempt signal = Thread.delay 1e-6 in 139 | Sys.set_signal Sys.sigvtalrm (Sys.Signal_handle preempt); 140 | ignore (Unix.setitimer Unix.ITIMER_VIRTUAL 141 | { Unix.it_interval = 1e-2; Unix.it_value = 1e-2 }) 142 | -------------------------------------------------------------------------------- /src/statmemprof_emacs.mli: -------------------------------------------------------------------------------- 1 | (*--------------------------------------------------------------------------- 2 | Copyright (c) 2017 CNRS. All rights reserved. Distributed under the MIT 3 | license. 4 | ---------------------------------------------------------------------------*) 5 | 6 | (** [start sampling_rate callstack_size min_sample_print] starts the 7 | sampling on the current process and creates a Sturgeon server to 8 | be used from emacs for profiling memory consumption. 9 | 10 | [sampling_rate] is the sampling rate of the profiler. Good value: 1e-4. 11 | 12 | [callstack_size] is the size of the fragment of the call stack 13 | which is captured for each sampled allocation. 14 | 15 | [min_sample_print] is the minimum number of samples under which 16 | the location of an allocation is not displayed. 17 | *) 18 | val start : float -> int -> int -> unit 19 | -------------------------------------------------------------------------------- /statmemprof-emacs.opam: -------------------------------------------------------------------------------- 1 | opam-version: "2.0" 2 | maintainer: "Jacques-Henri Jourdan " 3 | authors: [ 4 | "Jacques-Henri Jourdan " 5 | "Frédéric Bour " 6 | ] 7 | license: "MIT" 8 | homepage: "https://github.com/jhjourdan/statmemprof-emacs" 9 | doc: "https://jhjourdan.mketjh.fr//statmemprof-emacs/doc" 10 | bug-reports: "https://github.com/jhjourdan/statmemprof-emacs/issues" 11 | depends: [ 12 | "ocaml" 13 | "ocaml-variants" 14 | { ="4.03.0+statistical-memprof" 15 | | ="4.05.0+statistical-memprof" 16 | | ="4.06.0+statistical-memprof" 17 | | ="4.07.1+statistical-memprof"} 18 | "dune" {build & >= "1.0"} 19 | "sturgeon" {>= "0.3"} 20 | "inuit" {>= "0.3"} 21 | ] 22 | build: [ 23 | ["dune" "subst"] {pinned} 24 | ["dune" "build" "-p" name "-j" jobs] 25 | ] 26 | dev-repo: "git+https://github.com/jhjourdan/statmemprof-emacs.git" 27 | synopsis: "Emacs client for statistical memory profiler" 28 | description: """ 29 | statmemprof-emacs is an Sturgeon/emacs front-end of the statmemprof 30 | statistical memory profiler for OCaml. 31 | """ 32 | --------------------------------------------------------------------------------