try multicore

src/Tiny_httpd.ml

@@ -14,7 +14,8 @@ let _enable_debug b = _debug_on := b
 let _debug k =
   if !_debug_on then (
     k (fun fmt->
-       Printf.fprintf stdout "[http.thread %d]: " Thread.(id @@ self());
+      let id = (Domain.self () :> int) in
+       Printf.fprintf stdout "[http.thread %d]: " id;
        Printf.kfprintf (fun oc -> Printf.fprintf oc "\n%!") stdout fmt)
   )
 
@@ -766,7 +767,8 @@ type t = {
   addr: string;
   port: int;
   sem_max_connections: Sem_.t;
-  new_thread: (unit -> unit) -> unit;
+  pool: Domainslib.Task.pool;
+  new_thread: unit Domainslib.Task.task -> unit Domainslib.Task.promise;
   masksigpipe: bool;
   mutable handler: (string Request.t -> Response.t);
   mutable path_handlers : (unit Request.t -> cb_path_handler resp_result option) list;
@@ -840,11 +842,14 @@ let add_route_handler_stream ?accept ?meth self route f =
 let create
     ?(masksigpipe=true)
     ?(max_connections=32)
-    ?(new_thread=(fun f -> ignore (Thread.create f () : Thread.t)))
     ?(addr="127.0.0.1") ?(port=8080) () : t =
   let handler _req = Response.fail ~code:404 "no top handler" in
+  (* TODO: Make pool size configurable, and pick a better heuristic for the pool size. *)
+  let pool = Domainslib.Task.setup_pool ~num_domains:8 in
+  let new_thread = fun f -> Domainslib.Task.async pool f in
   let max_connections = max 4 max_connections in
   { new_thread; addr; port; masksigpipe; handler;
+  pool;
     running= true; sem_max_connections=Sem_.create max_connections;
     path_handlers=[];
     cb_encode_resp=[]; cb_decode_req=[];
@@ -967,7 +972,7 @@ let run (self:t) : (unit,_) result =
              (try Unix.close client_sock with _ -> ());
              Sem_.release 1 self.sem_max_connections;
              raise e
-        );
+        ) |> ignore
     done;
     Ok ()
   with e -> Error e

src/Tiny_httpd.mli

@@ -428,7 +428,6 @@ type t
 val create :
   ?masksigpipe:bool ->
   ?max_connections:int ->
-  ?new_thread:((unit -> unit) -> unit) ->
   ?addr:string ->
   ?port:int ->
   unit ->
@@ -567,4 +566,3 @@ val _debug : ((('a, out_channel, unit, unit, unit, unit) format6 -> 'a) -> unit)
 val _enable_debug: bool -> unit
 
 (**/**)
-

src/dune

@@ -2,7 +2,7 @@
 (library
   (name tiny_httpd)
   (public_name tiny_httpd)
-  (libraries threads)
+  (libraries unix domainslib threads)
   (inline_tests (backend qtest.lib))
   (flags :standard -safe-string)
   (wrapped false))

src/examples/echo.ml

@@ -1,6 +1,34 @@
 
 module S = Tiny_httpd
 
+let text =
+  "CHAPTER I. Down the Rabbit-Hole  Alice was beginning to get very tired of sitting by \
+   her sister on the bank, and of having nothing to do: once or twice she had peeped \
+   into the book her sister was reading, but it had no pictures or conversations in it, \
+   <and what is the use of a book,> thought Alice <without pictures or conversations?> \
+   So she was considering in her own mind (as well as she could, for the hot day made \
+   her feel very sleepy and stupid), whether the pleasure of making a daisy-chain would \
+   be worth the trouble of getting up and picking the daisies, when suddenly a White \
+   Rabbit with pink eyes ran close by her. There was nothing so very remarkable in that; \
+   nor did Alice think it so very much out of the way to hear the Rabbit say to itself, \
+   <Oh dear! Oh dear! I shall be late!> (when she thought it over afterwards, it \
+   occurred to her that she ought to have wondered at this, but at the time it all \
+   seemed quite natural); but when the Rabbit actually took a watch out of its \
+   waistcoat-pocket, and looked at it, and then hurried on, Alice started to her feet, \
+   for it flashed across her mind that she had never before seen a rabbit with either a \
+   waistcoat-pocket, or a watch to take out of it, and burning with curiosity, she ran \
+   across the field after it, and fortunately was just in time to see it pop down a \
+   large rabbit-hole under the hedge. In another moment down went Alice after it, never \
+   once considering how in the world she was to get out again. The rabbit-hole went \
+   straight on like a tunnel for some way, and then dipped suddenly down, so suddenly \
+   that Alice had not a moment to think about stopping herself before she found herself \
+   falling down a very deep well. Either the well was very deep, or she fell very \
+   slowly, for she had plenty of time as she went down to look about her and to wonder \
+   what was going to happen next. First, she tried to look down and make out what she \
+   was coming to, but it was too dark to see anything; then she looked at the sides of \
+   the well, and noticed that they were filled with cupboards......"
+;;
+
 let () =
   let port_ = ref 8080 in
   let j = ref 32 in
@@ -14,8 +42,8 @@ let () =
   Tiny_httpd_camlzip.setup ~compress_above:1024 ~buf_size:(1024*1024) server;
   (* say hello *)
   S.add_route_handler ~meth:`GET server
-    S.Route.(exact "hello" @/ string @/ return)
+    S.Route.(exact "hello" @/ return)
-    (fun name _req -> S.Response.make_string (Ok ("hello " ^name ^"!\n")));
+    (fun _req -> S.Response.make_string (Ok text));
   S.add_route_handler ~meth:`GET server
     S.Route.(exact "zcat" @/ string_urlencoded @/ return)
     (fun path _req ->