src/Pure/Concurrent/simple_thread.ML
author wenzelm
Tue, 10 Nov 2009 23:15:15 +0100
changeset 33602 d25e6bd6ca95
parent 33220 11a1af478dac
child 33605 f91ec14e20b6
permissions -rw-r--r--
exported SimpleThread.attributes;
wenzelm@28241
     1
(*  Title:      Pure/Concurrent/simple_thread.ML
wenzelm@28241
     2
    Author:     Makarius
wenzelm@28241
     3
wenzelm@28577
     4
Simplified thread operations.
wenzelm@28241
     5
*)
wenzelm@28241
     6
wenzelm@28241
     7
signature SIMPLE_THREAD =
wenzelm@28241
     8
sig
wenzelm@33602
     9
  val attributes: bool -> Thread.threadAttribute list
wenzelm@28241
    10
  val fork: bool -> (unit -> unit) -> Thread.thread
wenzelm@28550
    11
  val interrupt: Thread.thread -> unit
wenzelm@28577
    12
  val synchronized: string -> Mutex.mutex -> (unit -> 'a) -> 'a
wenzelm@28241
    13
end;
wenzelm@28241
    14
wenzelm@28241
    15
structure SimpleThread: SIMPLE_THREAD =
wenzelm@28241
    16
struct
wenzelm@28241
    17
wenzelm@33602
    18
fun attributes interrupts =
wenzelm@33602
    19
  if interrupts then Multithreading.public_interrupts else Multithreading.no_interrupts;
wenzelm@33602
    20
wenzelm@28241
    21
fun fork interrupts body =
wenzelm@33220
    22
  Thread.fork (fn () => exception_trace (fn () => body () handle Exn.Interrupt => ()),
wenzelm@33602
    23
    attributes interrupts);
wenzelm@28241
    24
wenzelm@28550
    25
fun interrupt thread = Thread.interrupt thread handle Thread _ => ();
wenzelm@28550
    26
wenzelm@28577
    27
wenzelm@28577
    28
(* basic synchronization *)
wenzelm@28577
    29
wenzelm@28577
    30
fun synchronized name lock e = Exn.release (uninterruptible (fn restore_attributes => fn () =>
wenzelm@28577
    31
  let
wenzelm@32051
    32
    val immediate =
wenzelm@32051
    33
      if Mutex.trylock lock then true
wenzelm@28577
    34
      else
wenzelm@32184
    35
        let
wenzelm@32184
    36
          val _ = Multithreading.tracing 5 (fn () => name ^ ": locking ...");
wenzelm@32185
    37
          val time = Multithreading.real_time Mutex.lock lock;
wenzelm@32186
    38
          val _ = Multithreading.tracing_time true time
wenzelm@32185
    39
            (fn () => name ^ ": locked after " ^ Time.toString time);
wenzelm@32184
    40
        in false end;
wenzelm@28577
    41
    val result = Exn.capture (restore_attributes e) ();
wenzelm@32051
    42
    val _ =
wenzelm@32184
    43
      if immediate then () else Multithreading.tracing 5 (fn () => name ^ ": unlocking ...");
wenzelm@28577
    44
    val _ = Mutex.unlock lock;
wenzelm@28577
    45
  in result end) ());
wenzelm@28577
    46
wenzelm@28241
    47
end;