Merge pull request #30 from talex5/gc-colours

Show GC running in red

Author: talex5

README.md

@@ -101,18 +101,29 @@ Switches can be named using `Switch.run ~name`. Unnamed switches are shown as "s
 A context being cancelled is indicated by a vertical red line.
 
 Domain-wide events, such as garbage collection and waiting for events,
-are shown as yellow regions behind all the fibers in the domain.
-Nested events get progressively darker yellow.
+are shown as coloured regions behind all the fibers in the domain.
+GC periods are shown in shades of red when running, or yellow when waiting.
+Yellow is also used when the domain is waiting for events outside of GC.
 When there are multiple domains, they are shown stacked vertically:
 
 <p align='center'>
   <img src="./doc/gc.svg"/>
 </p>
 
 In the above trace, the upper domain performed GC while suspended
-(the dark "minor" region in the top right, inside the "suspend-domain" region).
+(the red "minor" region in the top right, inside the "suspend-domain" region).
 This is possible because each domain has a "backup" thread that handles GC while the domain is suspended.
 
+For minor GCs:
+1. The domain initiating the GC enters a "stw_leader" (stop-the-world) phase and waits for the other domains to stop.
+2. One by one, the other domains stop and enter "stw_api_barrier" until all domains have stopped.
+3. All domains perform a minor GC, clearing their minor heaps.
+4. They then enter a "minor_leave_barrier" phase, waiting until all domains have finished.
+5. Each domain returns to running application code (including GC finalizers).
+
+Phases that usually involve sleeping are shown with a yellow background, but sometimes they do perform work
+(the trace events don't give us enough information to know in all cases).
+
 ## Controls
 
 - F5 : reload the trace file
@@ -123,7 +134,7 @@ This is possible because each domain has a "backup" thread that handles GC while
 
 ## Limitations
 
-- OCaml 5.1 can [deadlock when tracing multiple domains](https://github.com/ocaml/ocaml/issues/12897). This should be fixed in OCaml 5.2.
+- OCaml 5.1 can [deadlock when tracing multiple domains](https://github.com/ocaml/ocaml/issues/12897). This was fixed in OCaml 5.2.
 - Events are reported per-domain, but not per-systhread.
   Events generated in systhreads will get mixed up and cannot be shown correctly.
   They will either appear attached to whatever fiber happens to be running, or shown as domain-level events.

doc/gc.svg

@@ -0,0 +1,3 @@
+(executable
+  (name main)
+  (libraries eio_main))

examples/domains/dune

@@ -0,0 +1,19 @@
+(* Run jobs using an executor pool, to get a trace with multiple domains showing GC. *)
+
+open Eio.Std
+
+let n_jobs = 10
+let domain_count = 2
+
+let run_job () =
+  let items = ref [] in
+  for _ = 1 to 1000 do
+    items := Bytes.create 1000 :: !items
+  done
+
+let () =
+  Eio_main.run @@ fun env ->
+  Switch.run @@ fun sw ->
+  let pool = Eio.Executor_pool.create ~sw ~domain_count env#domain_mgr in
+  let jobs = List.init n_jobs (fun _ -> Eio.Executor_pool.submit_fork ~sw ~weight:1. pool run_job) in
+  List.iter Promise.await_exn jobs

examples/domains/main.ml

@@ -69,7 +69,7 @@ module Ring = struct
   }
 
   type t = {
-    events : (timestamp * string list) array;
+    events : (timestamp * Trace.Ring.event list) array;
     mutable y : int;
     mutable height : int;
     mutable roots : root list;

lib/layout.ml

@@ -239,11 +239,26 @@ module Make (C : CANVAS) = struct
         let w = x1 -. x0 in
         begin match stack with
           | [] -> ()
-          | op :: p ->
-            let g = 1.0 -. min 1.0 (0.1 *. float (List.length stack)) in
+          | Suspend op :: p ->
+            begin match layer with
+              | `Bg ->
+                let g = 0.9 in
+                C.set_source_rgb cr ~r:g ~g:g ~b:(g /. 2.);
+                C.rectangle cr ~x:x0 ~y ~w ~h;
+                C.fill cr
+              | `Fg ->
+                if p == !prev_stack then (
+                  let clip_area = (w -. 0.2, v.height) in
+                  C.set_source_rgb cr ~r:0.0 ~g:0.0 ~b:0.0;
+                  C.paint_text cr ~x:(x0 +. 2.) ~y:(y +. 12.) op
+                    ~clip_area
+                )
+            end
+          | Gc op :: p ->
+            let g = max 0.1 (0.1 *. float (List.length stack)) in
             match layer with
             | `Bg ->
-              C.set_source_rgb cr ~r:g ~g:g ~b:(g /. 2.);
+              C.set_source_rgb cr ~r:1.0 ~g:g ~b:(g /. 2.);
               C.rectangle cr ~x:x0 ~y ~w ~h;
               C.fill cr
             | `Fg ->

lib/render.ml

@@ -38,9 +38,13 @@ module Ring = struct
     mutable cc : (timestamp * item) option;
   }
 
+  type event =
+    | Suspend of string
+    | Gc of string
+
   type t = {
     mutable current_fiber : int option;
-    mutable events : (timestamp * string list) list;
+    mutable events : (timestamp * event list) list;
     mutable roots : root list;
   }
 
@@ -161,7 +165,7 @@ let process_event t e =
   | "eio.span", name, Duration_begin ->
     begin match fiber_of_thread t thread with
       | Some fiber -> add_activation fiber timestamp (`Enter_span name)
-      | None -> ring_of_thread t thread |> Option.iter (fun ring -> Ring.push ring timestamp name)
+      | None -> ring_of_thread t thread |> Option.iter (fun ring -> Ring.push ring timestamp (Suspend name))
     end
   | "eio.span", _name, Duration_end ->
     begin match fiber_of_thread t thread with
@@ -201,7 +205,16 @@ let process_event t e =
   | "eio", ("suspend-domain" as phase), Duration_begin
   | "gc", phase, Duration_begin ->
     let r = ring_of_thread t thread |> Option.get in
-    Ring.push r timestamp phase
+    Ring.push r timestamp (
+      match phase with
+      | "suspend-domain"
+      | "major_gc_stw"
+      | "major_gc_phase_change"
+      | "stw_api_barrier"
+      | "minor_leave_barrier"
+      | "stw_leader" -> Ring.Suspend phase
+      | _ -> Ring.Gc phase
+    )
   | "eio", "suspend-domain", Duration_end
   | "gc", _, Duration_end ->
     let r = ring_of_thread t thread |> Option.get in