added sync_interrupts, regular_interrupts;
authorwenzelm
Sun, 07 Sep 2008 22:20:15 +0200
changeset 281617718587e510e
parent 28160 e0177b67ecd9
child 28162 55772e4e95e0
added sync_interrupts, regular_interrupts;
max_thread_value: enforce >= 1;
src/Pure/ML-Systems/multithreading_polyml.ML
     1.1 --- a/src/Pure/ML-Systems/multithreading_polyml.ML	Sun Sep 07 22:20:11 2008 +0200
     1.2 +++ b/src/Pure/ML-Systems/multithreading_polyml.ML	Sun Sep 07 22:20:15 2008 +0200
     1.3 @@ -43,7 +43,7 @@
     1.4  
     1.5  fun max_threads_value () =
     1.6    let val m = ! max_threads
     1.7 -  in if m <= 0 then Thread.numProcessors () else m end;
     1.8 +  in if m <= 0 then Int.max (Thread.numProcessors (), 1) else m end;
     1.9  
    1.10  
    1.11  (* misc utils *)
    1.12 @@ -62,6 +62,15 @@
    1.13  
    1.14  (* thread attributes *)
    1.15  
    1.16 +val no_interrupts =
    1.17 +  [Thread.EnableBroadcastInterrupt false, Thread.InterruptState Thread.InterruptDefer];
    1.18 +
    1.19 +val sync_interrupts =
    1.20 +  [Thread.EnableBroadcastInterrupt false, Thread.InterruptState Thread.InterruptSynch];
    1.21 +
    1.22 +val regular_interrupts =
    1.23 +  [Thread.EnableBroadcastInterrupt true, Thread.InterruptState Thread.InterruptAsynchOnce];
    1.24 +
    1.25  fun with_attributes new_atts f x =
    1.26    let
    1.27      val orig_atts = Thread.getAttributes ();
    1.28 @@ -77,13 +86,7 @@
    1.29        handle Interrupt => (restore (); Exn.Exn Interrupt))
    1.30    end;
    1.31  
    1.32 -fun interruptible f =
    1.33 -  with_attributes
    1.34 -    [Thread.EnableBroadcastInterrupt true, Thread.InterruptState Thread.InterruptAsynchOnce]
    1.35 -    (fn _ => f);
    1.36 -
    1.37 -val no_interrupts =
    1.38 -  [Thread.EnableBroadcastInterrupt false, Thread.InterruptState Thread.InterruptDefer];
    1.39 +fun interruptible f = with_attributes regular_interrupts (fn _ => f);
    1.40  
    1.41  fun uninterruptible f =
    1.42    with_attributes no_interrupts (fn atts => f (fn g => with_attributes atts (fn _ => g)));