    {-# LINE 1 "libraries/ghc-internal/src/GHC/Internal/Event/EPoll.hsc" #-}
    {-# LANGUAGE BangPatterns               #-}
    {-# LANGUAGE GeneralizedNewtypeDeriving #-}
    {-# LANGUAGE NoImplicitPrelude          #-}
    {-# LANGUAGE Trustworthy                #-}

    -----------------------------------------------------------------------------
    -- |
    -- A binding to the epoll I/O event notification facility
    --
    -- epoll is a variant of poll that can be used either as an edge-triggered or
    -- a level-triggered interface and scales well to large numbers of watched file
    -- descriptors.
    --
    -- epoll decouples monitor an fd from the process of registering it.
    --
    -----------------------------------------------------------------------------

    module GHC.Internal.Event.EPoll
        (
          new
        , available
        ) where

    import qualified GHC.Internal.Event.Internal as E

    {-# LINE 37 "libraries/ghc-internal/src/GHC/Internal/Event/EPoll.hsc" #-}

    import GHC.Internal.Data.Bits (Bits, FiniteBits, (.|.), (.&.))
    import GHC.Internal.Word (Word32)
    import GHC.Internal.Foreign.C.Error (eNOENT, getErrno, throwErrno,
                            throwErrnoIfMinus1, throwErrnoIfMinus1_)
    import GHC.Internal.Foreign.C.Types (CInt(..))
    import GHC.Internal.Foreign.Marshal.Utils (with)
    import GHC.Internal.Foreign.Ptr (Ptr)
    import GHC.Internal.Foreign.Storable (Storable(..))
    import GHC.Internal.Base
    import GHC.Internal.Num (Num(..))
    import GHC.Internal.Real (fromIntegral, div)
    import GHC.Internal.Show (Show)
    import GHC.Internal.System.Posix.Internals (c_close, setCloseOnExec)
    import GHC.Internal.System.Posix.Types (Fd(..))

    import qualified GHC.Internal.Event.Array    as A
    import           GHC.Internal.Event.Internal (Timeout(..))

    available :: Bool
    available :: Bool
    available = Bool
    True
    {-# INLINE available #-}

    data EPoll = EPoll {
          EPoll -> EPollFd
    epollFd     :: {-# UNPACK #-} !EPollFd
        , EPoll -> Array Event
    epollEvents :: {-# UNPACK #-} !(A.Array Event)
        }

    -- | Create a new epoll backend.
    new :: IO E.Backend
    new :: IO Backend
    new = do
      epfd <- IO EPollFd
    epollCreate
      evts <- A.new 64
      let !be = (EPoll -> Maybe Timeout -> (Fd -> Event -> IO ()) -> IO Int)
    -> (EPoll -> Fd -> Event -> Event -> IO Bool)
    -> (EPoll -> Fd -> Event -> IO Bool)
    -> (EPoll -> IO ())
    -> EPoll
    -> Backend
    forall a.
    (a -> Maybe Timeout -> (Fd -> Event -> IO ()) -> IO Int)
    -> (a -> Fd -> Event -> Event -> IO Bool)
    -> (a -> Fd -> Event -> IO Bool)
    -> (a -> IO ())
    -> a
    -> Backend
    E.backend EPoll -> Maybe Timeout -> (Fd -> Event -> IO ()) -> IO Int
    poll EPoll -> Fd -> Event -> Event -> IO Bool
    modifyFd EPoll -> Fd -> Event -> IO Bool
    modifyFdOnce EPoll -> IO ()
    delete (EPollFd -> Array Event -> EPoll
    EPoll EPollFd
    epfd Array Event
    evts)
      return be

    delete :: EPoll -> IO ()
    delete :: EPoll -> IO ()
    delete EPoll
    be = do
      _ <- CInt -> IO CInt
    c_close (CInt -> IO CInt) -> (EPoll -> CInt) -> EPoll -> IO CInt
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . EPollFd -> CInt
    fromEPollFd (EPollFd -> CInt) -> (EPoll -> EPollFd) -> EPoll -> CInt
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . EPoll -> EPollFd
    epollFd (EPoll -> IO CInt) -> EPoll -> IO CInt
    forall a b. (a -> b) -> a -> b
    $ EPoll
    be
      return ()

    -- | Change the set of events we are interested in for a given file
    -- descriptor.
    modifyFd :: EPoll -> Fd -> E.Event -> E.Event -> IO Bool
    modifyFd :: EPoll -> Fd -> Event -> Event -> IO Bool
    modifyFd EPoll
    ep Fd
    fd Event
    oevt Event
    nevt =
      Event -> (Ptr Event -> IO Bool) -> IO Bool
    forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
    with (EventType -> Fd -> Event
    Event (Event -> EventType
    fromEvent Event
    nevt) Fd
    fd) ((Ptr Event -> IO Bool) -> IO Bool)
    -> (Ptr Event -> IO Bool) -> IO Bool
    forall a b. (a -> b) -> a -> b
    $ \Ptr Event
    evptr -> do
        EPollFd -> ControlOp -> Fd -> Ptr Event -> IO ()
    epollControl (EPoll -> EPollFd
    epollFd EPoll
    ep) ControlOp
    op Fd
    fd Ptr Event
    evptr
        Bool -> IO Bool
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Bool
    True
      where op :: ControlOp
    op | Event
    oevt Event -> Event -> Bool
    forall a. Eq a => a -> a -> Bool
    == Event
    forall a. Monoid a => a
    mempty = ControlOp
    controlOpAdd
               | Event
    nevt Event -> Event -> Bool
    forall a. Eq a => a -> a -> Bool
    == Event
    forall a. Monoid a => a
    mempty = ControlOp
    controlOpDelete
               | Bool
    otherwise      = ControlOp
    controlOpModify

    modifyFdOnce :: EPoll -> Fd -> E.Event -> IO Bool
    modifyFdOnce :: EPoll -> Fd -> Event -> IO Bool
    modifyFdOnce EPoll
    ep Fd
    fd Event
    evt =
      do let !ev :: EventType
    ev = Event -> EventType
    fromEvent Event
    evt EventType -> EventType -> EventType
    forall a. Bits a => a -> a -> a
    .|. EventType
    epollOneShot
         res <- Event -> (Ptr Event -> IO CInt) -> IO CInt
    forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
    with (EventType -> Fd -> Event
    Event EventType
    ev Fd
    fd) ((Ptr Event -> IO CInt) -> IO CInt)
    -> (Ptr Event -> IO CInt) -> IO CInt
    forall a b. (a -> b) -> a -> b
    $
                EPollFd -> ControlOp -> Fd -> Ptr Event -> IO CInt
    epollControl_ (EPoll -> EPollFd
    epollFd EPoll
    ep) ControlOp
    controlOpModify Fd
    fd
         if res == 0
           then return True
           else do err <- getErrno
                   if err == eNOENT
                     then with (Event ev fd) $ \Ptr Event
    evptr -> do
                            EPollFd -> ControlOp -> Fd -> Ptr Event -> IO ()
    epollControl (EPoll -> EPollFd
    epollFd EPoll
    ep) ControlOp
    controlOpAdd Fd
    fd Ptr Event
    evptr
                            Bool -> IO Bool
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Bool
    True
                     else throwErrno "modifyFdOnce"

    -- | Select a set of file descriptors which are ready for I/O
    -- operations and call @f@ for all ready file descriptors, passing the
    -- events that are ready.
    poll :: EPoll                     -- ^ state
         -> Maybe Timeout             -- ^ timeout in milliseconds
         -> (Fd -> E.Event -> IO ())  -- ^ I/O callback
         -> IO Int
    poll :: EPoll -> Maybe Timeout -> (Fd -> Event -> IO ()) -> IO Int
    poll EPoll
    ep Maybe Timeout
    mtimeout Fd -> Event -> IO ()
    f = do
      let events :: Array Event
    events = EPoll -> Array Event
    epollEvents EPoll
    ep
          fd :: EPollFd
    fd = EPoll -> EPollFd
    epollFd EPoll
    ep

      -- Will return zero if the system call was interrupted, in which case
      -- we just return (and try again later.)
      n <- Array Event -> (Ptr Event -> Int -> IO Int) -> IO Int
    forall a. Array a -> (Ptr a -> Int -> IO Int) -> IO Int
    A.unsafeLoad Array Event
    events ((Ptr Event -> Int -> IO Int) -> IO Int)
    -> (Ptr Event -> Int -> IO Int) -> IO Int
    forall a b. (a -> b) -> a -> b
    $ \Ptr Event
    es Int
    cap -> case Maybe Timeout
    mtimeout of
        Just Timeout
    timeout -> EPollFd -> Ptr Event -> Int -> Int -> IO Int
    epollWait EPollFd
    fd Ptr Event
    es Int
    cap (Int -> IO Int) -> Int -> IO Int
    forall a b. (a -> b) -> a -> b
    $ Timeout -> Int
    fromTimeout Timeout
    timeout
        Maybe Timeout
    Nothing      -> EPollFd -> Ptr Event -> Int -> IO Int
    epollWaitNonBlock EPollFd
    fd Ptr Event
    es Int
    cap

      when (n > 0) $ do
        A.forM_ events $ \Event
    e -> Fd -> Event -> IO ()
    f (Event -> Fd
    eventFd Event
    e) (EventType -> Event
    toEvent (Event -> EventType
    eventTypes Event
    e))
        cap <- A.capacity events
        when (cap == n) $ A.ensureCapacity events (2 * cap)
      return n

    newtype EPollFd = EPollFd {
          EPollFd -> CInt
    fromEPollFd :: CInt
        } deriving (EPollFd -> EPollFd -> Bool
    (EPollFd -> EPollFd -> Bool)
    -> (EPollFd -> EPollFd -> Bool) -> Eq EPollFd
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: EPollFd -> EPollFd -> Bool
    == :: EPollFd -> EPollFd -> Bool
    $c/= :: EPollFd -> EPollFd -> Bool
    /= :: EPollFd -> EPollFd -> Bool
    Eq, Int -> EPollFd -> ShowS
    [EPollFd] -> ShowS
    EPollFd -> String
    (Int -> EPollFd -> ShowS)
    -> (EPollFd -> String) -> ([EPollFd] -> ShowS) -> Show EPollFd
    forall a.
    (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
    $cshowsPrec :: Int -> EPollFd -> ShowS
    showsPrec :: Int -> EPollFd -> ShowS
    $cshow :: EPollFd -> String
    show :: EPollFd -> String
    $cshowList :: [EPollFd] -> ShowS
    showList :: [EPollFd] -> ShowS
    Show)

    data Event = Event {
          Event -> EventType
    eventTypes :: EventType
        , Event -> Fd
    eventFd    :: Fd
        } deriving (Int -> Event -> ShowS
    [Event] -> ShowS
    Event -> String
    (Int -> Event -> ShowS)
    -> (Event -> String) -> ([Event] -> ShowS) -> Show Event
    forall a.
    (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
    $cshowsPrec :: Int -> Event -> ShowS
    showsPrec :: Int -> Event -> ShowS
    $cshow :: Event -> String
    show :: Event -> String
    $cshowList :: [Event] -> ShowS
    showList :: [Event] -> ShowS
    Show)

    -- | @since base-4.3.1.0
    instance Storable Event where
        sizeOf :: Event -> Int
    sizeOf    Event
    _ = (Int
    12)
    {-# LINE 140 "libraries/ghc-internal/src/GHC/Internal/Event/EPoll.hsc" #-}
        alignment _ = alignment (undefined :: CInt)

        peek :: Ptr Event -> IO Event
    peek Ptr Event
    ptr = do
            ets <- (\Ptr Event
    hsc_ptr -> Ptr Event -> Int -> IO Word32
    forall b. Ptr b -> Int -> IO Word32
    forall a b. Storable a => Ptr b -> Int -> IO a
    peekByteOff Ptr Event
    hsc_ptr Int
    0) Ptr Event
    ptr
    {-# LINE 144 "libraries/ghc-internal/src/GHC/Internal/Event/EPoll.hsc" #-}
            ed  <- (\Ptr Event
    hsc_ptr -> Ptr Event -> Int -> IO Fd
    forall b. Ptr b -> Int -> IO Fd
    forall a b. Storable a => Ptr b -> Int -> IO a
    peekByteOff Ptr Event
    hsc_ptr Int
    4)   ptr
    {-# LINE 145 "libraries/ghc-internal/src/GHC/Internal/Event/EPoll.hsc" #-}
            let !ev = EventType -> Fd -> Event
    Event (Word32 -> EventType
    EventType Word32
    ets) Fd
    ed
            return ev

        poke :: Ptr Event -> Event -> IO ()
    poke Ptr Event
    ptr Event
    e = do
            (\Ptr Event
    hsc_ptr -> Ptr Event -> Int -> Word32 -> IO ()
    forall b. Ptr b -> Int -> Word32 -> IO ()
    forall a b. Storable a => Ptr b -> Int -> a -> IO ()
    pokeByteOff Ptr Event
    hsc_ptr Int
    0) Ptr Event
    ptr (EventType -> Word32
    unEventType (EventType -> Word32) -> EventType -> Word32
    forall a b. (a -> b) -> a -> b
    $ Event -> EventType
    eventTypes Event
    e)
    {-# LINE 150 "libraries/ghc-internal/src/GHC/Internal/Event/EPoll.hsc" #-}
            (\Ptr Event
    hsc_ptr -> Ptr Event -> Int -> Fd -> IO ()
    forall b. Ptr b -> Int -> Fd -> IO ()
    forall a b. Storable a => Ptr b -> Int -> a -> IO ()
    pokeByteOff Ptr Event
    hsc_ptr Int
    4)   Ptr Event
    ptr (Event -> Fd
    eventFd Event
    e)
    {-# LINE 151 "libraries/ghc-internal/src/GHC/Internal/Event/EPoll.hsc" #-}

    newtype ControlOp = ControlOp CInt

    controlOpAdd     :: ControlOp
    controlOpAdd :: ControlOp
    controlOpAdd     = CInt -> ControlOp
    ControlOp CInt
    1
    controlOpModify  :: ControlOp
    controlOpModify :: ControlOp
    controlOpModify  = CInt -> ControlOp
    ControlOp CInt
    3
    controlOpDelete  :: ControlOp
    controlOpDelete :: ControlOp
    controlOpDelete  = CInt -> ControlOp
    ControlOp CInt
    2

    {-# LINE 159 "libraries/ghc-internal/src/GHC/Internal/Event/EPoll.hsc" #-}

    newtype EventType = EventType {
          unEventType :: Word32
        } deriving ( Show       -- ^ @since base-4.4.0.0
                   , Eq         -- ^ @since base-4.4.0.0
                   , Num        -- ^ @since base-4.4.0.0
                   , Bits       -- ^ @since base-4.4.0.0
                   , FiniteBits -- ^ @since base-4.7.0.0
                   )

    epollIn   :: EventType
    epollIn :: EventType
    epollIn   = Word32 -> EventType
    EventType Word32
    1
    epollOut  :: EventType
    epollOut :: EventType
    epollOut  = Word32 -> EventType
    EventType Word32
    4
    epollErr  :: EventType
    epollErr :: EventType
    epollErr  = Word32 -> EventType
    EventType Word32
    8
    epollHup  :: EventType
    epollHup :: EventType
    epollHup  = Word32 -> EventType
    EventType Word32
    16
    epollOneShot  :: EventType
    epollOneShot :: EventType
    epollOneShot  = Word32 -> EventType
    EventType Word32
    1073741824

    {-# LINE 176 "libraries/ghc-internal/src/GHC/Internal/Event/EPoll.hsc" #-}

    -- | Create a new epoll context, returning a file descriptor associated with the context.
    -- The fd may be used for subsequent calls to this epoll context.
    --
    -- The size parameter to epoll_create is a hint about the expected number of handles.
    --
    -- The file descriptor returned from epoll_create() should be destroyed via
    -- a call to close() after polling is finished
    --
    epollCreate :: IO EPollFd
    epollCreate :: IO EPollFd
    epollCreate = do
      fd <- String -> IO CInt -> IO CInt
    forall a. (Eq a, Num a) => String -> IO a -> IO a
    throwErrnoIfMinus1 String
    "epollCreate" (IO CInt -> IO CInt) -> IO CInt -> IO CInt
    forall a b. (a -> b) -> a -> b
    $
            CInt -> IO CInt
    c_epoll_create CInt
    256 -- argument is ignored
      setCloseOnExec fd
      let !epollFd' = CInt -> EPollFd
    EPollFd CInt
    fd
      return epollFd'

    epollControl :: EPollFd -> ControlOp -> Fd -> Ptr Event -> IO ()
    epollControl :: EPollFd -> ControlOp -> Fd -> Ptr Event -> IO ()
    epollControl EPollFd
    epfd ControlOp
    op Fd
    fd Ptr Event
    event =
        String -> IO CInt -> IO ()
    forall a. (Eq a, Num a) => String -> IO a -> IO ()
    throwErrnoIfMinus1_ String
    "epollControl" (IO CInt -> IO ()) -> IO CInt -> IO ()
    forall a b. (a -> b) -> a -> b
    $ EPollFd -> ControlOp -> Fd -> Ptr Event -> IO CInt
    epollControl_ EPollFd
    epfd ControlOp
    op Fd
    fd Ptr Event
    event

    epollControl_ :: EPollFd -> ControlOp -> Fd -> Ptr Event -> IO CInt
    epollControl_ :: EPollFd -> ControlOp -> Fd -> Ptr Event -> IO CInt
    epollControl_ (EPollFd CInt
    epfd) (ControlOp CInt
    op) (Fd CInt
    fd) Ptr Event
    event =
        CInt -> CInt -> CInt -> Ptr Event -> IO CInt
    c_epoll_ctl CInt
    epfd CInt
    op CInt
    fd Ptr Event
    event

    epollWait :: EPollFd -> Ptr Event -> Int -> Int -> IO Int
    epollWait :: EPollFd -> Ptr Event -> Int -> Int -> IO Int
    epollWait (EPollFd CInt
    epfd) Ptr Event
    events Int
    numEvents Int
    timeout =
        (CInt -> Int) -> IO CInt -> IO Int
    forall a b. (a -> b) -> IO a -> IO b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap CInt -> Int
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (IO CInt -> IO Int) -> (IO CInt -> IO CInt) -> IO CInt -> IO Int
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    .
        String -> IO CInt -> IO CInt
    forall a. (Eq a, Num a) => String -> IO a -> IO a
    E.throwErrnoIfMinus1NoRetry String
    "epollWait" (IO CInt -> IO Int) -> IO CInt -> IO Int
    forall a b. (a -> b) -> a -> b
    $
        CInt -> Ptr Event -> CInt -> CInt -> IO CInt
    c_epoll_wait CInt
    epfd Ptr Event
    events (Int -> CInt
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Int
    numEvents) (Int -> CInt
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Int
    timeout)

    epollWaitNonBlock :: EPollFd -> Ptr Event -> Int -> IO Int
    epollWaitNonBlock :: EPollFd -> Ptr Event -> Int -> IO Int
    epollWaitNonBlock (EPollFd CInt
    epfd) Ptr Event
    events Int
    numEvents =
      (CInt -> Int) -> IO CInt -> IO Int
    forall a b. (a -> b) -> IO a -> IO b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap CInt -> Int
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (IO CInt -> IO Int) -> (IO CInt -> IO CInt) -> IO CInt -> IO Int
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    .
      String -> IO CInt -> IO CInt
    forall a. (Eq a, Num a) => String -> IO a -> IO a
    E.throwErrnoIfMinus1NoRetry String
    "epollWaitNonBlock" (IO CInt -> IO Int) -> IO CInt -> IO Int
    forall a b. (a -> b) -> a -> b
    $
      CInt -> Ptr Event -> CInt -> CInt -> IO CInt
    c_epoll_wait_unsafe CInt
    epfd Ptr Event
    events (Int -> CInt
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Int
    numEvents) CInt
    0

    fromEvent :: E.Event -> EventType
    fromEvent :: Event -> EventType
    fromEvent Event
    e = Event -> EventType -> EventType
    forall {p}. Num p => Event -> p -> p
    remap Event
    E.evtRead  EventType
    epollIn EventType -> EventType -> EventType
    forall a. Bits a => a -> a -> a
    .|.
                  Event -> EventType -> EventType
    forall {p}. Num p => Event -> p -> p
    remap Event
    E.evtWrite EventType
    epollOut
      where remap :: Event -> p -> p
    remap Event
    evt p
    to
                | Event
    e Event -> Event -> Bool
    `E.eventIs` Event
    evt = p
    to
                | Bool
    otherwise         = p
    0

    toEvent :: EventType -> E.Event
    toEvent :: EventType -> Event
    toEvent EventType
    e = EventType -> Event -> Event
    forall {p}. Monoid p => EventType -> p -> p
    remap (EventType
    epollIn  EventType -> EventType -> EventType
    forall a. Bits a => a -> a -> a
    .|. EventType
    epollErr EventType -> EventType -> EventType
    forall a. Bits a => a -> a -> a
    .|. EventType
    epollHup) Event
    E.evtRead Event -> Event -> Event
    forall a. Monoid a => a -> a -> a
    `mappend`
                EventType -> Event -> Event
    forall {p}. Monoid p => EventType -> p -> p
    remap (EventType
    epollOut EventType -> EventType -> EventType
    forall a. Bits a => a -> a -> a
    .|. EventType
    epollErr EventType -> EventType -> EventType
    forall a. Bits a => a -> a -> a
    .|. EventType
    epollHup) Event
    E.evtWrite
      where remap :: EventType -> p -> p
    remap EventType
    evt p
    to
                | EventType
    e EventType -> EventType -> EventType
    forall a. Bits a => a -> a -> a
    .&. EventType
    evt EventType -> EventType -> Bool
    forall a. Eq a => a -> a -> Bool
    /= EventType
    0 = p
    to
                | Bool
    otherwise      = p
    forall a. Monoid a => a
    mempty

    fromTimeout :: Timeout -> Int
    fromTimeout :: Timeout -> Int
    fromTimeout Timeout
    Forever     = -Int
    1
    fromTimeout (Timeout Word64
    s) = Word64 -> Int
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Word64 -> Int) -> Word64 -> Int
    forall a b. (a -> b) -> a -> b
    $ Word64
    s Word64 -> Word64 -> Word64
    forall {a}. Integral a => a -> a -> a
    `divRoundUp` Word64
    1000000
      where
        divRoundUp :: a -> a -> a
    divRoundUp a
    num a
    denom = (a
    num a -> a -> a
    forall a. Num a => a -> a -> a
    + a
    denom a -> a -> a
    forall a. Num a => a -> a -> a
    - a
    1) a -> a -> a
    forall {a}. Integral a => a -> a -> a
    `div` a
    denom

    foreign import ccall unsafe "sys/epoll.h epoll_create"
        c_epoll_create :: CInt -> IO CInt

    foreign import ccall unsafe "sys/epoll.h epoll_ctl"
        c_epoll_ctl :: CInt -> CInt -> CInt -> Ptr Event -> IO CInt

    foreign import ccall safe "sys/epoll.h epoll_wait"
        c_epoll_wait :: CInt -> Ptr Event -> CInt -> CInt -> IO CInt

    foreign import ccall unsafe "sys/epoll.h epoll_wait"
        c_epoll_wait_unsafe :: CInt -> Ptr Event -> CInt -> CInt -> IO CInt

    {-# LINE 245 "libraries/ghc-internal/src/GHC/Internal/Event/EPoll.hsc" #-}