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