Ticket #8089: base.patch

File base.patch, 2.6 KB (added by merijn, 2 years 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