Task_Queue.update_timing: more precise treatment of interruptibility;
authorwenzelm
Fri, 04 Feb 2011 16:33:12 +0100
changeset 41702 dca4c58c5d57
parent 41701 430493d65cd2
child 41703 d27950860514
Task_Queue.update_timing: more precise treatment of interruptibility; Task_Queue.waiting: potentially expensive wait dependencies are subject to trace flag;
src/Pure/Concurrent/task_queue.ML
--- a/src/Pure/Concurrent/task_queue.ML	Fri Feb 04 16:29:47 2011 +0100
+++ b/src/Pure/Concurrent/task_queue.ML	Fri Feb 04 16:33:12 2011 +0100
@@ -120,12 +120,13 @@
 fun timing_of_task (Task {timing, ...}) = Synchronized.value timing;
 
 fun update_timing update (Task {timing, ...}) e =
-  let
-    val start = Time.now ();
-    val result = Exn.capture e ();
-    val t = Time.- (Time.now (), start);
-    val _ = Synchronized.change timing (update t);
-  in Exn.release result end;
+  uninterruptible (fn restore_attributes => fn () =>
+    let
+      val start = Time.now ();
+      val result = Exn.capture (restore_attributes e) ();
+      val t = Time.- (Time.now (), start);
+      val _ = Synchronized.change timing (update t);
+    in Exn.release result end) ();
 
 fun task_ord (Task {id = id1, pri = pri1, ...}, Task {id = id2, pri = pri2, ...}) =
   prod_ord (rev_order o option_ord int_ord) int_ord ((pri1, id1), (pri2, id2));
@@ -147,7 +148,9 @@
 
 fun waiting task deps =
   update_timing (fn t => fn (a, b, ds) =>
-    (Time.- (a, t), Time.+ (b, t), fold (insert (op =) o name_of_task) deps ds)) task;
+    (Time.- (a, t), Time.+ (b, t),
+      if ! Multithreading.trace > 0
+      then fold (insert (op =) o name_of_task) deps ds else ds)) task;