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