Skip to content

Commit 8cd79b8

Browse files
raphael-proustraphael-proust
committed
emit runtime events
1 parent 47bcbfd commit 8cd79b8

File tree

9 files changed

+26
-4
lines changed

9 files changed

+26
-4
lines changed

‎dune-project‎

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -76,7 +76,7 @@ a single thread by default. This reduces the need for locks or other
7676
synchronization primitives. Code can be run in parallel on an opt-in basis.
7777
")
7878
(depends
79-
(ocaml (>= 4.14))
79+
(ocaml (>= 5.1.0))
8080
domain_shims
8181
(cppo (and :build (>= 1.1)))
8282
(ocamlfind (and :dev (>= 1.7.3-1)))

‎lwt.opam‎

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -22,7 +22,7 @@ doc: "https://ocsigen.org/lwt"
2222
bug-reports: "https://github.com/ocsigen/lwt/issues"
2323
depends: [
2424
"dune" {>= "3.15"}
25-
"ocaml" {>= "4.14"}
25+
"ocaml" {>= "5.1.0"}
2626
"domain_shims"
2727
"cppo" {build & >= "1.1"}
2828
"ocamlfind" {dev & >= "1.7.3-1"}

‎src/core/dune‎

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -2,7 +2,7 @@
22
(public_name lwt)
33
(synopsis "Monadic promises and concurrent I/O")
44
(wrapped false)
5-
(libraries domain_shims))
5+
(libraries domain_shims runtime_events))
66

77
(documentation
88
(package lwt))

‎src/core/lwt.ml‎

Lines changed: 2 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -3311,4 +3311,6 @@ module Private = struct
33113311
type nonrec storage = storage
33123312
module Sequence_associated_storage = Sequence_associated_storage
33133313
module Multidomain_sync = Multidomain_sync
3314+
type Runtime_events.User.tag += Paused_count
3315+
let paused_count = Runtime_events.User.register "lwt-paused-count" Paused_count Runtime_events.Type.int
33143316
end

‎src/core/lwt.mli‎

Lines changed: 2 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -2077,4 +2077,6 @@ module Private : sig
20772077
val register_notification : Domain.id -> (unit -> unit) -> unit
20782078
val is_alredy_registered : Domain.id -> bool
20792079
end
2080+
2081+
val paused_count : int Runtime_events.User.t
20802082
end [@@alert trespassing "for internal use only, keep away"]

‎src/unix/dune‎

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -54,7 +54,7 @@
5454
(public_name lwt.unix)
5555
(synopsis "Unix support for Lwt")
5656
(wrapped false)
57-
(libraries bigarray lwt ocplib-endian.bigstring threads unix)
57+
(libraries bigarray lwt ocplib-endian.bigstring threads unix runtime_events)
5858
(install_c_headers lwt_features lwt_config lwt_unix)
5959
(foreign_stubs
6060
(language c)

‎src/unix/lwt_main.ml‎

Lines changed: 10 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -20,6 +20,11 @@ let yield = Lwt.pause
2020
let abandon_yielded_and_paused () =
2121
Lwt.abandon_paused ()
2222

23+
type Runtime_events.User.tag += Scheduler_call
24+
let sch_call = Runtime_events.User.register "lwt-sch-call" Scheduler_call Runtime_events.Type.span
25+
type Runtime_events.User.tag += Scheduler_lap
26+
let sch_lap = Runtime_events.User.register "lwt-sch-lap" Scheduler_lap Runtime_events.Type.unit
27+
2328
let run p =
2429
let domain = Domain.self () in
2530
let () = if (Lwt.Private.Multidomain_sync.is_alredy_registered[@alert "-trespassing"]) domain then
@@ -32,9 +37,14 @@ let run p =
3237
(Lwt.Private.Multidomain_sync.register_notification[@alert "-trespassing"]) domain(fun () -> Lwt_unix.send_notification n)
3338
end
3439
in
40+
Runtime_events.User.write sch_call Begin;
3541
let rec run_loop () =
42+
Runtime_events.User.write sch_lap ();
43+
Runtime_events.User.write Lwt_unix.unix_job_count (Domain.DLS.get Lwt_unix.job_count) ;
44+
Runtime_events.User.write (Lwt.Private.paused_count[@alert "-trespassing"]) (Lwt.paused_count ()) ;
3645
match Lwt.poll p with
3746
| Some x ->
47+
Runtime_events.User.write sch_call End;
3848
x
3949
| None ->
4050
(* Call enter hooks. *)

‎src/unix/lwt_unix.cppo.ml‎

Lines changed: 6 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -12,6 +12,10 @@ module Lwt_sequence = Lwt_sequence
1212

1313
open Lwt.Infix
1414

15+
type Runtime_events.User.tag += Unix_job_count
16+
let unix_job_count = Runtime_events.User.register "lwt-unix-job-count" Unix_job_count Runtime_events.Type.int
17+
let job_count = Domain.DLS.new_key (fun () -> 0)
18+
1519
(* +-----------------------------------------------------------------+
1620
| Configuration |
1721
+-----------------------------------------------------------------+ *)
@@ -207,12 +211,14 @@ let run_job_aux async_method job result =
207211
(waiter >>= fun _ -> Lwt.return_unit),
208212
(fun exn -> if Lwt.state waiter = Lwt.Sleep then Lwt.wakeup_exn wakener exn))
209213
jobs in
214+
Domain.DLS.set job_count (Domain.DLS.get job_count + 1);
210215
ignore begin
211216
(* Create the notification for asynchronous wakeup. *)
212217
let notification =
213218
make_notification ~once:true
214219
(fun () ->
215220
Lwt_sequence.remove node;
221+
Domain.DLS.set job_count (Domain.DLS.get job_count - 1);
216222
let result = result job in
217223
if Lwt.state waiter = Lwt.Sleep then Lwt.wakeup_result wakener result)
218224
in

‎src/unix/lwt_unix.cppo.mli‎

Lines changed: 2 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -2,6 +2,8 @@
22
details, or visit https://github.com/ocsigen/lwt/blob/master/LICENSE.md. *)
33

44

5+
val unix_job_count : int Runtime_events.User.t
6+
val job_count : int Domain.DLS.key
57

68
(** Cooperative system calls *)
79

0 commit comments

Comments
 (0)