Skip to content

Instantly share code, notes, and snippets.

@WJWH

WJWH/event_benchmark.hs

Created August 16, 2020 18:25
Show Gist options

  • Select an option

    Learn more about clone URLs
  • Save WJWH/ff35f140c23f1023f3fe7a66d16978cd to your computer and use it in GitHub Desktop.

Select an option

Learn more about clone URLs
Save WJWH/ff35f140c23f1023f3fe7a66d16978cd to your computer and use it in GitHub Desktop.
Download ZIP

Revisions

  1. WJWH created this gist Aug 16, 2020.
    126 changes: 126 additions & 0 deletions event_benchmark.hs
    View file
    Original file line number Diff line number Diff line change
    @@ -0,0 +1,126 @@
    -- 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