Permalink
Browse files

Reverted the previous select back-end commit

  • Loading branch information...
1 parent cdb5d14 commit 532cc1a8d1f54298307f4d50d9c4becdc62621a5 Johan Tibell committed Jun 3, 2010
Showing with 3 additions and 206 deletions.
  1. +2 −8 configure.ac
  2. +0 −1 event.cabal
  3. +0 −28 include/HsEvent.h
  4. +1 −1 src/System/Event/Clock.hsc
  5. +0 −166 src/System/Event/Select.hsc
  6. +0 −2 tests/Manager.hs
View
@@ -14,11 +14,9 @@ AC_ARG_WITH([cc],
[CC=$withval])
AC_PROG_CC()
-AC_CHECK_HEADERS([poll.h signal.h sys/epoll.h sys/event.h sys/eventfd.h \
- sys/select.h sys/time.h sys/types.h unistd.h])
+AC_CHECK_HEADERS([poll.h signal.h sys/epoll.h sys/event.h sys/eventfd.h])
-AC_CHECK_FUNCS([epoll_create1 epoll_ctl eventfd kevent kevent64 kqueue poll \
- select])
+AC_CHECK_FUNCS([epoll_create1 epoll_ctl eventfd kevent kevent64 kqueue poll])
if test "$ac_cv_header_sys_epoll_h" = yes -a "$ac_cv_func_epoll_ctl" = yes; then
AC_DEFINE([HAVE_EPOLL], [1], [Define if you have epoll support.])
@@ -32,8 +30,4 @@ if test "$ac_cv_header_poll_h" = yes -a "$ac_cv_func_poll" = yes; then
AC_DEFINE([HAVE_POLL], [1], [Define if you have poll support.])
fi
-if test "$ac_cv_func_select" = yes; then
- AC_DEFINE([HAVE_SELECT], [1], [Define if you have select support.])
-fi
-
AC_OUTPUT
View
@@ -37,7 +37,6 @@ library
System.Event.Manager
System.Event.PSQ
System.Event.Poll
- System.Event.Select
System.Event.Signal
System.Event.Unique
View
@@ -6,19 +6,6 @@
#include <signal.h>
#include <pthread.h>
-#if defined(HAVE_SYS_SELECT_H)
-#include <sys/select.h>
-#endif
-#if defined(HAVE_SYS_TIME_H)
-#include <sys/time.h>
-#endif
-#if defined(HAVE_SYS_TYPES_H)
-#include <sys/types.h>
-#endif
-#if defined(HAVE_UNISTD_H)
-#include <unistd.h>
-#endif
-
#if !defined(INLINE)
# if defined(_MSC_VER)
# define INLINE extern __inline
@@ -46,21 +33,6 @@ INLINE int __hsevent_kill_thread(pthread_t *tid, int sig)
return pthread_kill(*tid, sig);
}
-INLINE int __hsevent_fd_isset(int fd, fd_set *fds)
-{
- return FD_ISSET(fd, fds);
-}
-
-INLINE void __hsevent_fd_set(int fd, fd_set *fds)
-{
- FD_SET(fd, fds);
-}
-
-INLINE void __hsevent_fd_zero(fd_set *fds)
-{
- FD_ZERO(fds);
-}
-
#endif /* __HS_EVENT_H__ */
/*
* Local Variables:
@@ -1,6 +1,6 @@
{-# LANGUAGE ForeignFunctionInterface #-}
-module System.Event.Clock (CTimeval(..), getCurrentTime) where
+module System.Event.Clock (getCurrentTime) where
#include <sys/time.h>
View
@@ -1,166 +0,0 @@
-{-# LANGUAGE EmptyDataDecls, ForeignFunctionInterface #-}
-
-module System.Event.Select
- (
- new
- , available
- ) where
-
-#include "EventConfig.h"
-
-import Prelude hiding (exp)
-import qualified System.Event.Internal as E
-
-#if !defined(HAVE_SELECT)
-new :: IO E.Backend
-new = error "Select back end not implemented for this platform"
-
-available :: Bool
-available = False
-{-# INLINE available #-}
-#else
-
-#if defined(HAVE_SYS_SELECT_H)
-#include <sys/select.h>
-#endif
-#if defined(HAVE_SYS_TIME_H)
-#include <sys/time.h>
-#endif
-#if defined(HAVE_SYS_TYPES_H)
-#include <sys/types.h>
-#endif
-#if defined(HAVE_UNISTD_H)
-#include <unistd.h>
-#endif
-
-import Control.Monad (when)
-import Data.IORef (IORef, atomicModifyIORef, newIORef, readIORef, writeIORef)
-import Foreign.C.Types (CInt)
-import Foreign.ForeignPtr (ForeignPtr, mallocForeignPtrBytes, withForeignPtr)
-import Foreign.Marshal.Utils (with)
-import Foreign.Ptr (Ptr, nullPtr)
-import System.Event.Clock (CTimeval(..))
-import System.Posix.Types (Fd(..))
-
-------------------------------------------------------------------------
--- Exported interface
-
-new :: IO E.Backend
-new = do
- rdfds <- mallocForeignPtrBytes (#size fd_set)
- wrfds <- mallocForeignPtrBytes (#size fd_set)
- new' <- newIORef []
- pending' <- newIORef []
- return $ E.backend select modifyFd (const $ return ())
- (Select rdfds wrfds new' pending')
-
-available :: Bool
-available = True
-{-# INLINE available #-}
-
-select :: Select -> E.Timeout -> (Fd -> E.Event -> IO ()) -> IO ()
-select be to f = do
- -- Pick up new I/O requests.
- new' <- atomicModifyIORef (newReqs be) $ \xs -> ([], xs)
- old' <- readIORef (pendingReqs be)
- let reqs = new' ++ old'
-
- -- Build fd_sets for select().
- reqs' <- withForeignPtr (readfds be) $ \rdp ->
- withForeignPtr (writefds be) $ \wrp ->
- withTimeout to $ \top -> do
- fdZero rdp
- fdZero wrp
- maxfd <- buildFdSets 0 rdp wrp reqs
- n <- E.throwErrnoIfMinus1NoRetry "c_select" $
- c_select (maxfd + 1) rdp wrp nullPtr top
-
- if n == 0 then return reqs
- else completeRequests f reqs rdp wrp []
-
- writeIORef (pendingReqs be) reqs'
-
-withTimeout :: E.Timeout -> (Ptr CTimeval -> IO a) -> IO a
-withTimeout E.Forever f = f nullPtr
-withTimeout (E.Timeout t) f =
- let !tval = CTimeval (floor t) (floor $ t * 1000000.0)
- in with tval f
-
-buildFdSets :: Fd -> Ptr CFdSet -> Ptr CFdSet -> [IOReq] -> IO Fd
-buildFdSets maxfd _ _ [] = return maxfd
-buildFdSets maxfd rdfds wrfds (Read fd : reqs)
- | fd >= (#const FD_SETSIZE) =
- error "buildFdSets: file descriptor out of range"
- | otherwise = do
- fdSet fd rdfds
- buildFdSets (max maxfd fd) rdfds wrfds reqs
-buildFdSets maxfd rdfds wrfds (Write fd : reqs)
- | fd >= (#const FD_SETSIZE) =
- error "buildFdSets: file descriptor out of range"
- | otherwise = do
- fdSet fd wrfds
- buildFdSets (max maxfd fd) rdfds wrfds reqs
-
-completeRequests :: (Fd -> E.Event -> IO ()) -> [IOReq] -> Ptr CFdSet
- -> Ptr CFdSet -> [IOReq] -> IO [IOReq]
-completeRequests _ [] _ _ reqs' = return reqs'
-completeRequests f (Read fd : reqs) rdfds wrfds reqs' = do
- b <- fdIsSet fd rdfds
- if b
- then f fd E.evtRead >> completeRequests f reqs rdfds wrfds reqs'
- else completeRequests f reqs rdfds wrfds (Read fd : reqs')
-completeRequests f (Write fd : reqs) rdfds wrfds reqs' = do
- b <- fdIsSet fd wrfds
- if b
- then f fd E.evtWrite >> completeRequests f reqs rdfds wrfds reqs'
- else completeRequests f reqs rdfds wrfds (Write fd : reqs')
-
-modifyFd :: Select -> Fd -> E.Event -> E.Event -> IO ()
-modifyFd be fd _oevt nevt = do
- when (nevt `E.eventIs` E.evtRead) $ atomicModifyIORef (newReqs be) $ \xs ->
- ((Read fd : xs), ())
- when (nevt `E.eventIs` E.evtWrite) $ atomicModifyIORef (newReqs be) $ \xs ->
- ((Write fd : xs), ())
-
-------------------------------------------------------------------------
--- FFI binding
-
-data IOReq = Read {-# UNPACK #-} !Fd
- | Write {-# UNPACK #-} !Fd
-
-data Select = Select {
- readfds :: {-# UNPACK #-} !(ForeignPtr CFdSet)
- , writefds :: {-# UNPACK #-} !(ForeignPtr CFdSet)
- , newReqs :: {-# UNPACK #-} !(IORef [IOReq])
- , pendingReqs :: {-# UNPACK #-} !(IORef [IOReq])
- }
-
-data CFdSet
-
-fdIsSet :: Fd -> Ptr CFdSet -> IO Bool
-fdIsSet (Fd fd) fdset = do
- b <- c_fdIsSet fd fdset
- if b /= 0
- then return True
- else return False
-
-fdSet :: Fd -> Ptr CFdSet -> IO ()
-fdSet (Fd fd) fdset = c_fdSet fd fdset
-
-fdZero :: Ptr CFdSet -> IO ()
-fdZero fdset = c_fdZero fdset
-
-foreign import ccall unsafe "select"
- c_select :: Fd -> Ptr CFdSet -> Ptr CFdSet -> Ptr CFdSet -> Ptr CTimeval
- -> IO CInt
-
-foreign import ccall unsafe "__hsevent_fd_isset"
- c_fdIsSet :: CInt -> Ptr CFdSet -> IO CInt
-
-foreign import ccall unsafe "__hsevent_fd_set"
- c_fdSet :: CInt -> Ptr CFdSet -> IO ()
-
-foreign import ccall unsafe "__hsevent_fd_zero"
- c_fdZero :: Ptr CFdSet -> IO ()
-
-#endif /* defined(HAVE_SELECT) */
View
@@ -18,7 +18,6 @@ import Test.HUnit (Assertion, assertBool, assertEqual)
import qualified System.Event.EPoll as EPoll
import qualified System.Event.KQueue as KQueue
import qualified System.Event.Poll as Poll
-import qualified System.Event.Select as Select
import qualified Test.Framework as F
import qualified Test.Framework.Providers.HUnit as F
@@ -96,5 +95,4 @@ tests = F.testGroup "System.Event.Manager" [ group | (available, group) <- [
(EPoll.available, F.testGroup "EPoll" $ backendTests EPoll.new)
, (KQueue.available, F.testGroup "KQueue" $ backendTests KQueue.new)
, (Poll.available, F.testGroup "Poll" $ backendTests Poll.new)
- , (Select.available, F.testGroup "Select" $ backendTests Select.new)
], available]

0 comments on commit 532cc1a

Please sign in to comment.