@@ -59,12 +59,7 @@ import GHC.Weak (Weak (..))
59import System.Mem.Weak (deRefWeak)
59import System.Mem.Weak (deRefWeak)
60import Data.Typeable (Typeable)
60import Data.Typeable (Typeable)
61import Control.Reaper
61import Control.Reaper
62−#if USE_ATOMIC_PRIMOPS
63import qualified Data.Atomics.Counter.Unboxed as C
62import qualified Data.Atomics.Counter.Unboxed as C
64−import Data.Atomics.Counter.Unboxed (casCounter)
66−import Network.Wai.Handler.Warp.IORef
69----------------------------------------------------------------
64----------------------------------------------------------------
@@ -75,12 +70,7 @@ type Manager = Reaper [Handle] Handle
75type TimeoutAction = IO ()
70type TimeoutAction = IO ()
77-- | A handle used by 'Manager'
72-- | A handle used by 'Manager'
78−data Handle = Handle TimeoutAction
73+data Handle = Handle TimeoutAction {-# UNPACK #-} !C.AtomicCounter
79−#if USE_ATOMIC_PRIMOPS
80− {-# UNPACK #-} !C.AtomicCounter
82− {-# UNPACK #-} !(IORef Int)
85-- Four states for the AtomicCounter:
75-- Four states for the AtomicCounter:
@@ -101,7 +91,7 @@ initialize timeout = mkReaper defaultReaperSettings
102 prune m@(Handle onTimeout iactive) = do
92 prune m@(Handle onTimeout iactive) = do
103 -- Try to change from active to inactive
93 -- Try to change from active to inactive
104− (wasActive, newState) <- casCounter iactive 1 2
94+ (wasActive, newState) <- C.casCounter iactive 1 2
105 case newState of
95 case newState of
106 2 | not wasActive -> do -- inactive
96 2 | not wasActive -> do -- inactive
107 onTimeout `E.catch` ignoreAll
97 onTimeout `E.catch` ignoreAll
@@ -109,14 +99,6 @@ initialize timeout = mkReaper defaultReaperSettings
109 4 -> return Nothing -- canceled
99 4 -> return Nothing -- canceled
110 _ -> return $ Just m
100 _ -> return $ Just m
112−#if !USE_ATOMIC_PRIMOPS
113−casCounter :: IORef Int -> Int -> Int -> IO (Bool, Int)
114−casCounter ref old new = atomicModifyIORef' ref $ \curr ->
116− then (new, (True, new))
117− else (old, (False, old))
120----------------------------------------------------------------
102----------------------------------------------------------------
122-- | Stopping timeout manager.
104-- | Stopping timeout manager.
@@ -133,11 +115,7 @@ ignoreAll _ = return ()
133-- | Registering a timeout action.
115-- | Registering a timeout action.
134register :: Manager -> TimeoutAction -> IO Handle
116register :: Manager -> TimeoutAction -> IO Handle
135register mgr onTimeout = do
117register mgr onTimeout = do
136−#if USE_ATOMIC_PRIMOPS
137 iactive <- C.newCounter 1
118 iactive <- C.newCounter 1
139− iactive <- newIORef 1
141 let h = Handle onTimeout iactive
119 let h = Handle onTimeout iactive
142 reaperAdd mgr h
120 reaperAdd mgr h
@@ -171,28 +149,20 @@ mkWeakThreadId t@(ThreadId t#) = IO $ \s ->
172----------------------------------------------------------------
150----------------------------------------------------------------
174−writeCounter :: Int -> Handle -> IO ()
175−#if USE_ATOMIC_PRIMOPS
176−writeCounter i (Handle _ iactive) = C.writeCounter iactive i
178−writeCounter i (Handle _ iactive) = writeIORef iactive i
180−{-# INLINE writeCounter #-}
182-- | Setting the state to active.
152-- | Setting the state to active.
183-- 'Manager' turns active to inactive repeatedly.
153-- 'Manager' turns active to inactive repeatedly.
184tickle :: Handle -> IO ()
154tickle :: Handle -> IO ()
185−tickle = writeCounter 1
155+tickle (Handle _ iactive) = C.writeCounter iactive 1
187-- | Setting the state to canceled.
157-- | Setting the state to canceled.
188-- 'Manager' eventually removes this without timeout action.
158-- 'Manager' eventually removes this without timeout action.
189cancel :: Handle -> IO ()
159cancel :: Handle -> IO ()
190−cancel = writeCounter 4
160+cancel (Handle _ iactive) = C.writeCounter iactive 4
192-- | Setting the state to paused.
162-- | Setting the state to paused.
193-- 'Manager' does not change the value.
163-- 'Manager' does not change the value.
194pause :: Handle -> IO ()
164pause :: Handle -> IO ()
195−pause = writeCounter 3
165+pause (Handle _ iactive) = C.writeCounter iactive 3
197-- | Setting the paused state to active.
167-- | Setting the paused state to active.
198-- This is an alias to 'tickle'.
168-- This is an alias to 'tickle'.