From 23ca6b8a9e91256cc39ad823cdd7a0fc1fdf3ac5 Mon Sep 17 00:00:00 2001 From: simonmar Date: Tue, 23 Dec 2003 13:58:18 +0000 Subject: [PATCH] [project @ 2003-12-23 13:58:17 by simonmar] - Fix up mingw build after changes to hGetBuf etc. I don't think that hGetBufNonBlocking works correctly on Windows, because there doesn't seem to be a non-blocking read primitive. I haven't tested it, however. - Clean up Unix versions of the low-level read/write functions in Handle.hs. Now that these aren't used on Windows, they can be made simpler. --- GHC/Handle.hs | 43 +++++++++++++++++-------------------------- GHC/IO.hs | 4 ++++ include/HsBase.h | 16 ++-------------- 3 files changed, 23 insertions(+), 40 deletions(-) diff --git a/GHC/Handle.hs b/GHC/Handle.hs index 64fab41..d2c2614 100644 --- a/GHC/Handle.hs +++ b/GHC/Handle.hs @@ -28,10 +28,6 @@ module GHC.Handle ( writeRawBuffer, writeRawBufferPtr, unlockFile, - {- ought to be unnecessary, but just in case.. -} - write_off, write_rawBuffer, - read_off, read_rawBuffer, - ioe_closedHandle, ioe_EOF, ioe_notReadable, ioe_notWritable, stdin, stdout, stderr, @@ -516,44 +512,44 @@ fillReadBufferWithoutBlocking fd is_stream readRawBuffer :: String -> FD -> Bool -> RawBuffer -> Int -> CInt -> IO CInt readRawBuffer loc fd is_stream buf off len = throwErrnoIfMinus1RetryMayBlock loc - (read_rawBuffer fd is_stream buf off len) + (read_rawBuffer fd buf off len) (threadWaitRead fd) readRawBufferNoBlock :: String -> FD -> Bool -> RawBuffer -> Int -> CInt -> IO CInt readRawBufferNoBlock loc fd is_stream buf off len = throwErrnoIfMinus1RetryOnBlock loc - (read_rawBuffer fd is_stream buf off len) + (read_rawBuffer fd buf off len) (return 0) readRawBufferPtr :: String -> FD -> Bool -> Ptr CChar -> Int -> CInt -> IO CInt readRawBufferPtr loc fd is_stream buf off len = throwErrnoIfMinus1RetryMayBlock loc - (read_off fd is_stream buf off len) + (read_off fd buf off len) (threadWaitRead fd) writeRawBuffer :: String -> FD -> Bool -> RawBuffer -> Int -> CInt -> IO CInt writeRawBuffer loc fd is_stream buf off len = throwErrnoIfMinus1RetryMayBlock loc - (write_rawBuffer (fromIntegral fd) is_stream buf off len) + (write_rawBuffer (fromIntegral fd) buf off len) (threadWaitWrite 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) is_stream buf off len) + (write_off (fromIntegral fd) buf off len) (threadWaitWrite fd) foreign import ccall unsafe "__hscore_PrelHandle_read" - read_rawBuffer :: FD -> Bool -> RawBuffer -> Int -> CInt -> IO CInt + read_rawBuffer :: FD -> RawBuffer -> Int -> CInt -> IO CInt foreign import ccall unsafe "__hscore_PrelHandle_read" - read_off :: FD -> Bool -> Ptr CChar -> Int -> CInt -> IO CInt + read_off :: FD -> Ptr CChar -> Int -> CInt -> IO CInt foreign import ccall unsafe "__hscore_PrelHandle_write" - write_rawBuffer :: CInt -> Bool -> RawBuffer -> Int -> CInt -> IO CInt + write_rawBuffer :: CInt -> RawBuffer -> Int -> CInt -> IO CInt foreign import ccall unsafe "__hscore_PrelHandle_write" - write_off :: CInt -> Bool -> Ptr CChar -> Int -> CInt -> IO CInt + write_off :: CInt -> Ptr CChar -> Int -> CInt -> IO CInt #else readRawBuffer :: String -> FD -> Bool -> RawBuffer -> Int -> CInt -> IO CInt @@ -564,6 +560,14 @@ readRawBuffer loc fd is_stream buf off len = do ioError (errnoToIOError loc (Errno (fromIntegral rc)) Nothing Nothing) else return (fromIntegral l) +readRawBufferNoBlock :: String -> FD -> Bool -> RawBuffer -> Int -> CInt -> IO CInt +readRawBufferNoBlock loc fd is_stream buf off len = do + (l, rc) <- asyncReadBA fd (if is_stream then 1 else 0) (fromIntegral len) off buf + if l == (-1) + then + ioError (errnoToIOError loc (Errno (fromIntegral rc)) Nothing Nothing) + else return (fromIntegral l) + readRawBufferPtr :: String -> FD -> Bool -> Ptr CChar -> Int -> CInt -> IO CInt readRawBufferPtr loc fd is_stream buf off len = do (l, rc) <- asyncRead fd (if is_stream then 1 else 0) (fromIntegral len) (buf `plusPtr` off) @@ -587,19 +591,6 @@ writeRawBufferPtr loc fd is_stream buf off len = do then ioError (errnoToIOError loc (Errno (fromIntegral rc)) Nothing Nothing) else return (fromIntegral l) - -foreign import ccall unsafe "__hscore_PrelHandle_read" - read_rawBuffer :: FD -> Bool -> RawBuffer -> Int -> CInt -> IO CInt - -foreign import ccall unsafe "__hscore_PrelHandle_read" - read_off :: FD -> Bool -> Ptr CChar -> Int -> CInt -> IO CInt - -foreign import ccall unsafe "__hscore_PrelHandle_write" - write_rawBuffer :: CInt -> Bool -> RawBuffer -> Int -> CInt -> IO CInt - -foreign import ccall unsafe "__hscore_PrelHandle_write" - write_off :: CInt -> Bool -> Ptr CChar -> Int -> CInt -> IO CInt - #endif -- --------------------------------------------------------------------------- diff --git a/GHC/IO.hs b/GHC/IO.hs index d494a31..24a0653 100644 --- a/GHC/IO.hs +++ b/GHC/IO.hs @@ -47,6 +47,10 @@ import GHC.Show import GHC.List import GHC.Exception ( ioError, catch ) +#ifdef mingw32_TARGET_OS +import GHC.Conc +#endif + -- --------------------------------------------------------------------------- -- Simple input operations diff --git a/include/HsBase.h b/include/HsBase.h index 960aedd..71fd475 100644 --- a/include/HsBase.h +++ b/include/HsBase.h @@ -392,26 +392,14 @@ __hscore_setmode( HsInt fd, HsBool toBin ) } INLINE HsInt -__hscore_PrelHandle_write( HsInt fd, HsBool isSock, HsAddr ptr, - HsInt off, int sz ) +__hscore_PrelHandle_write( HsInt fd, HsAddr ptr, HsInt off, int sz ) { -#if defined(mingw32_TARGET_OS) || defined(_MSC_VER) - if (isSock) { - return send(fd,(char *)ptr + off, sz, 0); - } -#endif return write(fd,(char *)ptr + off, sz); } INLINE HsInt -__hscore_PrelHandle_read( HsInt fd, HsBool isSock, HsAddr ptr, - HsInt off, int sz ) +__hscore_PrelHandle_read( HsInt fd, HsAddr ptr, HsInt off, int sz ) { -#if defined(mingw32_TARGET_OS) || defined(_MSC_VER) - if (isSock) { - return recv(fd,(char *)ptr + off, sz, 0); - } -#endif return read(fd,(char *)ptr + off, sz); } -- 1.7.10.4