diff options
author | Ian Lynagh <igloo@earth.li> | 2011-11-28 18:59:18 +0000 |
---|---|---|
committer | Ian Lynagh <igloo@earth.li> | 2011-11-28 18:59:18 +0000 |
commit | b02e926961caeabe4ebe0bf6b3a671e1ec190864 (patch) | |
tree | 02e3975782db9ce8583aa2753d02a36968bd6cfe /System/Posix/IO/Common.hsc | |
parent | a55cb0304bf9ba3d20146d25b1fed4116819f4b3 (diff) |
Use capi to define the fcntl FFI imports
Diffstat (limited to 'System/Posix/IO/Common.hsc')
-rw-r--r-- | System/Posix/IO/Common.hsc | 21 |
1 files changed, 6 insertions, 15 deletions
diff --git a/System/Posix/IO/Common.hsc b/System/Posix/IO/Common.hsc index c937b3e..e12bebc 100644 --- a/System/Posix/IO/Common.hsc +++ b/System/Posix/IO/Common.hsc @@ -297,7 +297,7 @@ fdOption2Int SynchronousWrites = (#const O_SYNC) -- | May throw an exception if this is an invalid descriptor. queryFdOption :: Fd -> FdOption -> IO Bool queryFdOption (Fd fd) opt = do - r <- throwErrnoIfMinus1 "queryFdOption" (c_fcntl_read fd flag) + r <- throwErrnoIfMinus1 "queryFdOption" (Base.c_fcntl_read fd flag) return ((r .&. fdOption2Int opt) /= 0) where flag = case opt of @@ -307,23 +307,17 @@ queryFdOption (Fd fd) opt = do -- | May throw an exception if this is an invalid descriptor. setFdOption :: Fd -> FdOption -> Bool -> IO () setFdOption (Fd fd) opt val = do - r <- throwErrnoIfMinus1 "setFdOption" (c_fcntl_read fd getflag) + r <- throwErrnoIfMinus1 "setFdOption" (Base.c_fcntl_read fd getflag) let r' | val = r .|. opt_val | otherwise = r .&. (complement opt_val) throwErrnoIfMinus1_ "setFdOption" - (c_fcntl_write fd setflag (fromIntegral r')) + (Base.c_fcntl_write fd setflag (fromIntegral r')) where (getflag,setflag)= case opt of CloseOnExec -> ((#const F_GETFD),(#const F_SETFD)) _ -> ((#const F_GETFL),(#const F_SETFL)) opt_val = fdOption2Int opt -foreign import ccall unsafe "HsUnix.h fcntl_read" - c_fcntl_read :: CInt -> CInt -> IO CInt - -foreign import ccall unsafe "HsUnix.h fcntl_write" - c_fcntl_write :: CInt -> CInt -> CLong -> IO CInt - -- ----------------------------------------------------------------------------- -- Seeking @@ -350,7 +344,7 @@ type FileLock = (LockRequest, SeekMode, FileOffset, FileOffset) getLock :: Fd -> FileLock -> IO (Maybe (ProcessID, FileLock)) getLock (Fd fd) lock = allocaLock lock $ \p_flock -> do - throwErrnoIfMinus1_ "getLock" (c_fcntl_lock fd (#const F_GETLK) p_flock) + throwErrnoIfMinus1_ "getLock" (Base.c_fcntl_lock fd (#const F_GETLK) p_flock) result <- bytes2ProcessIDAndLock p_flock return (maybeResult result) where @@ -359,9 +353,6 @@ getLock (Fd fd) lock = type CFLock = () -foreign import ccall unsafe "HsUnix.h fcntl_lock" - c_fcntl_lock :: CInt -> CInt -> Ptr CFLock -> IO CInt - allocaLock :: FileLock -> (Ptr CFLock -> IO a) -> IO a allocaLock (lockreq, mode, start, len) io = allocaBytes (#const sizeof(struct flock)) $ \p -> do @@ -401,14 +392,14 @@ bytes2ProcessIDAndLock p = do setLock :: Fd -> FileLock -> IO () setLock (Fd fd) lock = do allocaLock lock $ \p_flock -> - throwErrnoIfMinus1_ "setLock" (c_fcntl_lock fd (#const F_SETLK) p_flock) + throwErrnoIfMinus1_ "setLock" (Base.c_fcntl_lock fd (#const F_SETLK) p_flock) -- | May throw an exception if this is an invalid descriptor. waitToSetLock :: Fd -> FileLock -> IO () waitToSetLock (Fd fd) lock = do allocaLock lock $ \p_flock -> throwErrnoIfMinus1_ "waitToSetLock" - (c_fcntl_lock fd (#const F_SETLKW) p_flock) + (Base.c_fcntl_lock fd (#const F_SETLKW) p_flock) -- ----------------------------------------------------------------------------- -- fd{Read,Write} |