diff options
| author | Ben Gamari <ben@smart-cactus.org> | 2022-07-16 16:49:48 -0400 |
|---|---|---|
| committer | Ben Gamari <ben@smart-cactus.org> | 2022-08-06 11:55:14 -0400 |
| commit | 43f2b271c12943ed7d5d5d5e387d41ed404eb7a8 (patch) | |
| tree | d829306682b2e938fda9033bdfc233012b30dd43 /libraries | |
| parent | 1472044ba587b575372102bbb0c8cc4d85df74db (diff) | |
| download | haskell-43f2b271c12943ed7d5d5d5e387d41ed404eb7a8.tar.gz | |
base: Share finalization thread label
For efficiency's sake we float the thread label assigned to the
finalization thread to the top-level, ensuring that we only need to
encode the label once.
Diffstat (limited to 'libraries')
| -rw-r--r-- | libraries/base/GHC/Conc/Sync.hs-boot | 4 | ||||
| -rw-r--r-- | libraries/base/GHC/Weak/Finalize.hs | 12 |
2 files changed, 12 insertions, 4 deletions
diff --git a/libraries/base/GHC/Conc/Sync.hs-boot b/libraries/base/GHC/Conc/Sync.hs-boot index 16c734ef9f..dbb2eda5ad 100644 --- a/libraries/base/GHC/Conc/Sync.hs-boot +++ b/libraries/base/GHC/Conc/Sync.hs-boot @@ -24,7 +24,7 @@ module GHC.Conc.Sync ThreadStatus(..), threadStatus, sharedCAF, - labelThread + labelThreadByteArray# ) where import GHC.Base @@ -69,4 +69,4 @@ myThreadId :: IO ThreadId showThreadId :: ThreadId -> String threadStatus :: ThreadId -> IO ThreadStatus sharedCAF :: a -> (Ptr a -> IO (Ptr a)) -> IO a -labelThread :: ThreadId -> String -> IO () +labelThreadByteArray# :: ThreadId -> ByteArray# -> IO () diff --git a/libraries/base/GHC/Weak/Finalize.hs b/libraries/base/GHC/Weak/Finalize.hs index 8503f9ddb7..9a0aec9db6 100644 --- a/libraries/base/GHC/Weak/Finalize.hs +++ b/libraries/base/GHC/Weak/Finalize.hs @@ -18,8 +18,16 @@ module GHC.Weak.Finalize import GHC.Base import GHC.Exception import GHC.IORef -import {-# SOURCE #-} GHC.Conc (labelThread, myThreadId) +import {-# SOURCE #-} GHC.Conc.Sync (labelThreadByteArray#, myThreadId) import GHC.IO (catchException, unsafePerformIO) +import GHC.Encoding.UTF8 (utf8EncodeByteArray#) + +data ByteArray = ByteArray ByteArray# + +-- | The label we use for finalization threads. We manually float this to the +-- top-level to ensure that the ByteArray# can be shared. +label :: ByteArray +label = ByteArray (utf8EncodeByteArray# "weak finalizer thread") -- | 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 @@ -29,7 +37,7 @@ runFinalizerBatch :: Int -> IO () runFinalizerBatch (I# n) arr = do tid <- myThreadId - labelThread tid "weak finalizer thread" + case label of ByteArray ba# -> labelThreadByteArray# tid ba# go n where getFinalizer :: Int# -> IO () |