Hello haskell, Main reason of slowness of existing Handle-based I/O in GHC is locking around each operation. it is especially bad for simple char-at-a-time I/O where 99% of time spent on locking and unlocking. To be exact, on my CPU, hPutChar for 100mb file requires 150 seconds, while hGetChar for the same file is "only" 100 seconds long. it seems that former use 3 locking operations and later 2 ones, because my own vGetChar/vPutChar implementations both requires 52 seconds, of those only about one second is real work and rest is just `withMVar` expenses. Until now, i thought that this 0.5 ms (about 1000 primitive CPU operations) on each withMVar is pure time required to perform takeMVar+putMVar operations. But yesterday i investigated this problem deeper and results was amazing! First, i just made local copy of `withMVar` and added INLINE to it: import Control.Exception as Exception {-# INLINE inlinedWithMVar #-} inlinedWithMVar :: MVar a -> (a -> IO b) -> IO b inlinedWithMVar m io = block $ do a <- takeMVar m b <- Exception.catch (unblock (io a)) (\e -> do putMVar m a; throw e) putMVar m a return b Second, i've developed my own simplified version of this procedure. Here i should say that my library uses "MVar ()" field to hold lock and separate immutable data field with actual data locked: data WithLocking h = WithLocking h !(MVar ()) This allowed me to omit block/unblock operation and develop the following faster analog of withMVar: lock (WithLocking h mvar) action = do Exception.catch (do takeMVar mvar result <- action h putMVar mvar () return res ) (\e -> do tryPutMVar mvar (); throw e) And as third variant i tried exception-unsafe variant of `withMVar`: unsafeWithMVar :: MVar a -> (a -> IO b) -> IO b unsafeWithMVar m io = do a <- takeMVar m b <- io a putMVar m a return b And now are results: withMVar 52 seconds inlinedWithMVar 38 seconds lock 20 seconds unsafeWithMVar 10 seconds So, 1) `withMVar` can be made significantly faster just by attaching INLINE pragma to it. until GHC includes this patch, you can just make local copy of this procedure (it's implementation is compiler-independent) and use INLINE pragma for this local copy 2) if MVar is used only to protect some immutable data from simultaneous access, it's use can be made significantly faster by using above-mentioned WithLocking type constructor together with 'lock' function. I hope that this mechanism will go into future Haskell implementations and in particular it will be used in my own Streams library and in new DiffArray implementation (that is a part of ArrayRef library) 3) For simple programs that don't catch exceptions anyway, this excessive protection is just meaningless. they can use 'unsafeWithMVar' to work as fast as possible. i mean in particular shootout-like benchmarks. it is also possible to develop fast & safe routines by using explicit unlocking (with 'tryPutMVar') in higher-level exception handlers and a more general conclusion. this case is a good demonstration of significant performance loss due to using of higher-order functions. i think that more aggressive inlining of high-order and polymorphic functions should significantly speed up GHC-compiled programs. -- Best regards, Bulat mailto:Bulat.Ziganshin@gmail.com
On Tue, May 02, 2006 at 12:15:20PM +0400, Bulat Ziganshin wrote:
Second, i've developed my own simplified version of this procedure. Here i should say that my library uses "MVar ()" field to hold lock and separate immutable data field with actual data locked:
data WithLocking h = WithLocking h !(MVar ())
This reminds me, I wonder if we should have an MVar varient that is _just_ for locking, it would have no separate take and put primitives, just a withLock, enforcing the restriction that the thread that took the lock is the same one that will return it. this would allow standard priority inversion reduction techniques to be used and could signifigantly mitigate the problem of accidentally performing a long pure evaluation while holding a lock. when another thread comes along that needs a lock, it will give its CPU time to the thread holding it so it can finish up its long computation. with MVars, you never know whether an MVar is being used for simple locking or as an inter-thread communication mechanism. John -- John Meacham - ⑆repetae.net⑆john⑈
Hello John, Wednesday, May 3, 2006, 2:37:03 AM, you wrote:
This reminds me, I wonder if we should have an MVar varient that is _just_ for locking, it would have no separate take and put primitives, just a withLock, enforcing the restriction that the thread that took the lock is the same one that will return it.
to be exact, i has the following definitions, which uses class to define 'lock' operation and therefore allow alternative implementations in future without need to change application code that uses this operation:
data WithLocking h = WithLocking h !(MVar ())
-- | Add lock to object to ensure its proper use in concurrent threads addLocking h = do mvar <- newMVar () return (WithLocking h mvar)
-- | Run `action` with locked version of object `h` withLocking :: h -> (WithLocking h -> IO a) -> IO a withLocking h action = do addLocking h >>= action
-- | Define class of locking implementations, where 'lh' holds lock around 'h' class Locking lh h | lh->h where -- | Perform `action` while exclusively locking wrapped object lock :: lh -> (h->IO a) -> IO a
instance Locking (WithLocking h) h where {-# INLINE lock #-} lock (WithLocking h mvar) action = do -- Faster analog of withMVar Exception.catch (do takeMVar mvar result <- action h putMVar mvar () return res ) (\e -> do tryPutMVar mvar (); throw e)
liftLock1 action h = lock h (\a -> action a) liftLock2 action h x = lock h (\a -> action a x) liftLock3 action h x y = lock h (\a -> action a x y) liftLock4 action h x y z = lock h (\a -> action a x y z) liftLock5 action h x y z t = lock h (\a -> action a x y z t) {-# INLINE liftLock1 #-} {-# INLINE liftLock2 #-}
instance (Show h) => Show (WithLocking h) where show (WithLocking h _) = "WithLocking ("++ show h ++")"
and then any type class can be made client of this library, f.e.:
type WithLocking2 a e m = WithLocking (a e m)
instance (MArray a e m) => (MArray (WithLocking2 a) e m) where newArray lu e = newArray lu e >>= addLocking newArray_ lu = newArray_ lu >>= addLocking unsafeReadArray = liftLock2 unsafeReadArray unsafeWriteArray = liftLock3 unsafeWriteArray
main = do arr <- newArray (0,9) 0 >>= addLocking readArray arr 0 >>= writeArray arr 1 .....
-- Best regards, Bulat mailto:Bulat.Ziganshin@gmail.com
participants (2)
-
Bulat Ziganshin -
John Meacham