-{-# OPTIONS -fno-implicit-prelude -#include "HsBase.h" #-}
+{-# OPTIONS_GHC -fno-implicit-prelude -#include "HsBase.h" #-}
#undef DEBUG_DUMP
#undef DEBUG
readRawBuffer, readRawBufferPtr,
writeRawBuffer, writeRawBufferPtr,
-#ifndef mingw32_TARGET_OS
+#ifndef mingw32_HOST_OS
unlockFile,
#endif
) where
-#include "ghcconfig.h"
-
+import System.Directory.Internals
import Control.Monad
import Data.Bits
import Data.Maybe
import Foreign.C
import System.IO.Error
import System.Posix.Internals
-import System.FilePath
import GHC.Real
allocateBuffer :: Int -> BufferState -> IO Buffer
allocateBuffer sz@(I# size) state = IO $ \s ->
-#ifdef mingw32_TARGET_OS
+#ifdef mingw32_HOST_OS
-- To implement asynchronous I/O under Win32, we have to pass
-- buffer references to external threads that handles the
-- filling/emptying of their contents. Hence, the buffer cannot
-- Low level routines for reading/writing to (raw)buffers:
-#ifndef mingw32_TARGET_OS
+#ifndef mingw32_HOST_OS
readRawBuffer :: String -> FD -> Bool -> RawBuffer -> Int -> CInt -> IO CInt
readRawBuffer loc fd is_stream buf off len =
throwErrnoIfMinus1RetryMayBlock loc
foreign import ccall unsafe "__hscore_PrelHandle_write"
write_off :: CInt -> Ptr CChar -> Int -> CInt -> IO CInt
-#else /* mingw32_TARGET_OS.... */
+#else /* mingw32_HOST_OS.... */
readRawBuffer :: String -> FD -> Bool -> RawBuffer -> Int -> CInt -> IO CInt
readRawBuffer loc fd is_stream buf off len
let
oflags1 = case mode of
- ReadMode -> read_flags
- WriteMode -> write_flags
- ReadWriteMode -> rw_flags
+ ReadMode -> read_flags
+#ifdef mingw32_HOST_OS
+ WriteMode -> write_flags .|. o_TRUNC
+#else
+ WriteMode -> write_flags
+#endif
+ ReadWriteMode -> rw_flags
AppendMode -> append_flags
binary_flags
throwErrnoIfMinus1Retry "openFile"
(c_open f (fromIntegral oflags) 0o666)
- openFd fd Nothing False filepath mode binary
- `catchException` \e -> do c_close (fromIntegral fd); throw e
+ h <- openFd fd Nothing False filepath mode binary
+ `catchException` \e -> do c_close (fromIntegral 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
-- (so we don't need to worry about removing the newly created file
-- in the event of an error).
+#ifndef mingw32_HOST_OS
+ if mode == WriteMode
+ then throwErrnoIf (/=0) "openFile"
+ (c_ftruncate (fromIntegral fd) 0)
+ else return 0
+#endif
+ 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.
std_flags = o_NONBLOCK .|. o_NOCTTY
output_flags = std_flags .|. o_CREAT
read_flags = std_flags .|. o_RDONLY
-write_flags = output_flags .|. o_WRONLY .|. o_TRUNC
+write_flags = output_flags .|. o_WRONLY
rw_flags = output_flags .|. o_RDWR
append_flags = write_flags .|. o_APPEND
-- regular files need to be locked
RegularFile -> do
-#ifndef mingw32_TARGET_OS
+#ifndef mingw32_HOST_OS
r <- lockFile (fromIntegral fd) (fromBool write) 1{-exclusive-}
when (r == -1) $
ioException (IOError Nothing ResourceBusy "openFile"
openFd fd Nothing False{-XXX!-} fd_str mode True{-bin mode-}
-#ifndef mingw32_TARGET_OS
+#ifndef mingw32_HOST_OS
foreign import ccall unsafe "lockFile"
lockFile :: CInt -> CInt -> CInt -> IO CInt
c_fd = fromIntegral fd
-- close the file descriptor, but not when this is the read
- -- side of a duplex handle, and not when this is one of the
- -- std file handles.
+ -- side of a duplex handle.
case haOtherSide handle_ of
Nothing ->
- when (fd /= fd_stdin && fd /= fd_stdout && fd /= fd_stderr) $
throwErrnoIfMinus1Retry_ "hClose"
-#ifdef mingw32_TARGET_OS
+#ifdef mingw32_HOST_OS
(closeFd (haIsStream handle_) c_fd)
#else
(c_close c_fd)
-- free the spare buffers
writeIORef (haBuffers handle_) BufferListNil
-#ifndef mingw32_TARGET_OS
+#ifndef mingw32_HOST_OS
-- unlock it
unlockFile c_fd
#endif
is_tty <- fdIsTTY (haFD handle_)
when (is_tty && isReadableHandleType (haType handle_)) $
case mode of
-#ifndef mingw32_TARGET_OS
+#ifndef mingw32_HOST_OS
-- 'raw' mode under win32 is a bit too specialised (and troublesome
-- for most common uses), so simply disable its use here.
NoBuffering -> setCooked (haFD handle_) False
hTell handle =
wantSeekableHandle "hGetPosn" handle $ \ handle_ -> do
-#if defined(mingw32_TARGET_OS)
+#if defined(mingw32_HOST_OS)
-- urgh, on Windows we have to worry about \n -> \r\n translation,
-- so we can't easily calculate the file position using the
-- current buffer size. Just flush instead.