5.1.0

README.md

@@ -3,19 +3,17 @@ meio
 
 *Status: Experimental*
 
-Meio is a CLI tool for monitoring programs using [Eio][]. It allows you to see, in real-time, the running and idle fibers of your program along with the structure of the fiber tree. Fibers are also labelled with where they were spawned from and each individual fiber carries extra information about how busy it is, how often it is entered and the debug logs that have been run from the fiber. Here's what Meio looks like:
+Meio is a CLI tool for monitoring programs asynchronous programs like those that use [Eio][]. It allows you to see, in real-time, the running and idle fibers of your program along with the structure of the fiber tree. Fibers are also labelled with where they were spawned from and each individual fiber carries extra information about how busy it is, how often it is entered and the debug logs that have been run from the fiber. Here's what Meio looks like:
 
 ![Meio on asciicast](./.screencast/example.gif)
 
 ### Building meio
 
-Meio uses custom events which will be available in OCaml 5.1. This means currently you must use an unreleased compiler and a few forked libraries. 
-
-To build Meio locally, you can add a temporary opam-repository and use the custom-events compiler:
+Meio uses custom events which is only available in OCaml 5.1 and beyond.
 
 ```
-$ opam repo add custom-events https://github.com/TheLortex/custom-events-opam-repository.git
-$ opam switch create --no-install custom-events --packages ocaml-variants.5.0.0+custom-events --repositories=custom-events,default
+$ opam update
+$ opam switch create 5.1.0
 $ opam install --deps-only .
 $ dune build
 ```

dune-project

@@ -1,2 +1,2 @@
 (lang dune 2.9)
-(name ec)
+(name meio)

example/burn.ml

@@ -1,25 +1,25 @@
 open Eio
 
 let woops_sleepy ~clock =
-  Private.Ctf.set_name "sleeper";
+  Private.Tracing.set_name "sleeper";
   Switch.run ~name:"sleeper" @@ fun sw ->
   Fiber.fork ~sw (fun () ->
-      Private.Ctf.set_name "unix sleeper";
+      Private.Tracing.set_name "unix sleeper";
       (* Woops! Wrong sleep function, we blocked the fiber *)
       traceln "Woops! Blocked by Unix.sleepf";
       Unix.sleepf 5.;
       Time.sleep clock 10.)
 
 let spawn ~clock min max =
-  Private.Ctf.set_name (Fmt.str "spawn %d %d" min max);
+  Private.Tracing.set_name (Fmt.str "spawn %d %d" min max);
   (* Some GC action *)
   for _i = 0 to 100 do
     ignore (Sys.opaque_identity @@ Array.init 1000000 float_of_int)
   done;
   Switch.run @@ fun sw ->
   for i = min to max do
     Fiber.fork ~sw (fun () ->
-        Private.Ctf.set_name (Fmt.str "worker>%d" i);
+        Private.Tracing.set_name (Fmt.str "worker>%d" i);
         for i = 0 to max do
           (* Some more GC action *)
           for _i = 0 to 100 do
@@ -39,7 +39,7 @@ let main clock =
   Switch.run ~name:"main" @@ fun sw ->
   (* A long running task *)
   Fiber.fork ~sw (fun () ->
-      Private.Ctf.set_name "waiter";
+      Private.Tracing.set_name "waiter";
       traceln "stuck waiting :(";
       Promise.await p;
       traceln "Done");
@@ -53,6 +53,6 @@ let main clock =
 
 let () =
   Eio_main.run @@ fun env ->
-  Ctf.with_tracing @@ fun () ->
+  Tracing.with_tracing @@ fun () ->
   let clock = Stdenv.clock env in
   main clock

example/burn_domains.ml

@@ -42,7 +42,7 @@ let main dom_mgr clock =
 
 let () =
   Eio_main.run @@ fun env ->
-  Ctf.with_tracing @@ fun () ->
+  Tracing.with_tracing @@ fun () ->
   let clock = Stdenv.clock env in
   let dom_mgr = Stdenv.domain_mgr env in
   main dom_mgr clock

example/deadlock.ml

@@ -4,7 +4,7 @@ let fork wait =
   Switch.run @@ fun sw ->
   Fiber.fork ~sw (fun () ->
       (* Also add a really big label to test the handling of that in CTF. *)
-      Eio.Private.Ctf.log (String.make 5000 'e');
+      Eio.Private.Tracing.log (String.make 5000 'e');
       Promise.await wait)
 
 let main () =

example/main.ml

@@ -21,6 +21,6 @@ let main clock =
 
 let () =
   Eio_main.run @@ fun env ->
-  Ctf.with_tracing @@ fun () ->
+  Tracing.with_tracing @@ fun () ->
   let clock = Stdenv.clock env in
   main clock

example/zero.ml

@@ -8,9 +8,9 @@ let main clock =
       (* Eio.Switch.run ~name:"forked context" @@ fun sw ->
       traceln "in another context I do this" *)) *)
   (* for i = 0 to 10 do
-    Eio.Switch.run ~name:(Fmt.str "switch %d" i) @@ fun sw ->
-    traceln "welcome %d" i
-  done; *)
+       Eio.Switch.run ~name:(Fmt.str "switch %d" i) @@ fun sw ->
+       traceln "welcome %d" i
+     done; *)
   Eio.Time.sleep clock 100000.0
 
 let () =

meio-runtime-events.opam

@@ -0,0 +1,31 @@
+# This file is generated by dune, edit dune-project instead
+opam-version: "2.0"
+synopsis: "Monitor live Eio programs"
+description:
+  "Eio-console provides an executable that allows you to monitor OCaml programs using Eventring."
+maintainer: ["[email protected]"]
+authors: ["Patrick Ferris"]
+license: "MIT"
+homepage: "https://github.com/patricoferris/eio-console"
+bug-reports: "https://github.com/patricoferris/eio-console/issues"
+depends: [
+  "dune" {>= "2.9"}
+  "odoc" {with-doc}
+]
+build: [
+  ["dune" "subst"] {dev}
+  [
+    "dune"
+    "build"
+    "-p"
+    name
+    "-j"
+    jobs
+    "--promote-install-files=false"
+    "@install"
+    "@runtest" {with-test}
+    "@doc" {with-doc}
+  ]
+  ["dune" "install" "-p" name "--create-install-files" name]
+]
+dev-repo: "git+https://github.com/patricoferris/eio-console.git"

meio.opam

@@ -9,15 +9,15 @@ license: "MIT"
 homepage: "https://github.com/patricoferris/eio-console"
 bug-reports: "https://github.com/patricoferris/eio-console/issues"
 depends: [
-  "dune" {>= "2.9"}
-  "eio_main"
-  "eio" {= "0.8.1+custom-events.2"} # available in https://github.com/TheLortex/custom-events-opam-repository
+  "ocaml"             {>= "5.1.0"}
+  "dune"              {>= "2.9"}
   "astring"
   "ptime"
   "nottui"
   "cmdliner"
   "hdr_histogram"
-  "odoc" {with-doc}
+  "eio_main"          {with-test}
+  "odoc"              {with-doc}
 ]
 build: [
   ["dune" "subst"] {dev}
@@ -36,3 +36,7 @@ build: [
   ["dune" "install" "-p" name "--create-install-files" name]
 ]
 dev-repo: "git+https://github.com/patricoferris/eio-console.git"
+pin-depends:[
+  [ "eio.dev" "git+https://github.com/patricoferris/eio#dbd52c66a6e463720b48cb835d01f0e5c7c0b170"]
+  [ "eio_main.dev" "git+https://github.com/patricoferris/eio#dbd52c66a6e463720b48cb835d01f0e5c7c0b170" ]
+]

src/bin/dune

@@ -1,4 +1,5 @@
 (executable
  (name meio)
  (public_name meio)
- (libraries meio eio_main))
+ (package meio)
+ (libraries meio))

src/bin/meio.ml

@@ -1,4 +1,4 @@
-let run _stdenv exec_args =
+let run exec_args =
   let argsl = String.split_on_char ' ' exec_args in
   let executable_filename = List.hd argsl in
   let argsl = Array.of_list argsl in
@@ -12,7 +12,9 @@ let run _stdenv exec_args =
       |]
       (Unix.environment ())
   in
-  let dev_null = Unix.openfile Filename.null [ Unix.O_WRONLY; Unix.O_KEEPEXEC ] 0o666 in
+  let dev_null =
+    Unix.openfile Filename.null [ Unix.O_WRONLY; Unix.O_KEEPEXEC ] 0o666
+  in
   let child_pid =
     Unix.create_process_env executable_filename argsl env Unix.stdin dev_null
       dev_null
@@ -27,4 +29,4 @@ let run _stdenv exec_args =
   in
   Unix.unlink ring_file
 
-let () = Eio_main.run @@ fun stdenv -> run stdenv Sys.argv.(1)
+let () = run Sys.argv.(1)

src/lib/console.ml

@@ -147,7 +147,7 @@ let render_task sort now ~depth ~filtered
   let kind =
     W.string ~attr
       (match kind with
-      | Cancellation_context _ -> "cc"
+      | Meio_runtime_events.Cancellation_context _ -> "cc"
       | Task -> "task"
       | _ -> "??")
   in

src/lib/dune

@@ -4,4 +4,11 @@
  (foreign_stubs
   (language c)
   (names meio_console_stubs))
- (libraries eio eio.utils runtime_events ptime logs nottui hdr_histogram))
+ (libraries
+  runtime_events
+  ptime
+  logs
+  fmt
+  nottui
+  hdr_histogram
+  meio-runtime-events))

src/lib/help.ml

@@ -22,7 +22,7 @@ let footer sort screen =
       space;
       key_help ~attr:(attr `Task) 'e' "Fiber info";
       space;
-      key_help ~attr:(attr `Logs) 'l' ("Logs");
+      key_help ~attr:(attr `Logs) 'l' "Logs";
       space;
       key_help 's' ("Sort " ^ Sort.to_string sort);
       space;

src/lib/lf_queue.ml

@@ -0,0 +1,140 @@
+(* Copyright (C) 2021 Anil Madhavapeddy
+      Copyright (C) 2022 Thomas Leonard
+
+   Permission to use, copy, modify, and distribute this software for any
+   purpose with or without fee is hereby granted, provided that the above
+   copyright notice and this permission notice appear in all copies.
+
+   THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
+   WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
+   MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
+   ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
+   WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
+   ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
+   OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. *)
+
+(* A lock-free multi-producer, single-consumer, thread-safe queue without support for cancellation.
+   This makes a good data structure for a scheduler's run queue.
+
+   See: "Implementing lock-free queues"
+   https://people.cs.pitt.edu/~jacklange/teaching/cs2510-f12/papers/implementing_lock_free.pdf
+
+   It is simplified slightly because we don't need multiple consumers.
+   Therefore [head] is not atomic. *)
+
+exception Closed
+
+module Node : sig
+  type 'a t = { next : 'a opt Atomic.t; mutable value : 'a }
+  and +'a opt
+
+  val make : next:'a opt -> 'a -> 'a t
+
+  val none : 'a opt
+  (** [t.next = none] means that [t] is currently the last node. *)
+
+  val closed : 'a opt
+  (** [t.next = closed] means that [t] will always be the last node. *)
+
+  val some : 'a t -> 'a opt
+  val fold : 'a opt -> none:(unit -> 'b) -> some:('a t -> 'b) -> 'b
+end = struct
+  (* https://github.com/ocaml/RFCs/pull/14 should remove the need for magic here *)
+
+  type +'a opt (* special | 'a t *)
+  type 'a t = { next : 'a opt Atomic.t; mutable value : 'a }
+  type special = Nothing | Closed
+
+  let none : 'a. 'a opt = Obj.magic Nothing
+  let closed : 'a. 'a opt = Obj.magic Closed
+  let some (t : 'a t) : 'a opt = Obj.magic t
+
+  let fold (opt : 'a opt) ~none:n ~some =
+    if opt == none then n ()
+    else if opt == closed then raise Closed
+    else some (Obj.magic opt : 'a t)
+
+  let make ~next value = { value; next = Atomic.make next }
+end
+
+type 'a t = { tail : 'a Node.t Atomic.t; mutable head : 'a Node.t }
+(* [head] is the last node dequeued (or a dummy node, initially).
+   [head.next] gives the real first node, if not [Node.none].
+   If [tail.next] is [none] then it is the last node in the queue.
+   Otherwise, [tail.next] is a node that is closer to the tail. *)
+
+let push t x =
+  let node = Node.(make ~next:none) x in
+  let rec aux () =
+    let p = Atomic.get t.tail in
+    (* While [p.next == none], [p] is the last node in the queue. *)
+    if Atomic.compare_and_set p.next Node.none (Node.some node) then
+      (* [node] has now been added to the queue (and possibly even consumed).
+         Update [tail], unless someone else already did it for us. *)
+      ignore (Atomic.compare_and_set t.tail p node : bool)
+    else
+      (* Someone else added a different node first ([p.next] is not [none]).
+         Make [t.tail] more up-to-date, if it hasn't already changed, and try again. *)
+      Node.fold (Atomic.get p.next)
+        ~none:(fun () -> assert false)
+        ~some:(fun p_next ->
+          ignore (Atomic.compare_and_set t.tail p p_next : bool);
+          aux ())
+  in
+  aux ()
+
+let rec push_head t x =
+  let p = t.head in
+  let next = Atomic.get p.next in
+  if next == Node.closed then raise Closed;
+  let node = Node.make ~next x in
+  if Atomic.compare_and_set p.next next (Node.some node) then
+    if
+      (* We don't want to let [tail] get too far behind, so if the queue was empty, move it to the new node. *)
+      next == Node.none
+    then ignore (Atomic.compare_and_set t.tail p node : bool)
+    else
+      ( (* If the queue wasn't empty, there's nothing to do.
+           Either tail isn't at head or there is some [push] thread working to update it.
+           Either [push] will update it directly to the new tail, or will update it to [node]
+           and then retry. Either way, it ends up at the real tail. *) )
+  else (
+    (* Someone else changed it first. This can only happen if the queue was empty. *)
+    assert (next == Node.none);
+    push_head t x)
+
+let rec close (t : 'a t) =
+  (* Mark the tail node as final. *)
+  let p = Atomic.get t.tail in
+  if not (Atomic.compare_and_set p.next Node.none Node.closed) then
+    (* CAS failed because [p] is no longer the tail (or is already closed). *)
+    Node.fold (Atomic.get p.next)
+      ~none:(fun () -> assert false)
+        (* Can't switch from another state to [none] *)
+      ~some:(fun p_next ->
+        (* Make [tail] more up-to-date if it hasn't changed already *)
+        ignore (Atomic.compare_and_set t.tail p p_next : bool);
+        (* Retry *)
+        close t)
+
+let pop t =
+  let p = t.head in
+  (* [p] is the previously-popped item. *)
+  let node = Atomic.get p.next in
+  Node.fold node
+    ~none:(fun () -> None)
+    ~some:(fun node ->
+      t.head <- node;
+      let v = node.value in
+      node.value <- Obj.magic ();
+      (* So it can be GC'd *)
+      Some v)
+
+let is_empty t =
+  Node.fold (Atomic.get t.head.next)
+    ~none:(fun () -> true)
+    ~some:(fun _ -> false)
+
+let create () =
+  let dummy = { Node.value = Obj.magic (); next = Atomic.make Node.none } in
+  { tail = Atomic.make dummy; head = dummy }

src/lib/logging.ml

@@ -1,4 +1,4 @@
-module Queue = Eio_utils.Lf_queue
+module Queue = Lf_queue
 
 let table = Lwd_table.make ()
 let waiting = Queue.create ()