Debug: remember previous log names per thread in a stack

The module ThreadLocalTable uses a Map data structure to keep track of
the name to use for a thread in the logs. A name is normally registered
through a call to `Debug.with_thread_associated`, soon after a thread is
created. However, each time a new context is created through a function
like `Server_helpers.exec_with_new_task`, `Debug.with_thread_associated`
is called as well, which then overwrites the name for the current
thread. When the inner task exits, the old name is not restore, but
simply left blank.

The result is the useful information end up missing from the first part
of log lines. For example. we see this

    [error||128 ||xenops]

rather than

    [error||128 |xapi events D:4f8a44d7e8d1|xenops]

In the past, there was a Hashtbl instead of a Map here, which does
remember all previous bindings in the table. The Hashtbl was removed in
order to avoid taking the lock in `find`.

This patchs adds a list inside each Map value to model a stack, which
behaves like Hashtbl, but in a pure functional way.

Signed-off-by: Rob Hoes <rob.hoes@citrix.com>

ocaml/libs/log/debug.ml

@@ -27,7 +27,9 @@ let get_thread_id () = try Thread.id (Thread.self ()) with _ -> -1
 module IntMap = Map.Make (Int)
 
 module ThreadLocalTable = struct
-  type 'a t = {mutable tbl: 'a IntMap.t; m: Mutex.t}
+  (* The map values behave like stacks here, with shadowing as in Hashtbl.
+     A Hashtbl is not used here, in order to avoid taking the lock in `find`. *)
+  type 'a t = {mutable tbl: 'a list IntMap.t; m: Mutex.t}
 
   let make () =
     let tbl = IntMap.empty in
@@ -36,15 +38,33 @@ module ThreadLocalTable = struct
 
   let add t v =
     let id = get_thread_id () in
-    Mutex.execute t.m (fun () -> t.tbl <- IntMap.add id v t.tbl)
+    Mutex.execute t.m (fun () ->
+        t.tbl <-
+          IntMap.update id
+            (function Some v' -> Some (v :: v') | None -> Some [v])
+            t.tbl
+    )
 
   let remove t =
     let id = get_thread_id () in
-    Mutex.execute t.m (fun () -> t.tbl <- IntMap.remove id t.tbl)
+    Mutex.execute t.m (fun () ->
+        t.tbl <-
+          IntMap.update id
+            (function
+              | Some [_] ->
+                  None
+              | Some (_hd :: tl) ->
+                  Some tl
+              | Some [] | None ->
+                  None
+              )
+            t.tbl
+    )
 
   let find t =
     let id = get_thread_id () in
     IntMap.find_opt id t.tbl
+    |> Option.fold ~none:None ~some:(function v :: _ -> Some v | [] -> None)
 end
 
 type task = {desc: string; client: string option}