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