1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
|
(* Copyright (C) 2014, Thomas Leonard *)
type id = int
let id_chunk_size = 1024
let next_id_chunk = Atomic.make 0
let next_id_key =
Domain.DLS.new_key (fun () -> Atomic.fetch_and_add next_id_chunk id_chunk_size)
let mint_id () =
let next_id_local = Domain.DLS.get next_id_key in
let next_id_local_succ =
if ((next_id_local + 1) mod id_chunk_size) = 0 then
(* we're out of local IDs *)
Atomic.fetch_and_add next_id_chunk id_chunk_size
else
next_id_local + 1
in
Domain.DLS.set next_id_key next_id_local_succ;
next_id_local
module RE = Eio_runtime_events
let add_event = Runtime_events.User.write
let create_obj ?label id ty =
add_event RE.create_obj (id, ty);
Option.iter (fun l -> add_event RE.name (id, l)) label
let create_cc id ty =
add_event RE.create_cc (id, ty)
let create_fiber ~cc id =
add_event RE.create_fiber (id, cc)
let log = add_event RE.log
let name id x = add_event RE.name (id, x)
let enter_span = add_event RE.enter_span
let exit_span = add_event RE.exit_span
let fiber = add_event RE.fiber
let suspend_domain = add_event RE.suspend_domain
let try_get = add_event RE.try_get
let get = add_event RE.get
let put = add_event RE.put
let exit_fiber = add_event RE.exit_fiber
let exit_cc = add_event RE.exit_cc
let error id ex = add_event RE.error (id, ex)
let suspend_fiber op = add_event RE.suspend_fiber op
let domain_spawn ~parent = add_event RE.domain_spawn parent
let with_span op fn =
enter_span op;
match fn () with
| r -> exit_span (); r
| exception ex ->
let bt = Printexc.get_raw_backtrace () in
exit_span ();
Printexc.raise_with_backtrace ex bt
|
