diff options
Diffstat (limited to 'libraries')
| -rw-r--r-- | libraries/base/GHC/Conc/Sync.hs | 21 |
1 files changed, 5 insertions, 16 deletions
diff --git a/libraries/base/GHC/Conc/Sync.hs b/libraries/base/GHC/Conc/Sync.hs index 517c20e45f..94601f356d 100644 --- a/libraries/base/GHC/Conc/Sync.hs +++ b/libraries/base/GHC/Conc/Sync.hs @@ -105,6 +105,7 @@ import Data.Maybe import GHC.Base import {-# SOURCE #-} GHC.IO.Handle ( hFlush ) import {-# SOURCE #-} GHC.IO.Handle.FD ( stdout ) +import GHC.Int import GHC.IO import GHC.IO.Encoding.UTF8 import GHC.IO.Exception @@ -194,18 +195,16 @@ instance Ord ThreadId where -- -- @since 4.8.0.0 setAllocationCounter :: Int64 -> IO () -setAllocationCounter i = do - ThreadId t <- myThreadId - rts_setThreadAllocationCounter t i +setAllocationCounter (I64# i) = IO $ \s -> + case setThreadAllocationCounter# i s of s' -> (# s', () #) -- | Return the current value of the allocation counter for the -- current thread. -- -- @since 4.8.0.0 getAllocationCounter :: IO Int64 -getAllocationCounter = do - ThreadId t <- myThreadId - rts_getThreadAllocationCounter t +getAllocationCounter = IO $ \s -> + case getThreadAllocationCounter# s of (# s', ctr #) -> (# s', I64# ctr #) -- | Enables the allocation counter to be treated as a limit for the -- current thread. When the allocation limit is enabled, if the @@ -242,16 +241,6 @@ disableAllocationLimit = do ThreadId t <- myThreadId rts_disableThreadAllocationLimit t --- We cannot do these operations safely on another thread, because on --- a 32-bit machine we cannot do atomic operations on a 64-bit value. --- Therefore, we only expose APIs that allow getting and setting the --- limit of the current thread. -foreign import ccall unsafe "rts_setThreadAllocationCounter" - rts_setThreadAllocationCounter :: ThreadId# -> Int64 -> IO () - -foreign import ccall unsafe "rts_getThreadAllocationCounter" - rts_getThreadAllocationCounter :: ThreadId# -> IO Int64 - foreign import ccall unsafe "rts_enableThreadAllocationLimit" rts_enableThreadAllocationLimit :: ThreadId# -> IO () |