summaryrefslogtreecommitdiff
path: root/libraries/base/GHC/Weak/Finalize.hs
blob: d16277248b01be196e403b081368d81da75748a7 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE UnboxedTuples #-}
{-# LANGUAGE MagicHash #-}
{-# LANGUAGE Unsafe #-}

module GHC.Weak.Finalize
    ( -- * Handling exceptions
      -- | When an exception is thrown by a finalizer called by the
      -- garbage collector, GHC calls a global handler which can be set with
      -- 'setFinalizerExceptionHandler'. Note that any exceptions thrown by
      -- this handler will be ignored.
      setFinalizerExceptionHandler
    , getFinalizerExceptionHandler
      -- * Internal
    , runFinalizerBatch
    ) where

import GHC.Base
import GHC.Exception
import GHC.IORef
import GHC.IO (catchException, unsafePerformIO)

-- | Run a batch of finalizers from the garbage collector.  We're given
-- an array of finalizers and the length of the array, and we just
-- call each one in turn.
runFinalizerBatch :: Int
                  -> Array# (State# RealWorld -> State# RealWorld)
                  -> IO ()
runFinalizerBatch (I# n) arr =
    go n
  where
    getFinalizer :: Int# -> IO ()
    getFinalizer i =
        case indexArray# arr i of
          (# io #) -> IO $ \s ->
              case io s of
                s' -> (# s', () #)

    go :: Int# -> IO ()
    go 0# = return ()
    go i = do
        let i' = i -# 1#
        let finalizer = getFinalizer i'
        finalizer `catchException` handleExc
        go i'

    handleExc :: SomeException -> IO ()
    handleExc se = do
        handleFinalizerExc <- getFinalizerExceptionHandler
        handleFinalizerExc se `catchException` (\(SomeException _) -> return ())

-- See Note [Handling exceptions during Handle finalization] for the
-- motivation for this mechanism.
finalizerExceptionHandler :: IORef (SomeException -> IO ())
finalizerExceptionHandler = unsafePerformIO $ newIORef (const $ return ())
{-# NOINLINE finalizerExceptionHandler #-}

-- | Get the global action called to report exceptions thrown by weak pointer
-- finalizers to the user.
--
-- @since 4.18.0.0
getFinalizerExceptionHandler :: IO (SomeException -> IO ())
getFinalizerExceptionHandler = readIORef finalizerExceptionHandler

-- | Set the global action called to report exceptions thrown by weak pointer
-- finalizers to the user.
--
-- @since 4.18.0.0
setFinalizerExceptionHandler :: (SomeException -> IO ()) -> IO ()
setFinalizerExceptionHandler = writeIORef finalizerExceptionHandler