| 1 | (* critical.sml |
| 2 | * 2004 Matthew Fluet (mfluet@acm.org) |
| 3 | * Ported to MLton threads. |
| 4 | *) |
| 5 | |
| 6 | structure Critical : CRITICAL = |
| 7 | struct |
| 8 | structure Thread = MLton.Thread |
| 9 | structure AtomicState = MLton.Thread.AtomicState |
| 10 | structure Signal = MLton.Signal |
| 11 | structure Itimer = MLton.Itimer |
| 12 | |
| 13 | val atomicBegin = Thread.atomicBegin |
| 14 | val atomicEnd = Thread.atomicEnd |
| 15 | local datatype z = datatype Thread.AtomicState.t |
| 16 | in |
| 17 | fun atomicMsg () = |
| 18 | case Thread.atomicState () of |
| 19 | AtomicState.NonAtomic => "[NonAtomic]" |
| 20 | | AtomicState.Atomic n => concat ["[ Atomic ", Int.toString n, "]"] |
| 21 | end |
| 22 | fun doAtomic (f: unit -> unit) = (atomicBegin (); f (); atomicEnd ()) |
| 23 | |
| 24 | val mask = Signal.Mask.some [Itimer.signal Itimer.Real] |
| 25 | fun maskBegin () = Signal.Mask.block mask |
| 26 | fun maskEnd () = Signal.Mask.unblock mask |
| 27 | fun doMasked (f: unit -> unit) = (maskBegin (); f (); maskEnd ()) |
| 28 | end |