renamed mask_interrupt to ignore_interrupt;
authorwenzelm
Thu Feb 28 21:35:07 2002 +0100 (2002-02-28)
changeset 12990c11adf2b1c1e
parent 12989 42ac77552dbf
child 12991 1bfa0670f592
renamed mask_interrupt to ignore_interrupt;
renamed exhibit_interrupt to raise_interrupt;
fixed interrupt handling code (more correct use of continuation);
src/Pure/ML-Systems/smlnj.ML
     1.1 --- a/src/Pure/ML-Systems/smlnj.ML	Thu Feb 28 21:34:33 2002 +0100
     1.2 +++ b/src/Pure/ML-Systems/smlnj.ML	Thu Feb 28 21:35:07 2002 +0100
     1.3 @@ -108,72 +108,36 @@
     1.4  
     1.5  (** interrupts **)
     1.6  
     1.7 +exception Interrupt;
     1.8 +
     1.9  local
    1.10  
    1.11 -datatype 'a result =
    1.12 -  Result of 'a |
    1.13 -  Exn of exn;
    1.14 -
    1.15 -fun capture f x = Result (f x) handle exn => Exn exn;
    1.16 -
    1.17 -fun release (Result x) = x
    1.18 -  | release (Exn exn) = raise exn;
    1.19 -
    1.20 -
    1.21 -val sig_int = Signals.sigINT;
    1.22 -val sig_int_mask = Signals.MASK [Signals.sigINT];
    1.23 +fun capture f x = ((f x): unit; NONE) handle exn => SOME exn;
    1.24  
    1.25 -fun interruptible () =
    1.26 -  (case Signals.masked () of
    1.27 -    Signals.MASKALL => false
    1.28 -  | Signals.MASK sigs => List.all (fn s => s <> sig_int) sigs);
    1.29 -
    1.30 -val mask_signals = Signals.maskSignals;
    1.31 -val unmask_signals = Signals.unmaskSignals;
    1.32 -
    1.33 -fun change_mask ok change unchange f x =
    1.34 -  if ok () then f x
    1.35 -  else
    1.36 -    let
    1.37 -      val _ = change sig_int_mask;
    1.38 -      val result = capture f x;
    1.39 -      val _ = unchange sig_int_mask;
    1.40 -    in release result end;
    1.41 +fun release NONE = ()
    1.42 +  | release (SOME exn) = raise exn;
    1.43  
    1.44  in
    1.45  
    1.46 -
    1.47 -(* mask / unmask interrupt *)
    1.48 -
    1.49 -fun mask_interrupt f = change_mask (not o interruptible) mask_signals unmask_signals f;
    1.50 -fun unmask_interrupt f = change_mask interruptible unmask_signals mask_signals f;
    1.51 -
    1.52 -
    1.53 -(* exhibit interrupt (via exception) *)
    1.54 -
    1.55 -exception Interrupt;
    1.56 -
    1.57 -fun exhibit_interrupt f x =
    1.58 +fun ignore_interrupt f x =
    1.59    let
    1.60 -    val orig_handler = Signals.inqHandler sig_int;
    1.61 -    fun reset_handler () = (Signals.setHandler (sig_int, orig_handler); ());
    1.62 +    val old_handler = Signals.setHandler (Signals.sigINT, Signals.IGNORE);
    1.63 +    val result = capture f x;
    1.64 +    val _ = Signals.setHandler (Signals.sigINT, old_handler);
    1.65 +  in release result end;
    1.66  
    1.67 +fun raise_interrupt f x =
    1.68 +  let
    1.69      val interrupted = ref false;
    1.70 -
    1.71 -    fun set_handler cont =
    1.72 -      Signals.setHandler (sig_int, Signals.HANDLER (fn _ => (interrupted := true; cont)));
    1.73 -
    1.74 -    fun proceed cont =
    1.75 -      let
    1.76 -        val _ = set_handler cont;
    1.77 -        val result = unmask_interrupt (capture f) x;
    1.78 -        val _ = reset_handler ();
    1.79 -      in release result end;
    1.80 +    val result = ref NONE;
    1.81 +    val old_handler = Signals.inqHandler Signals.sigINT;
    1.82    in
    1.83 -    SMLofNJ.Cont.callcc proceed;
    1.84 -    reset_handler ();
    1.85 -    if ! interrupted then raise Interrupt else ()
    1.86 -   end;
    1.87 +    SMLofNJ.Cont.callcc (fn cont =>
    1.88 +      (Signals.setHandler (Signals.sigINT, Signals.HANDLER (fn _ => (interrupted := true; cont)));
    1.89 +      result := capture f x));
    1.90 +    Signals.setHandler (Signals.sigINT, old_handler);
    1.91 +    if ! interrupted then raise Interrupt else release (! result)
    1.92 +  end;
    1.93  
    1.94  end;
    1.95  
    1.96 @@ -198,7 +162,7 @@
    1.97    end;
    1.98  
    1.99  (*plain version; with return code*)
   1.100 -val system = OS.Process.system: string -> int; 
   1.101 +val system = OS.Process.system: string -> int;
   1.102  
   1.103  
   1.104  (* file handling *)