Ticket #8089: base.patch

File base.patch, 2.6 KB (added by merijn, 9 months ago)
  • GHC/Event/Poll.hsc

    diff --git a/GHC/Event/Poll.hsc b/GHC/Event/Poll.hsc
    index fc4b011..b085908 100644
    a b import Foreign.Ptr (Ptr) 
    3737import Foreign.Storable (Storable(..)) 
    3838import GHC.Base 
    3939import GHC.Conc.Sync (withMVar) 
     40import GHC.Enum (maxBound) 
    4041import GHC.Num (Num(..)) 
    4142import GHC.Real (ceiling, fromIntegral) 
    4243import GHC.Show (Show) 
    poll p mtout f = do 
    9293    E.throwErrnoIfMinus1NoRetry "c_poll" $ 
    9394    case mtout of 
    9495      Just tout -> 
    95         c_poll ptr (fromIntegral len) (fromIntegral (fromTimeout tout)) 
     96        c_pollLoop ptr (fromIntegral len) (fromTimeout tout) 
    9697      Nothing   -> 
    9798        c_poll_unsafe ptr (fromIntegral len) 0 
    9899  unless (n == 0) $ do 
    poll p mtout f = do 
    104105                return (i', i' == n) 
    105106        else return (i, True) 
    106107  return (fromIntegral n) 
     108  where 
     109    -- The poll timeout is specified as an Int, but c_poll takes a CInt. These 
     110    -- can't be safely coerced as on many systems (e.g. x86_64) CInt has a a 
     111    -- maxBound of (2^32 - 1), even though Int may have a significantly higher 
     112    -- bound. 
     113    -- 
     114    -- This function deals with timeouts greater than maxBound :: CInt, by 
     115    -- looping until c_poll returns a non-zero value (0 indicates timeout 
     116    -- expired) OR the full timeout has passed. 
     117    c_pollLoop :: Ptr PollFd -> (#type nfds_t) -> Int -> IO CInt 
     118    c_pollLoop ptr len tout 
     119        | tout <= maxPollTimeout = c_poll ptr len (fromIntegral tout) 
     120        | otherwise = do 
     121            result <- c_poll ptr len (fromIntegral maxPollTimeout) 
     122            if result == 0 
     123               then c_pollLoop ptr len (tout - maxPollTimeout) 
     124               else return result 
     125 
     126    -- We need to account for 3 cases: 
     127    --     1. Int and CInt are of equal size. 
     128    --     2. Int is larger than CInt 
     129    --     3. Int is smaller than CInt 
     130    -- 
     131    -- In case 1, the value of maxPollTimeout will be the maxBound of Int. 
     132    -- 
     133    -- In case 2, the value of maxPollTimeout will be the maxBound of CInt, 
     134    -- which is the largest value accepted by c_poll. This will result in 
     135    -- c_pollLoop recursing if the provided timeout is larger. 
     136    -- 
     137    -- In case 3, "fromIntegral (maxBound :: CInt) :: Int" wil result in a 
     138    -- negative Int, max will thus return maxBound :: Int. Since poll doesn't 
     139    -- accept values bigger than maxBound :: Int and CInt is larger than Int, 
     140    -- there is no problem converting Int to CInt for the c_poll call. 
     141    maxPollTimeout :: Int 
     142    maxPollTimeout = max maxBound (fromIntegral (maxBound :: CInt)) 
    107143 
    108144fromTimeout :: E.Timeout -> Int 
    109145fromTimeout E.Forever     = -1