From 66c4525726dc2a3dff42800d7f1bee87a0905a0b Mon Sep 17 00:00:00 2001
From: Simon Cruanes <simon.cruanes.2007@m4x.org>
Date: Thu, 5 Dec 2019 09:13:57 -0600
Subject: [PATCH] wip: try jemalloc

---
 src/Tiny_httpd.ml    |  2 +-
 src/examples/dune    |  2 +-
 src/examples/echo.ml | 26 +++++++++++++++++++++++---
 3 files changed, 25 insertions(+), 5 deletions(-)

diff --git a/src/Tiny_httpd.ml b/src/Tiny_httpd.ml
index 751ee0ca..5a036ef6 100644
--- a/src/Tiny_httpd.ml
+++ b/src/Tiny_httpd.ml
@@ -796,7 +796,7 @@ let run (self:t) : (unit,_) result =
            with e ->
              Sem_.release self.sem_max_connections;
              close_();
-             raise e
+             _debug (fun k->k "error in thread: %s" (Printexc.to_string e));
         );
     done;
     Ok ()
diff --git a/src/examples/dune b/src/examples/dune
index 7a1eef1e..4e095163 100644
--- a/src/examples/dune
+++ b/src/examples/dune
@@ -1,4 +1,4 @@
 
 (executables
   (names echo)
-  (libraries tiny_httpd statmemprof-notty))
+  (libraries tiny_httpd containers.thread jemalloc))
diff --git a/src/examples/echo.ml b/src/examples/echo.ml
index 0a673e74..103f532e 100644
--- a/src/examples/echo.ml
+++ b/src/examples/echo.ml
@@ -1,6 +1,23 @@
 
 module S = Tiny_httpd
 
+(*
+open Jemalloc
+
+let show_crt_info () =
+  let b = string_of_int in
+  try
+    let memory = get_memory_stats () in
+    Printf.sprintf "MALLOC: size %s, used %s, heap %s, free %s" (b memory.mapped) (b memory.active) (b memory.allocated) (b (memory.mapped - memory.active))
+  with exn ->
+    Printf.sprintf "MALLOC:? (error %s)" (Printexc.to_string exn)
+
+let setup () =
+  Memory.show_crt_info := show_crt_info;
+  Memory.malloc_release := release_free_memory;
+  ()
+   *)
+
 let () =
   let port_ = ref 8080 in
   let j = ref 32 in
@@ -10,7 +27,10 @@ let () =
       "--debug", Arg.Unit (fun () -> S._enable_debug true), " enable debug";
       "-j", Arg.Set_int j, " maximum number of connections";
     ]) (fun _ -> raise (Arg.Bad "")) "echo [option]*";
-  let server = S.create ~port:!port_ ~max_connections:!j () in
+(*   let module P = CCPool.Make(struct let max_size = 30 end) in *)
+  let server = S.create ~port:!port_ ~max_connections:!j
+(*       ~new_thread:P.run *)
+      () in
   (* say hello *)
   S.add_path_handler ~meth:`GET server
     "/hello/%s@/" (fun name _req -> S.Response.make_string (Ok ("hello " ^name ^"!\n")));
@@ -20,7 +40,7 @@ let () =
   S.add_path_handler ~meth:`POST server
     "/debug/%B" (fun b _req -> S._enable_debug b; S.Response.make_string (Ok "ok"));
   S.add_path_handler ~meth:`POST server
-    "/compact/" (fun _req -> Gc.compact(); S.Response.make_string (Ok "gc.compact: done"));
+    "/compact/" (fun _req -> Gc.compact(); Jemalloc.release_free_memory(); S.Response.make_string (Ok "gc.compact: done"));
   S.add_path_handler ~meth:`POST server
     "/quit/" (fun _req -> S.stop server; S.Response.make_string (Ok "bye"));
   S.add_path_handler ~meth:`PUT server
@@ -35,7 +55,7 @@ let () =
           S.Response.fail ~code:500 "couldn't upload file: %s" (Printexc.to_string e)
       );
   Printf.printf "listening on http://%s:%d\n%!" (S.addr server) (S.port server);
-  ignore @@ Thread.create (fun () -> Statmemprof_inuit.start 1e-4 300 2) ();
+(*   ignore @@ Thread.create (fun () -> Statmemprof_inuit.start 1e-4 300 2) (); *)
   match S.run server with
   | Ok () -> ()
   | Error e -> raise e