Source file riot.ml

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
include Runtime
include Lib

let shutdown () =
  Logger.debug (fun f -> f "RIOT IS SHUTTING DOWN!");
  let pool = _get_pool () in
  Scheduler.Pool.shutdown pool

let run ?(rnd = Random.State.make_self_init ()) ?workers main =
  let max_workers = Int.max 0 (Stdlib.Domain.recommended_domain_count () - 2) in
  let workers =
    match workers with Some w -> Int.min w max_workers | None -> max_workers
  in

  Log.debug (fun f -> f "Initializing Riot runtime...");
  Printexc.record_backtrace true;
  Pid.reset ();
  Scheduler.Uid.reset ();

  let sch0 = Scheduler.make ~rnd () in
  let pool, domains = Scheduler.Pool.make ~main:sch0 ~domains:workers () in

  Scheduler.set_current_scheduler sch0;
  Scheduler.Pool.set_pool pool;

  let _pid = _spawn ~shutdown:true pool sch0 main in
  Scheduler.run pool sch0 ();

  Log.debug (fun f -> f "Riot runtime shutting down...");
  List.iter Stdlib.Domain.join domains;
  Log.debug (fun f -> f "Riot runtime shutdown")

let start ?rnd ?workers ~apps () =
  run ?rnd ?workers @@ fun () ->
  let pids =
    List.fold_left
      (fun acc (module App : Application.Intf) ->
        match (acc, App.start ()) with
        | Ok acc, Ok pid -> Ok (pid :: acc)
        | Ok _, Error error ->
            Logger.error (fun f ->
                f "Could not start application %s due to %s" App.name
                  (Marshal.to_string error []));
            Error ()
        | Error (), _ -> acc)
      (Ok []) apps
    |> Result.get_ok
  in
  wait_pids pids