simon/tiny_httpd
1
0
Fork 0
mirror of https://github.com/c-cube/tiny_httpd.git synced 2025-12-05 19:00:32 -05:00
Code Issues Projects Releases Packages Wiki Activity Actions

wip: try jemalloc

Browse source
This commit is contained in:
Simon Cruanes 2019-12-05 09:13:57 -06:00
parent 64e232e459
commit 66c4525726
3 changed files with 25 additions and 5 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

2
src/Tiny_httpd.ml
View file

@ -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 ()

2
src/examples/dune
View file

@ -1,4 +1,4 @@
(executables
(names echo)
(libraries tiny_httpd statmemprof-notty))
(libraries tiny_httpd containers.thread jemalloc))

26
src/examples/echo.ml
View file

@ -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