ioe_closedHandle, ioe_EOF, ioe_notReadable, ioe_notWritable,
stdin, stdout, stderr,
- IOMode(..), openFile, openBinaryFile, openTempFile, openBinaryTempFile, openFd, fdToHandle,
+ IOMode(..), openFile, openBinaryFile, fdToHandle', fdToHandle,
hFileSize, hSetFileSize, hIsEOF, isEOF, hLookAhead, hSetBuffering, hSetBinaryMode,
hFlush, hDuplicate, hDuplicateTo,
else return 0
-- XXX see note [nonblock]
where
- do_read call = throwErrnoIfMinus1RetryMayBlock loc call (return 0)
+ do_read call = throwErrnoIfMinus1RetryOnBlock loc call (return 0)
unsafe_read = do_read (read_rawBuffer fd buf off len)
safe_read = do_read (safe_read_rawBuffer fd buf off len)
| is_nonblock = unsafe_write
| threaded = safe_write
| otherwise = do r <- fdReady (fromIntegral fd) 1 0 False
- if r /= 0 then safe_write
- else return 0
+ if r /= 0
+ then safe_write
+ else do threadWaitWrite (fromIntegral fd); unsafe_write
where
do_write call = throwErrnoIfMinus1RetryMayBlock loc call
(threadWaitWrite (fromIntegral fd))
| is_nonblock = unsafe_write
| threaded = safe_write
| otherwise = do r <- fdReady (fromIntegral fd) 1 0 False
- if r /= 0 then safe_write
- else return 0
+ if r /= 0
+ then safe_write
+ else do threadWaitWrite (fromIntegral fd); unsafe_write
where
do_write call = throwErrnoIfMinus1RetryMayBlock loc call
(threadWaitWrite (fromIntegral fd))
fd_type <- fdType fd
- h <- openFd fd (Just fd_type) False filepath mode binary
+ h <- fdToHandle' fd (Just fd_type) False filepath mode binary
`catchException` \e -> do c_close fd; throw e
- -- NB. don't forget to close the FD if openFd fails, otherwise
+ -- NB. don't forget to close the FD if fdToHandle' fails, otherwise
-- this FD leaks.
- -- ASSERT: if we just created the file, then openFd won't fail
+ -- ASSERT: if we just created the file, then fdToHandle' won't fail
-- (so we don't need to worry about removing the newly created file
-- in the event of an error).
return h
--- | The function creates a temporary file in ReadWrite mode.
--- The created file isn\'t deleted automatically, so you need to delete it manually.
-openTempFile :: FilePath -- ^ Directory in which to create the file
- -> String -- ^ File name template. If the template is \"foo.ext\" then
- -- the create file will be \"fooXXX.ext\" where XXX is some
- -- random number.
- -> IO (FilePath, Handle)
-openTempFile tmp_dir template = openTempFile' "openTempFile" tmp_dir template dEFAULT_OPEN_IN_BINARY_MODE
-
--- | Like 'openTempFile', but opens the file in binary mode. See 'openBinaryFile' for more comments.
-openBinaryTempFile :: FilePath -> String -> IO (FilePath, Handle)
-openBinaryTempFile tmp_dir template = openTempFile' "openBinaryTempFile" tmp_dir template True
-
-openTempFile' :: String -> FilePath -> String -> Bool -> IO (FilePath, Handle)
-openTempFile' loc tmp_dir template binary = do
- pid <- c_getpid
- findTempName pid
- where
- (prefix,suffix) = break (=='.') template
-
- oflags1 = rw_flags .|. o_EXCL
-
- binary_flags
- | binary = o_BINARY
- | otherwise = 0
-
- oflags = oflags1 .|. binary_flags
-
- findTempName x = do
- fd <- withCString filepath $ \ f ->
- c_open f oflags 0o666
- if fd < 0
- then do
- errno <- getErrno
- if errno == eEXIST
- then findTempName (x+1)
- else ioError (errnoToIOError loc errno Nothing (Just tmp_dir))
- else do
- 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
- filepath = tmp_dir ++ [pathSeparator] ++ filename
-
-pathSeparator :: Char
-#ifdef mingw32_HOST_OS
-pathSeparator = '\\'
-#else
-pathSeparator = '/'
-#endif
-
std_flags = o_NONBLOCK .|. o_NOCTTY
output_flags = std_flags .|. o_CREAT
read_flags = std_flags .|. o_RDONLY
append_flags = write_flags .|. o_APPEND
-- ---------------------------------------------------------------------------
--- openFd
+-- fdToHandle'
-openFd :: FD -> Maybe FDType -> Bool -> FilePath -> IOMode -> Bool -> IO Handle
-openFd fd mb_fd_type is_socket filepath mode binary = do
+fdToHandle' :: FD -> Maybe FDType -> Bool -> FilePath -> IOMode -> Bool -> IO Handle
+fdToHandle' fd mb_fd_type is_socket filepath mode binary = do
-- turn on non-blocking mode
setNonBlockingFD fd
fdToHandle fd = do
mode <- fdGetMode fd
let fd_str = "<file descriptor: " ++ show fd ++ ">"
- openFd fd Nothing False{-XXX!-} fd_str mode True{-bin mode-}
+ fdToHandle' fd Nothing False{-XXX!-} fd_str mode True{-bin mode-}
#ifndef mingw32_HOST_OS
-- free the spare buffers
writeIORef (haBuffers handle_) BufferListNil
+ writeIORef (haBuffer handle_) noBuffer
#ifndef mingw32_HOST_OS
-- unlock it
haType = ClosedHandle
})
+{-# NOINLINE noBuffer #-}
+noBuffer = unsafePerformIO $ allocateBuffer 1 ReadBuffer
+
-----------------------------------------------------------------------------
-- Detecting and changing the size of a file
projects / ghc-base.git / blobdiff