{-# OPTIONS_GHC -optc-D_GNU_SOURCE #-}
{-# LINE 1 "src/Linux/Epoll/Types.hsc" #-}
{-# language BangPatterns #-}
{-# language BinaryLiterals #-}
{-# language DataKinds #-}
{-# language DerivingStrategies #-}
{-# language DuplicateRecordFields #-}
{-# language GADTSyntax #-}
{-# language GeneralizedNewtypeDeriving #-}
{-# language KindSignatures #-}
{-# language MagicHash #-}
{-# language NamedFieldPuns #-}
{-# language PolyKinds #-}
{-# language ScopedTypeVariables #-}
{-# language TypeApplications #-}
{-# language TypeInType #-}
{-# language UnboxedTuples #-}
{-# OPTIONS_GHC -fno-warn-unticked-promoted-constructors #-}
module Linux.Epoll.Types
( EpollFlags(..)
, ControlOperation(..)
, Exchange(..)
, Events(..)
, Event(..)
, PrimEpollData(..)
, closeOnExec
, add
, modify
, delete
, input
, output
, priority
, hangup
, readHangup
, error
, edgeTriggered
, containsAnyEvents
, containsAllEvents
, sizeofEvent
, peekEventEvents
, peekEventDataFd
, peekEventDataPtr
, peekEventDataU32
, peekEventDataU64
, pokeEventDataU64
) where
import Prelude hiding (truncate,error)
import Data.Bits (Bits,(.&.),(.|.),unsafeShiftL,unsafeShiftR)
import Data.Kind (Type)
import Data.Primitive.Addr (Addr(..))
import Data.Primitive (Prim)
import Data.Primitive (indexByteArray#,writeByteArray#,readByteArray#)
import Data.Primitive (indexOffAddr#,readOffAddr#,writeOffAddr#)
import Data.Word (Word32,Word64)
import Foreign.C.Types (CInt(..))
import Foreign.Storable (Storable,peekByteOff,pokeByteOff)
import GHC.Exts (Int(I#),(+#),(*#))
import GHC.Exts (State#,Int#,Addr#,MutableByteArray#,ByteArray#)
import GHC.Ptr (Ptr(..))
import Posix.Poll (Exchange(..))
import System.Posix.Types (Fd(..))
import qualified Data.Primitive as PM
newtype ControlOperation = ControlOperation CInt
deriving stock (Eq)
newtype EpollFlags = EpollFlags CInt
deriving stock (Eq)
deriving newtype (Bits)
instance Semigroup EpollFlags where (<>) = (.|.)
instance Monoid EpollFlags where mempty = EpollFlags 0
newtype Events :: Exchange -> Type where
Events :: Word32 -> Events e
deriving stock (Eq)
deriving newtype (Bits,Storable,Prim)
instance Semigroup (Events e) where (<>) = (.|.)
instance Monoid (Events e) where mempty = Events 0
data Event :: Exchange -> Type -> Type where
Event ::
{ events :: !(Events e)
, payload :: !a
} -> Event e a
class PrimEpollData a where
indexByteArrayEpoll :: ByteArray# -> Int# -> Event e a
readByteArrayEpoll :: MutableByteArray# s -> Int# -> State# s -> (# State# s, Event e a #)
writeByteArrayEpoll :: MutableByteArray# s -> Int# -> Event e a -> State# s -> State# s
indexOffAddrEpoll :: Addr# -> Int# -> Event e a
readOffAddrEpoll :: Addr# -> Int# -> State# s -> (# State# s, Event e a #)
writeOffAddrEpoll :: Addr# -> Int# -> Event e a -> State# s -> State# s
instance PrimEpollData a => Prim (Event e a) where
{-# inline sizeOf# #-}
{-# inline alignment# #-}
{-# inline indexByteArray# #-}
{-# inline readByteArray# #-}
{-# inline writeByteArray# #-}
{-# inline setByteArray# #-}
{-# inline indexOffAddr# #-}
{-# inline readOffAddr# #-}
{-# inline writeOffAddr# #-}
{-# inline setOffAddr# #-}
sizeOf# _ = unI (12)
{-# LINE 149 "src/Linux/Epoll/Types.hsc" #-}
alignment# _ = PM.alignment# (undefined :: Word32)
indexByteArray# = indexByteArrayEpoll
readByteArray# = readByteArrayEpoll
writeByteArray# = writeByteArrayEpoll
setByteArray# = PM.defaultSetByteArray#
indexOffAddr# = indexOffAddrEpoll
readOffAddr# = readOffAddrEpoll
writeOffAddr# = writeOffAddrEpoll
setOffAddr# = PM.defaultSetOffAddr#
instance PrimEpollData Fd where
{-# inline indexByteArrayEpoll #-}
{-# inline readByteArrayEpoll #-}
{-# inline writeByteArrayEpoll #-}
{-# inline indexOffAddrEpoll #-}
{-# inline readOffAddrEpoll #-}
{-# inline writeOffAddrEpoll #-}
indexByteArrayEpoll arr i = Event
{ events = (\hsc_arr hsc_ix -> indexByteArray# hsc_arr (0# +# (hsc_ix *# 3#))) arr i
{-# LINE 168 "src/Linux/Epoll/Types.hsc" #-}
, payload = (\hsc_arr hsc_ix -> indexByteArray# hsc_arr (1# +# (hsc_ix *# 3#))) arr i
{-# LINE 169 "src/Linux/Epoll/Types.hsc" #-}
}
writeByteArrayEpoll arr i Event{events,payload} s0 =
case (\hsc_arr hsc_ix -> writeByteArray# hsc_arr (0# +# (hsc_ix *# 3#))) arr i events s0 of
{-# LINE 172 "src/Linux/Epoll/Types.hsc" #-}
s1 -> (\hsc_arr hsc_ix -> writeByteArray# hsc_arr (1# +# (hsc_ix *# 3#))) arr i payload s1
{-# LINE 173 "src/Linux/Epoll/Types.hsc" #-}
readByteArrayEpoll arr i s0 =
case (\hsc_arr hsc_ix -> readByteArray# hsc_arr (0# +# (hsc_ix *# 3#))) arr i s0 of
{-# LINE 175 "src/Linux/Epoll/Types.hsc" #-}
(# s1, events #) -> case (\hsc_arr hsc_ix -> readByteArray# hsc_arr (1# +# (hsc_ix *# 3#))) arr i s1 of
{-# LINE 176 "src/Linux/Epoll/Types.hsc" #-}
(# s2, payload #) -> (# s2, Event{events,payload} #)
indexOffAddrEpoll arr i = Event
{ events = (\hsc_arr hsc_ix -> indexOffAddr# hsc_arr (0# +# (hsc_ix *# 3#))) arr i
{-# LINE 179 "src/Linux/Epoll/Types.hsc" #-}
, payload = (\hsc_arr hsc_ix -> indexOffAddr# hsc_arr (1# +# (hsc_ix *# 3#))) arr i
{-# LINE 180 "src/Linux/Epoll/Types.hsc" #-}
}
writeOffAddrEpoll arr i Event{events,payload} s0 =
case (\hsc_arr hsc_ix -> writeOffAddr# hsc_arr (0# +# (hsc_ix *# 3#))) arr i events s0 of
{-# LINE 183 "src/Linux/Epoll/Types.hsc" #-}
s1 -> (\hsc_arr hsc_ix -> writeOffAddr# hsc_arr (1# +# (hsc_ix *# 3#))) arr i payload s1
{-# LINE 184 "src/Linux/Epoll/Types.hsc" #-}
readOffAddrEpoll arr i s0 =
case (\hsc_arr hsc_ix -> readOffAddr# hsc_arr (0# +# (hsc_ix *# 3#))) arr i s0 of
{-# LINE 186 "src/Linux/Epoll/Types.hsc" #-}
(# s1, events #) -> case (\hsc_arr hsc_ix -> readOffAddr# hsc_arr (1# +# (hsc_ix *# 3#))) arr i s1 of
{-# LINE 187 "src/Linux/Epoll/Types.hsc" #-}
(# s2, payload #) -> (# s2, Event{events,payload} #)
instance PrimEpollData Word64 where
{-# inline indexByteArrayEpoll #-}
{-# inline readByteArrayEpoll #-}
{-# inline writeByteArrayEpoll #-}
{-# inline indexOffAddrEpoll #-}
{-# inline readOffAddrEpoll #-}
{-# inline writeOffAddrEpoll #-}
indexByteArrayEpoll arr i = Event
{ events = PM.indexByteArray# arr (i *# 3#)
, payload = composePayload
(PM.indexByteArray# arr ((i *# 3#) +# 1#))
(PM.indexByteArray# arr ((i *# 3#) +# 2#))
}
writeByteArrayEpoll arr i Event{events,payload} s0 = case PM.writeByteArray# arr (i *# 3#) events s0 of
s1 -> case PM.writeByteArray# arr ((i *# 3#) +# 1#) pa s1 of
s2 -> PM.writeByteArray# arr ((i *# 3#) +# 2#) pb s2
where
!(pa,pb) = decomposePayload payload
readByteArrayEpoll arr i s0 = case PM.readByteArray# arr (i *# 3#) s0 of
(# s1, events #) -> case PM.readByteArray# arr ((i *# 3#) +# 1#) s1 of
(# s2, pa #) -> case PM.readByteArray# arr ((i *# 3#) +# 2#) s2 of
(# s3, pb #) -> let payload = composePayload pa pb in
(# s3, Event{events,payload} #)
indexOffAddrEpoll arr i = Event
{ events = PM.indexOffAddr# arr (i *# 3#)
, payload = composePayload
(PM.indexOffAddr# arr ((i *# 3#) +# 1#))
(PM.indexOffAddr# arr ((i *# 3#) +# 2#))
}
writeOffAddrEpoll arr i Event{events,payload} s0 = case PM.writeOffAddr# arr (i *# 3#) events s0 of
s1 -> case PM.writeOffAddr# arr ((i *# 3#) +# 1#) pa s1 of
s2 -> PM.writeOffAddr# arr ((i *# 3#) +# 2#) pb s2
where
!(pa,pb) = decomposePayload payload
readOffAddrEpoll arr i s0 = case PM.readOffAddr# arr (i *# 3#) s0 of
(# s1, events #) -> case PM.readOffAddr# arr ((i *# 3#) +# 1#) s1 of
(# s2, pa #) -> case PM.readOffAddr# arr ((i *# 3#) +# 2#) s2 of
(# s3, pb #) -> let payload = composePayload pa pb in
(# s3, Event{events,payload} #)
add :: ControlOperation
add = ControlOperation 1
{-# LINE 236 "src/Linux/Epoll/Types.hsc" #-}
modify :: ControlOperation
modify = ControlOperation 3
{-# LINE 240 "src/Linux/Epoll/Types.hsc" #-}
delete :: ControlOperation
delete = ControlOperation 2
{-# LINE 244 "src/Linux/Epoll/Types.hsc" #-}
closeOnExec :: EpollFlags
closeOnExec = EpollFlags 524288
{-# LINE 248 "src/Linux/Epoll/Types.hsc" #-}
input :: Events e
input = Events 1
{-# LINE 252 "src/Linux/Epoll/Types.hsc" #-}
output :: Events e
output = Events 4
{-# LINE 256 "src/Linux/Epoll/Types.hsc" #-}
priority :: Events e
priority = Events 2
{-# LINE 260 "src/Linux/Epoll/Types.hsc" #-}
error :: Events Response
error = Events 8
{-# LINE 267 "src/Linux/Epoll/Types.hsc" #-}
hangup :: Events Response
hangup = Events 16
{-# LINE 274 "src/Linux/Epoll/Types.hsc" #-}
readHangup :: Events e
readHangup = Events 8192
{-# LINE 278 "src/Linux/Epoll/Types.hsc" #-}
edgeTriggered :: Events Request
edgeTriggered = Events 2147483648
{-# LINE 282 "src/Linux/Epoll/Types.hsc" #-}
containsAllEvents :: Events e -> Events e -> Bool
containsAllEvents (Events a) (Events b) = a .&. b == b
containsAnyEvents :: Events e -> Events e -> Bool
containsAnyEvents (Events a) (Events b) = (a .&. b) /= 0
sizeofEvent :: Int
sizeofEvent = (12)
{-# LINE 294 "src/Linux/Epoll/Types.hsc" #-}
peekEventEvents :: Addr -> IO (Events e)
peekEventEvents (Addr p) = (\hsc_ptr -> peekByteOff hsc_ptr 0) (Ptr p)
{-# LINE 298 "src/Linux/Epoll/Types.hsc" #-}
peekEventDataFd :: Addr -> IO Fd
peekEventDataFd (Addr p) = (\hsc_ptr -> peekByteOff hsc_ptr 4) (Ptr p)
{-# LINE 302 "src/Linux/Epoll/Types.hsc" #-}
peekEventDataPtr :: Addr -> IO Addr
peekEventDataPtr (Addr p) = do
Ptr q <- (\hsc_ptr -> peekByteOff hsc_ptr 4) (Ptr p)
{-# LINE 307 "src/Linux/Epoll/Types.hsc" #-}
pure (Addr q)
peekEventDataU32 :: Addr -> IO Word32
peekEventDataU32 (Addr p) = (\hsc_ptr -> peekByteOff hsc_ptr 4) (Ptr p)
{-# LINE 312 "src/Linux/Epoll/Types.hsc" #-}
peekEventDataU64 :: Addr -> IO Word64
peekEventDataU64 (Addr p) = (\hsc_ptr -> peekByteOff hsc_ptr 4) (Ptr p)
{-# LINE 316 "src/Linux/Epoll/Types.hsc" #-}
pokeEventDataU64 :: Addr -> Word64 -> IO ()
pokeEventDataU64 (Addr p) w = (\hsc_ptr -> pokeByteOff hsc_ptr 4) (Ptr p) w
{-# LINE 320 "src/Linux/Epoll/Types.hsc" #-}
composePayload :: Word32 -> Word32 -> Word64
{-# inline composePayload #-}
composePayload a b = unsafeShiftL (word32ToWord64 a) 32 .|. word32ToWord64 b
decomposePayload :: Word64 -> (Word32,Word32)
{-# inline decomposePayload #-}
decomposePayload w = (word64ToWord32 (unsafeShiftR w 32), word64ToWord32 w)
word32ToWord64 :: Word32 -> Word64
word32ToWord64 = fromIntegral
word64ToWord32 :: Word64 -> Word32
word64ToWord32 = fromIntegral
unI :: Int -> Int#
unI (I# i) = i