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