Upgrade to OCaml 4.11

src/statmemprof_driver.ml

@@ -3,7 +3,7 @@
    license.
   ---------------------------------------------------------------------------*)
 
-open Memprof
+module Memprof = Gc.Memprof
 
 (* Helper function for mutex with correct handling of exceptions. *)
 
@@ -18,7 +18,7 @@ let with_lock m f x =
 module ISet = Set.Make (
   struct
     type t = int
-    let compare : int -> int -> int = fun x y -> Pervasives.compare x y
+    let compare : int -> int -> int = fun x y -> Stdlib.compare x y
   end)
 
 let disabled_threads_ids = ref ISet.empty
@@ -44,6 +44,8 @@ let no_sampling f x =
 
 (* Data structures for sampled blocks *)
 
+type sample_info = { minor : bool ; info : Memprof.allocation }
+
 let min_buf_size = 1024
 let empty_ephe = Ephemeron.K1.create ()
 let samples = ref (Array.make min_buf_size empty_ephe)
@@ -76,21 +78,23 @@ let push e =
 
 (* Our callback. *)
 
-let callback : sample_info Memprof.callback = fun info ->
+let callback minor = fun info ->
   if is_disabled_thread (Thread.self ()) then None
   else
     let ephe = Ephemeron.K1.create () in
-    Ephemeron.K1.set_data ephe info;
+    Ephemeron.K1.set_data ephe ({ minor ; info } : sample_info);
     with_lock samples_lock push ephe;
     Some ephe
 
+let minor_alloc_callback = callback true
+let major_alloc_callback = callback false
+
 (* Control functions *)
 
-let started = ref false
-let start sampling_rate callstack_size min_samples_print =
-  if !started then failwith "Already started";
-  started := true;
-  Memprof.start { sampling_rate; callstack_size; callback }
+let start sampling_rate callstack_size =
+  Memprof.start ~sampling_rate ~callstack_size
+    ~minor_alloc_callback ~major_alloc_callback
+    ()
 
 let reset = no_sampling @@ with_lock samples_lock @@ fun () ->
   samples := Array.make min_buf_size empty_ephe;

src/statmemprof_driver.mli

@@ -3,6 +3,8 @@
    license.
   ---------------------------------------------------------------------------*)
 
+type sample_info = { minor : bool ; info : Gc.Memprof.allocation }
+
 (** After a call to this functions, blocks allocated by the given
     thread will no longer be sampled. *)
 val add_disabled_thread : Thread.t -> unit
@@ -22,17 +24,14 @@ val no_sampling : ('a -> 'b) -> 'a -> 'b
 val reset : unit -> unit
 
 (** [dump ()] dumps the current set of tracked blocks. *)
-val dump : unit -> Memprof.sample_info list
+val dump : unit -> sample_info list
 
-(** [start sampling_rate callstack_size min_sample_print] starts the
+(** [start sampling_rate callstack_size] starts the
     sampling on the current process.
 
     [sampling_rate] is the sampling rate of the profiler. Good value: 1e-4.
 
     [callstack_size] is the size of the fragment of the call stack
     which is captured for each sampled allocation.
-
-    [min_sample_print] is the minimum number of samples under which
-    the location of an allocation is not displayed.
  *)
-val start : float -> int -> int -> unit
+val start : float -> int -> unit

src/statmemprof_emacs.ml

@@ -6,40 +6,43 @@
 open Printexc
 open Inuit
 
+module Memprof = Gc.Memprof
+
 (* Reading and printing the set of samples. *)
 
+type sample_info = Statmemprof_driver.sample_info
+
 type sampleTree =
-    STC of Memprof.sample_info list * int *
+    STC of sample_info list * int *
              (raw_backtrace_slot, sampleTree) Hashtbl.t
 
-let add_sampleTree (t:sampleTree) (s:Memprof.sample_info) : sampleTree =
+let add_sampleTree (t:sampleTree) (s:sample_info) : sampleTree =
   let rec aux idx (STC (sl, n, sth)) =
-    if idx >= Printexc.raw_backtrace_length s.callstack then
-      STC(s::sl, n+s.n_samples, sth)
+    if idx >= Printexc.raw_backtrace_length s.info.callstack then
+      STC(s::sl, n+s.info.n_samples, sth)
     else
-      let li = Printexc.get_raw_backtrace_slot s.callstack idx in
+      let li = Printexc.get_raw_backtrace_slot s.info.callstack idx in
       let child =
         try Hashtbl.find sth li
         with Not_found -> STC ([], 0, Hashtbl.create 3)
       in
       Hashtbl.replace sth li (aux (idx+1) child);
-      STC(sl, n+s.n_samples, sth)
+      STC(sl, n+s.info.n_samples, sth)
   in
   aux 0 t
 
 type sortedSampleTree =
     SSTC of int array * int * (raw_backtrace_slot * sortedSampleTree) list
 
+let kind (s : sample_info) =
+  if s.info.unmarshalled then 2
+  else if s.minor then 0 else 1
+
 let acc_si si children =
   let acc = Array.make 3 0 in
   List.iter (fun s ->
-    let o = match s.Memprof.kind with
-      | Memprof.Minor -> 0
-      | Memprof.Major -> 1
-      | Memprof.Major_postponed -> 1
-      | Memprof.Serialized -> 2
-    in
-    acc.(o) <- acc.(o) + s.Memprof.n_samples;
+    let o = kind s in
+    acc.(o) <- acc.(o) + s.info.n_samples;
   ) si;
   List.iter (fun (_, SSTC (acc',_,_)) ->
     acc.(0) <- acc.(0) + acc'.(0);
@@ -111,7 +114,7 @@ let sturgeon_dump sampling_rate k =
 
 let started = ref false
 let start sampling_rate callstack_size min_samples_print =
-  Statmemprof_driver.start sampling_rate callstack_size min_samples_print;
+  Statmemprof_driver.start sampling_rate callstack_size;
   min_samples := min_samples_print;
   let name = Filename.basename Sys.executable_name in
   let server =

statmemprof-emacs.opam

@@ -10,11 +10,7 @@ doc: "https://jhjourdan.mketjh.fr//statmemprof-emacs/doc"
 bug-reports: "https://github.com/jhjourdan/statmemprof-emacs/issues"
 depends: [
   "ocaml"
-  "ocaml-variants"
-    { ="4.03.0+statistical-memprof"
-    | ="4.05.0+statistical-memprof"
-    | ="4.06.0+statistical-memprof"
-    | ="4.07.1+statistical-memprof"}
+  "ocaml-variants" {>="4.11.0+trunk"}
   "dune" {build & >= "1.0"}
   "sturgeon" {>= "0.3"}
   "inuit" {>= "0.3"}
@@ -26,6 +22,6 @@ build: [
 dev-repo: "git+https://github.com/jhjourdan/statmemprof-emacs.git"
 synopsis: "Emacs client for statistical memory profiler"
 description: """
-statmemprof-emacs is an Sturgeon/emacs front-end of the statmemprof
+statmemprof-emacs is an Sturgeon/emacs front-end of the memprof
 statistical memory profiler for OCaml.
 """