--- a/src/Pure/Concurrent/thread_data.ML Wed Apr 06 16:33:33 2016 +0200
+++ b/src/Pure/Concurrent/thread_data.ML Wed Apr 06 16:51:52 2016 +0200
@@ -1,7 +1,7 @@
(* Title: Pure/Concurrent/thread_data.ML
Author: Makarius
-Thread-local data -- raw version without context management.
+Thread-local data -- physical version without context management.
*)
signature THREAD_DATA =
@@ -11,11 +11,63 @@
val get: 'a var -> 'a option
val put: 'a var -> 'a option -> unit
val setmp: 'a var -> 'a option -> ('b -> 'c) -> 'b -> 'c
+ val is_virtual: bool
end;
structure Thread_Data: THREAD_DATA =
struct
+open Thread;
+
+
+(* exceptions as values *)
+
+structure Exn =
+struct
+
+datatype 'a result =
+ Res of 'a |
+ Exn of exn;
+
+fun capture f x = Res (f x) handle e => Exn e;
+
+fun release (Res y) = y
+ | release (Exn e) = PolyML.Exception.reraise e;
+
+end;
+
+
+(* thread attributes *)
+
+local
+
+val no_interrupts =
+ [Thread.EnableBroadcastInterrupt false, Thread.InterruptState Thread.InterruptDefer];
+
+val safe_interrupts = map
+ (fn Thread.InterruptState Thread.InterruptAsynch =>
+ Thread.InterruptState Thread.InterruptAsynchOnce
+ | x => x);
+
+fun with_attributes new_atts e =
+ let
+ val orig_atts = safe_interrupts (Thread.getAttributes ());
+ val result = Exn.capture (fn () =>
+ (Thread.setAttributes (safe_interrupts new_atts); e orig_atts)) ();
+ val _ = Thread.setAttributes orig_atts;
+ in Exn.release result end;
+
+in
+
+fun uninterruptible f x =
+ with_attributes no_interrupts (fn atts =>
+ f (fn g => fn y => with_attributes atts (fn _ => g y)) x);
+
+end;
+
+
+(* var *)
+
abstype 'a var = Var of 'a option Universal.tag
with
@@ -39,4 +91,6 @@
end;
+val is_virtual = false;
+
end;
--- a/src/Pure/ML/ml_name_space.ML Wed Apr 06 16:33:33 2016 +0200
+++ b/src/Pure/ML/ml_name_space.ML Wed Apr 06 16:51:52 2016 +0200
@@ -63,7 +63,7 @@
val bootstrap_values =
["use", "exit", "ML_system_pretty", "ML_system_pp", "ML_system_overload"];
val bootstrap_structures =
- ["PolyML", "CInterface", "Foreign", "RunCall", "RuntimeCalls", "Signal"];
+ ["PolyML", "CInterface", "Foreign", "RunCall", "RuntimeCalls", "Signal", "Thread_Data"];
(* Standard ML environment *)
--- a/src/Pure/ROOT.ML Wed Apr 06 16:33:33 2016 +0200
+++ b/src/Pure/ROOT.ML Wed Apr 06 16:51:52 2016 +0200
@@ -12,7 +12,6 @@
use "General/exn.ML";
use "Concurrent/multithreading.ML";
-use "Concurrent/thread_data.ML";
use "Concurrent/unsynchronized.ML";
use "ML/ml_heap.ML";
--- a/src/Pure/ROOT0.ML Wed Apr 06 16:33:33 2016 +0200
+++ b/src/Pure/ROOT0.ML Wed Apr 06 16:51:52 2016 +0200
@@ -1,2 +1,3 @@
(*** Isabelle/Pure bootstrap: initial setup ***)
+use "Concurrent/thread_data.ML";