1(*  Title:      Pure/Concurrent/multithreading.ML
2    Author:     Makarius
3
4Multithreading in Poly/ML (cf. polyml/basis/Thread.sml).
5*)
6
7signature MULTITHREADING =
8sig
9  val max_threads: unit -> int
10  val max_threads_update: int -> unit
11  val parallel_proofs: int ref
12  val sync_wait: Time.time option -> ConditionVar.conditionVar -> Mutex.mutex -> bool Exn.result
13  val trace: int ref
14  val tracing: int -> (unit -> string) -> unit
15  val tracing_time: bool -> Time.time -> (unit -> string) -> unit
16  val synchronized: string -> Mutex.mutex -> (unit -> 'a) -> 'a
17end;
18
19structure Multithreading: MULTITHREADING =
20struct
21
22(* max_threads *)
23
24local
25
26fun num_processors () =
27  (case Thread.numPhysicalProcessors () of
28    SOME n => n
29  | NONE => Thread.numProcessors ());
30
31fun max_threads_result m =
32  if Thread_Data.is_virtual then 1
33  else if m > 0 then m
34  else Int.min (Int.max (num_processors (), 1), 8);
35
36val max_threads_state = ref 1;
37
38in
39
40fun max_threads () = ! max_threads_state;
41fun max_threads_update m = max_threads_state := max_threads_result m;
42
43end;
44
45
46(* parallel_proofs *)
47
48val parallel_proofs = ref 1;
49
50
51(* synchronous wait *)
52
53fun sync_wait time cond lock =
54  Thread_Attributes.with_attributes
55    (Thread_Attributes.sync_interrupts (Thread_Attributes.get_attributes ()))
56    (fn _ =>
57      (case time of
58        SOME t => Exn.Res (ConditionVar.waitUntil (cond, lock, t))
59      | NONE => (ConditionVar.wait (cond, lock); Exn.Res true))
60      handle exn => Exn.Exn exn);
61
62
63(* tracing *)
64
65val trace = ref 0;
66
67fun tracing level msg =
68  if ! trace < level then ()
69  else Thread_Attributes.uninterruptible (fn _ => fn () =>
70    (TextIO.output (TextIO.stdErr, (">>> " ^ msg () ^ "\n")); TextIO.flushOut TextIO.stdErr)
71      handle _ (*sic*) => ()) ();
72
73fun tracing_time detailed time =
74  tracing
75   (if not detailed then 5
76    else if time >= seconds 1.0 then 1
77    else if time >= seconds 0.1 then 2
78    else if time >= seconds 0.01 then 3
79    else if time >= seconds 0.001 then 4 else 5);
80
81
82(* synchronized evaluation *)
83
84fun synchronized name lock e =
85  Exn.release (Thread_Attributes.uninterruptible (fn restore_attributes => fn () =>
86    if ! trace > 0 then
87      let
88        val immediate =
89          if Mutex.trylock lock then true
90          else
91            let
92              val _ = tracing 5 (fn () => name ^ ": locking ...");
93              val timer = Timer.startRealTimer ();
94              val _ = Mutex.lock lock;
95              val time = Timer.checkRealTimer timer;
96              val _ = tracing_time true time (fn () => name ^ ": locked after " ^ Time.toString time);
97            in false end;
98        val result = Exn.capture (restore_attributes e) ();
99        val _ = if immediate then () else tracing 5 (fn () => name ^ ": unlocking ...");
100        val _ = Mutex.unlock lock;
101      in result end
102    else
103      let
104        val _ = Mutex.lock lock;
105        val result = Exn.capture (restore_attributes e) ();
106        val _ = Mutex.unlock lock;
107      in result end) ());
108
109end;
110