puts ("flushReadBuffer: new file offset = " ++ show off ++ "\n")
# endif
throwErrnoIfMinus1Retry "flushReadBuffer"
- (c_lseek (fromIntegral fd) (fromIntegral off) sEEK_CUR)
+ (c_lseek fd (fromIntegral off) sEEK_CUR)
return buf{ bufWPtr=0, bufRPtr=0 }
flushWriteBuffer :: FD -> Bool -> Buffer -> IO Buffer
if bytes == 0
then return (buf{ bufRPtr=0, bufWPtr=0 })
else do
- res <- writeRawBuffer "flushWriteBuffer" (fromIntegral fd) is_stream b
+ res <- writeRawBuffer "flushWriteBuffer" fd is_stream b
(fromIntegral r) (fromIntegral bytes)
let res' = fromIntegral res
if res' < bytes
writeRawBuffer :: String -> FD -> Bool -> RawBuffer -> Int -> CInt -> IO CInt
writeRawBuffer loc fd is_stream buf off len =
throwErrnoIfMinus1RetryMayBlock loc
- (write_rawBuffer (fromIntegral fd) buf off len)
+ (write_rawBuffer fd buf off len)
(threadWaitWrite (fromIntegral fd))
writeRawBufferPtr :: String -> FD -> Bool -> Ptr CChar -> Int -> CInt -> IO CInt
writeRawBufferPtr loc fd is_stream buf off len =
throwErrnoIfMinus1RetryMayBlock loc
- (write_off (fromIntegral fd) buf off len)
+ (write_off fd buf off len)
(threadWaitWrite (fromIntegral fd))
foreign import ccall unsafe "__hscore_PrelHandle_read"
blockingWriteRawBuffer loc fd True buf off len =
throwErrnoIfMinus1Retry loc $
- send_rawBuffer (fromIntegral fd) buf off len
+ send_rawBuffer fd buf off len
blockingWriteRawBuffer loc fd False buf off len =
throwErrnoIfMinus1Retry loc $
- write_rawBuffer (fromIntegral fd) buf off len
+ write_rawBuffer fd buf off len
blockingWriteRawBufferPtr loc fd True buf off len =
throwErrnoIfMinus1Retry loc $
- send_off (fromIntegral fd) buf off len
+ send_off fd buf off len
blockingWriteRawBufferPtr loc fd False buf off len =
throwErrnoIfMinus1Retry loc $
- write_off (fromIntegral fd) buf off len
+ write_off fd buf off len
-- NOTE: "safe" versions of the read/write calls for use by the threaded RTS.
-- These calls may block, but that's ok.
-- directories. However, the man pages I've read say that open()
-- always returns EISDIR if the file is a directory and was opened
-- for writing, so I think we're ok with a single open() here...
- fd <- fromIntegral `liftM`
- throwErrnoIfMinus1Retry "openFile"
+ fd <- throwErrnoIfMinus1Retry "openFile"
(c_open f (fromIntegral oflags) 0o666)
fd_type <- fdType fd
h <- openFd fd (Just fd_type) False filepath mode binary
- `catchException` \e -> do c_close (fromIntegral fd); throw e
+ `catchException` \e -> do c_close fd; throw e
-- NB. don't forget to close the FD if openFd fails, otherwise
-- this FD leaks.
-- ASSERT: if we just created the file, then openFd won't fail
-- like /dev/null.
if mode == WriteMode && fd_type == RegularFile
then throwErrnoIf (/=0) "openFile"
- (c_ftruncate (fromIntegral fd) 0)
+ (c_ftruncate fd 0)
else return 0
#endif
return h
then findTempName (x+1)
else ioError (errnoToIOError loc errno Nothing (Just tmp_dir))
else do
- h <- openFd (fromIntegral fd) Nothing False filepath ReadWriteMode True
- `catchException` \e -> do c_close (fromIntegral fd); throw e
+ h <- openFd fd Nothing False filepath ReadWriteMode True
+ `catchException` \e -> do c_close fd; throw e
return (filepath, h)
where
filename = prefix ++ show x ++ suffix
-- regular files need to be locked
RegularFile -> do
#ifndef mingw32_HOST_OS
- r <- lockFile (fromIntegral fd) (fromBool write) 1{-exclusive-}
+ r <- lockFile fd (fromBool write) 1{-exclusive-}
when (r == -1) $
ioException (IOError Nothing ResourceBusy "openFile"
"file is locked" Nothing)
hClose_handle_ handle_ = do
let fd = haFD handle_
- c_fd = fromIntegral fd
-- close the file descriptor, but not when this is the read
-- side of a duplex handle.
Nothing ->
throwErrnoIfMinus1Retry_ "hClose"
#ifdef mingw32_HOST_OS
- (closeFd (haIsStream handle_) c_fd)
+ (closeFd (haIsStream handle_) fd)
#else
- (c_close c_fd)
+ (c_close fd)
#endif
Just _ -> return ()
#ifndef mingw32_HOST_OS
-- unlock it
- unlockFile c_fd
+ unlockFile fd
#endif
-- we must set the fd to -1, because the finalizer is going
SemiClosedHandle -> ioe_closedHandle
_ -> do flushWriteBufferOnly handle_
throwErrnoIf (/=0) "hSetFileSize"
- (c_ftruncate (fromIntegral (haFD handle_)) (fromIntegral size))
+ (c_ftruncate (haFD handle_) (fromIntegral size))
return ()
-- ---------------------------------------------------------------------------
let do_seek =
throwErrnoIfMinus1Retry_ "hSeek"
- (c_lseek (fromIntegral (haFD handle_)) (fromIntegral offset) whence)
+ (c_lseek (haFD handle_) (fromIntegral offset) whence)
whence :: CInt
whence = case mode of
-- current buffer size. Just flush instead.
flushBuffer handle_
#endif
- let fd = fromIntegral (haFD handle_)
+ let fd = haFD handle_
posn <- fromIntegral `liftM`
throwErrnoIfMinus1Retry "hGetPosn"
(c_lseek fd 0 sEEK_CUR)
hSetBinaryMode handle bin =
withAllHandles__ "hSetBinaryMode" handle $ \ handle_ ->
do throwErrnoIfMinus1_ "hSetBinaryMode"
- (setmode (fromIntegral (haFD handle_)) bin)
+ (setmode (haFD handle_) bin)
return handle_{haIsBin=bin}
foreign import ccall unsafe "__hscore_setmode"
-- flush the buffer first, so we don't have to copy its contents
flushBuffer h_
new_fd <- throwErrnoIfMinus1 "dupHandle" $
- c_dup (fromIntegral (haFD h_))
+ c_dup (haFD h_)
dupHandle_ other_side h_ new_fd
dupHandleTo other_side hto_ h_ = do
flushBuffer h_
-- Windows' dup2 does not return the new descriptor, unlike Unix
throwErrnoIfMinus1 "dupHandleTo" $
- c_dup2 (fromIntegral (haFD h_)) (fromIntegral (haFD hto_))
+ c_dup2 (haFD h_) (haFD hto_)
dupHandle_ other_side h_ (haFD hto_)
+dupHandle_ :: Maybe (MVar Handle__) -> Handle__ -> FD
+ -> IO (Handle__, Handle__)
dupHandle_ other_side h_ new_fd = do
buffer <- allocateBuffer dEFAULT_BUFFER_SIZE (initBufferState (haType h_))
ioref <- newIORef buffer
ioref_buffers <- newIORef BufferListNil
- let new_handle_ = h_{ haFD = fromIntegral new_fd,
+ let new_handle_ = h_{ haFD = new_fd,
haBuffer = ioref,
haBuffers = ioref_buffers,
haOtherSide = other_side }
-- ---------------------------------------------------------------------------
-- stat()-related stuff
-fdFileSize :: Int -> IO Integer
+fdFileSize :: FD -> IO Integer
fdFileSize fd =
allocaBytes sizeof_stat $ \ p_stat -> do
throwErrnoIfMinus1Retry "fileSize" $
- c_fstat (fromIntegral fd) p_stat
+ c_fstat fd p_stat
c_mode <- st_mode p_stat :: IO CMode
if not (s_isreg c_mode)
then return (-1)
-- NOTE: On Win32 platforms, this will only work with file descriptors
-- referring to file handles. i.e., it'll fail for socket FDs.
-fdType :: Int -> IO FDType
+fdType :: FD -> IO FDType
fdType fd =
allocaBytes sizeof_stat $ \ p_stat -> do
throwErrnoIfMinus1Retry "fdType" $
- c_fstat (fromIntegral fd) p_stat
+ c_fstat fd p_stat
statGetType p_stat
statGetType p_stat = do
c_closesocket :: CInt -> IO CInt
#endif
-fdGetMode :: Int -> IO IOMode
+fdGetMode :: FD -> IO IOMode
fdGetMode fd = do
#if defined(mingw32_HOST_OS) || defined(__MINGW32__)
-- XXX: this code is *BROKEN*, _setmode only deals with O_TEXT/O_BINARY
flags1 <- throwErrnoIfMinus1Retry "fdGetMode"
- (c__setmode (fromIntegral fd) (fromIntegral o_WRONLY))
+ (c__setmode fd (fromIntegral o_WRONLY))
flags <- throwErrnoIfMinus1Retry "fdGetMode"
- (c__setmode (fromIntegral fd) (fromIntegral flags1))
+ (c__setmode fd (fromIntegral flags1))
#else
flags <- throwErrnoIfMinus1Retry "fdGetMode"
- (c_fcntl_read (fromIntegral fd) const_f_getfl)
+ (c_fcntl_read fd const_f_getfl)
#endif
let
wH = (flags .&. o_WRONLY) /= 0
-- ---------------------------------------------------------------------------
-- Terminal-related stuff
-fdIsTTY :: Int -> IO Bool
-fdIsTTY fd = c_isatty (fromIntegral fd) >>= return.toBool
+fdIsTTY :: FD -> IO Bool
+fdIsTTY fd = c_isatty fd >>= return.toBool
#if defined(HTYPE_TCFLAG_T)
-setEcho :: Int -> Bool -> IO ()
+setEcho :: FD -> Bool -> IO ()
setEcho fd on = do
tcSetAttr fd $ \ p_tios -> do
c_lflag <- c_lflag p_tios :: IO CTcflag
| otherwise = c_lflag .&. complement (fromIntegral const_echo)
poke_c_lflag p_tios (new_c_lflag :: CTcflag)
-getEcho :: Int -> IO Bool
+getEcho :: FD -> IO Bool
getEcho fd = do
tcSetAttr fd $ \ p_tios -> do
c_lflag <- c_lflag p_tios :: IO CTcflag
return ((c_lflag .&. fromIntegral const_echo) /= 0)
-setCooked :: Int -> Bool -> IO ()
+setCooked :: FD -> Bool -> IO ()
setCooked fd cooked =
tcSetAttr fd $ \ p_tios -> do
tcSetAttr fd fun = do
allocaBytes sizeof_termios $ \p_tios -> do
throwErrnoIfMinus1Retry "tcSetAttr"
- (c_tcgetattr (fromIntegral fd) p_tios)
+ (c_tcgetattr fd p_tios)
#ifdef __GLASGOW_HASKELL__
-- Save a copy of termios, if this is a standard file descriptor.
c_sigprocmask const_sig_block p_sigset p_old_sigset
r <- fun p_tios -- do the business
throwErrnoIfMinus1Retry_ "tcSetAttr" $
- c_tcsetattr (fromIntegral fd) const_tcsanow p_tios
+ c_tcsetattr fd const_tcsanow p_tios
c_sigprocmask const_sig_setmask p_old_sigset nullPtr
return r
#ifdef __GLASGOW_HASKELL__
foreign import ccall unsafe "HsBase.h __hscore_get_saved_termios"
- get_saved_termios :: Int -> IO (Ptr CTermios)
+ get_saved_termios :: CInt -> IO (Ptr CTermios)
foreign import ccall unsafe "HsBase.h __hscore_set_saved_termios"
- set_saved_termios :: Int -> (Ptr CTermios) -> IO ()
+ set_saved_termios :: CInt -> (Ptr CTermios) -> IO ()
#endif
#else
-- report that character until another character is input..odd.) This
-- latter feature doesn't sit too well with IO actions like IO.hGetLine..
-- consider yourself warned.
-setCooked :: Int -> Bool -> IO ()
+setCooked :: FD -> Bool -> IO ()
setCooked fd cooked = do
- x <- set_console_buffering (fromIntegral fd) (if cooked then 1 else 0)
+ x <- set_console_buffering fd (if cooked then 1 else 0)
if (x /= 0)
then ioError (ioe_unk_error "setCooked" "failed to set buffering")
else return ()
-- Note: echoing goes hand in hand with enabling 'line input' / raw-ness
-- for Win32 consoles, hence setEcho ends up being the inverse of setCooked.
-setEcho :: Int -> Bool -> IO ()
+setEcho :: FD -> Bool -> IO ()
setEcho fd on = do
- x <- set_console_echo (fromIntegral fd) (if on then 1 else 0)
+ x <- set_console_echo fd (if on then 1 else 0)
if (x /= 0)
then ioError (ioe_unk_error "setEcho" "failed to set echoing")
else return ()
-getEcho :: Int -> IO Bool
+getEcho :: FD -> IO Bool
getEcho fd = do
- r <- get_console_echo (fromIntegral fd)
+ r <- get_console_echo fd
if (r == (-1))
then ioError (ioe_unk_error "getEcho" "failed to get echoing")
else return (r == 1)
setNonBlockingFD fd = do
flags <- throwErrnoIfMinus1Retry "setNonBlockingFD"
- (c_fcntl_read (fromIntegral fd) const_f_getfl)
+ (c_fcntl_read fd const_f_getfl)
-- An error when setting O_NONBLOCK isn't fatal: on some systems
-- there are certain file handles on which this will fail (eg. /dev/null
-- on FreeBSD) so we throw away the return code from fcntl_write.
unless (testBit flags (fromIntegral o_NONBLOCK)) $ do
- c_fcntl_write (fromIntegral fd) const_f_setfl (flags .|. o_NONBLOCK)
+ c_fcntl_write fd const_f_setfl (flags .|. o_NONBLOCK)
return ()
#else
projects / haskell-directory.git / commitdiff