Skip to content

Instantly share code, notes, and snippets.

@WJWH
Created August 16, 2020 18:25
  • Star 0 You must be signed in to star a gist
  • Fork 0 You must be signed in to fork a gist
Star You must be signed in to star a gist
Save WJWH/ff35f140c23f1023f3fe7a66d16978cd to your computer and use it in GitHub Desktop.
-- To benchmark, make sure to expose the GHC.Event.* in /libraries/base/base.cabal,
-- otherwise GHC will complain that they are hidden modules.
import GHC.Event.Manager hiding (closeFd)
import GHC.Event.Internal
import GHC.Event.IoUring as IoUring
import GHC.Event.EPoll as Epoll
import Control.Monad
import Data.Time
import System.Posix.IO
repetitions = 500000
main = do
uring <- IoUring.new
epoll <- Epoll.new
putStrLn "Register and unregister a single fd when no others are present"
(readFd, writeFd) <- createPipe
start <- getCurrentTime
replicateM_ repetitions $ modifyFdOnce uring readFd evtRead >> modifyFd uring readFd evtRead mempty
end <- getCurrentTime
print $ "uring: " ++ (show $ diffUTCTime end start)
start <- getCurrentTime
replicateM_ repetitions $ modifyFdOnce epoll readFd evtRead >> modifyFd epoll readFd evtRead mempty
end <- getCurrentTime
print $ "epoll: " ++ (show $ diffUTCTime end start)
closeFd readFd
closeFd writeFd
putStrLn "Poll when no fds are monitored"
start <- getCurrentTime
replicateM_ repetitions $ poll uring Nothing (\_ _ -> return ())
end <- getCurrentTime
print $ "uring: " ++ (show $ diffUTCTime end start)
start <- getCurrentTime
replicateM_ repetitions $ poll epoll Nothing (\_ _ -> return ())
end <- getCurrentTime
print $ "epoll: " ++ (show $ diffUTCTime end start)
putStrLn "Monitor 512 fds with no events on them"
fds <- replicateM 512 createPipe
let readFds = map fst fds
let writeFds = map snd fds
forM_ readFds $ \readFd -> modifyFdOnce uring readFd evtRead
forM_ readFds $ \readFd -> modifyFdOnce epoll readFd evtRead
start <- getCurrentTime
replicateM_ repetitions $ poll uring Nothing (\_ _ -> return ())
end <- getCurrentTime
print $ "uring: " ++ (show $ diffUTCTime end start)
start <- getCurrentTime
replicateM_ repetitions $ poll epoll Nothing (\_ _ -> return ())
end <- getCurrentTime
print $ "epoll: " ++ (show $ diffUTCTime end start)
putStrLn "Register and unregister a single fd with 512 poll requests already outstanding"
(readFd, writeFd) <- createPipe
start <- getCurrentTime
replicateM_ repetitions $ modifyFdOnce uring readFd evtRead >> modifyFd uring readFd evtRead mempty
end <- getCurrentTime
print $ "uring: " ++ (show $ diffUTCTime end start)
start <- getCurrentTime
replicateM_ repetitions $ modifyFdOnce epoll readFd evtRead >> modifyFd epoll readFd evtRead mempty
end <- getCurrentTime
print $ "epoll: " ++ (show $ diffUTCTime end start)
closeFd readFd
closeFd writeFd
putStrLn "Register a fd that will trigger immediately and poll for it, waiting until it is ready, with 512 poll requests already outstanding"
(readFd, writeFd) <- createPipe
fdWrite writeFd "foo"
start <- getCurrentTime
replicateM_ repetitions $ modifyFdOnce uring readFd evtRead >> poll uring (Just Forever) (\_ _ -> return ())
end <- getCurrentTime
print $ "uring: " ++ (show $ diffUTCTime end start)
start <- getCurrentTime
replicateM_ repetitions $ modifyFdOnce epoll readFd evtRead >> poll epoll (Just Forever) (\_ _ -> return ())
end <- getCurrentTime
print $ "epoll: " ++ (show $ diffUTCTime end start)
closeFd readFd
closeFd writeFd
-- cause all fds to be readable and run all callbacks
forM_ writeFds $ \writeFd -> fdWrite writeFd "foo"
poll uring Nothing (\_ _ -> return ())
poll epoll Nothing (\_ _ -> return ())
putStrLn "Register and unregister a single fd after cleaning up all events"
(readFd, writeFd) <- createPipe
start <- getCurrentTime
replicateM_ repetitions $ modifyFdOnce uring readFd evtRead >> modifyFd uring readFd evtRead mempty
end <- getCurrentTime
print $ "uring: " ++ (show $ diffUTCTime end start)
start <- getCurrentTime
replicateM_ repetitions $ modifyFdOnce epoll readFd evtRead >> modifyFd epoll readFd evtRead mempty
end <- getCurrentTime
print $ "epoll: " ++ (show $ diffUTCTime end start)
closeFd readFd
closeFd writeFd
putStrLn "Register a fd that will trigger immediately and poll for it, waiting until it is ready"
(readFd, writeFd) <- createPipe
fdWrite writeFd "foo"
start <- getCurrentTime
replicateM_ repetitions $ modifyFdOnce uring readFd evtRead >> poll uring (Just Forever) (\_ _ -> return ())
end <- getCurrentTime
print $ "uring: " ++ (show $ diffUTCTime end start)
start <- getCurrentTime
replicateM_ repetitions $ modifyFdOnce epoll readFd evtRead >> poll epoll (Just Forever) (\_ _ -> return ())
end <- getCurrentTime
print $ "epoll: " ++ (show $ diffUTCTime end start)
closeFd readFd
closeFd writeFd
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment