clarified bootstrap;
authorwenzelm
Wed, 06 Apr 2016 16:51:52 +0200
changeset 62890 728aa05e9433
parent 62889 99c7f31615c2
child 62891 7a11ea5c9626
clarified bootstrap;
src/Pure/Concurrent/thread_data.ML
src/Pure/ML/ml_name_space.ML
src/Pure/ROOT.ML
src/Pure/ROOT0.ML
--- 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";