diff options
| -rw-r--r-- | libraries/base/GHC/Conc.lhs | 2 | ||||
| -rw-r--r-- | libraries/base/GHC/IO/FD.hs | 86 | ||||
| -rw-r--r-- | libraries/base/System/Posix/Internals.hs | 10 | ||||
| -rw-r--r-- | libraries/base/include/HsBase.h | 27 |
4 files changed, 47 insertions, 78 deletions
diff --git a/libraries/base/GHC/Conc.lhs b/libraries/base/GHC/Conc.lhs index 2d623081b0..1d6d9ed846 100644 --- a/libraries/base/GHC/Conc.lhs +++ b/libraries/base/GHC/Conc.lhs @@ -1054,7 +1054,7 @@ service_loop wakeup readfds writefds ptimeval old_reqs old_delays = do service_loop wakeup readfds writefds ptimeval reqs' delays' -io_MANAGER_WAKEUP, io_MANAGER_DIE, io_MANAGER_SYNC :: CChar +io_MANAGER_WAKEUP, io_MANAGER_DIE, io_MANAGER_SYNC :: Word8 io_MANAGER_WAKEUP = 0xff io_MANAGER_DIE = 0xfe io_MANAGER_SYNC = 0xfd diff --git a/libraries/base/GHC/IO/FD.hs b/libraries/base/GHC/IO/FD.hs index a54dd5237a..76c0242afd 100644 --- a/libraries/base/GHC/IO/FD.hs +++ b/libraries/base/GHC/IO/FD.hs @@ -447,7 +447,7 @@ indicates that there's no data, we call threadWaitRead. -} -readRawBufferPtr :: String -> FD -> Ptr Word8 -> Int -> CInt -> IO CInt +readRawBufferPtr :: String -> FD -> Ptr Word8 -> Int -> CSize -> IO Int readRawBufferPtr loc !fd buf off len | isNonBlocking fd = unsafe_read -- unsafe is ok, it can't block | otherwise = do r <- throwErrnoIfMinus1 loc @@ -456,14 +456,15 @@ readRawBufferPtr loc !fd buf off len then read else do threadWaitRead (fromIntegral (fdFD fd)); read where - do_read call = throwErrnoIfMinus1RetryMayBlock loc call + do_read call = fromIntegral `fmap` + throwErrnoIfMinus1RetryMayBlock loc call (threadWaitRead (fromIntegral (fdFD fd))) read = if threaded then safe_read else unsafe_read - unsafe_read = do_read (read_off (fdFD fd) buf off len) - safe_read = do_read (safe_read_off (fdFD fd) buf off len) + unsafe_read = do_read (c_read (fdFD fd) (buf `plusPtr` off) len) + safe_read = do_read (c_safe_read (fdFD fd) (buf `plusPtr` off) len) -- return: -1 indicates EOF, >=0 is bytes read -readRawBufferPtrNoBlock :: String -> FD -> Ptr Word8 -> Int -> CInt -> IO CInt +readRawBufferPtrNoBlock :: String -> FD -> Ptr Word8 -> Int -> CSize -> IO Int readRawBufferPtrNoBlock loc !fd buf off len | isNonBlocking fd = unsafe_read -- unsafe is ok, it can't block | otherwise = do r <- unsafe_fdReady (fdFD fd) 0 0 0 @@ -475,11 +476,11 @@ readRawBufferPtrNoBlock loc !fd buf off len case r of (-1) -> return 0 0 -> return (-1) - n -> return n - unsafe_read = do_read (read_off (fdFD fd) buf off len) - safe_read = do_read (safe_read_off (fdFD fd) buf off len) + n -> return (fromIntegral n) + unsafe_read = do_read (c_read (fdFD fd) (buf `plusPtr` off) len) + safe_read = do_read (c_safe_read (fdFD fd) (buf `plusPtr` off) len) -writeRawBufferPtr :: String -> FD -> Ptr Word8 -> Int -> CInt -> IO CInt +writeRawBufferPtr :: String -> FD -> Ptr Word8 -> Int -> CSize -> IO CInt writeRawBufferPtr loc !fd buf off len | isNonBlocking fd = unsafe_write -- unsafe is ok, it can't block | otherwise = do r <- unsafe_fdReady (fdFD fd) 1 0 0 @@ -487,13 +488,14 @@ writeRawBufferPtr loc !fd buf off len then write else do threadWaitWrite (fromIntegral (fdFD fd)); write where - do_write call = throwErrnoIfMinus1RetryMayBlock loc call + do_write call = fromIntegral `fmap` + throwErrnoIfMinus1RetryMayBlock loc call (threadWaitWrite (fromIntegral (fdFD fd))) write = if threaded then safe_write else unsafe_write - unsafe_write = do_write (write_off (fdFD fd) buf off len) - safe_write = do_write (safe_write_off (fdFD fd) buf off len) + unsafe_write = do_write (c_write (fdFD fd) (buf `plusPtr` off) len) + safe_write = do_write (c_safe_write (fdFD fd) (buf `plusPtr` off) len) -writeRawBufferPtrNoBlock :: String -> FD -> Ptr Word8 -> Int -> CInt -> IO CInt +writeRawBufferPtrNoBlock :: String -> FD -> Ptr Word8 -> Int -> CSize -> IO CInt writeRawBufferPtrNoBlock loc !fd buf off len | isNonBlocking fd = unsafe_write -- unsafe is ok, it can't block | otherwise = do r <- unsafe_fdReady (fdFD fd) 1 0 0 @@ -503,44 +505,38 @@ writeRawBufferPtrNoBlock loc !fd buf off len do_write call = do r <- throwErrnoIfMinus1RetryOnBlock loc call (return (-1)) case r of (-1) -> return 0 - n -> return n + n -> return (fromIntegral n) write = if threaded then safe_write else unsafe_write - unsafe_write = do_write (write_off (fdFD fd) buf off len) - safe_write = do_write (safe_write_off (fdFD fd) buf off len) + unsafe_write = do_write (c_write (fdFD fd) (buf `plusPtr` off) len) + safe_write = do_write (c_safe_write (fdFD fd) (buf `plusPtr` off) len) isNonBlocking :: FD -> Bool isNonBlocking fd = fdIsNonBlocking fd /= 0 -foreign import ccall unsafe "__hscore_PrelHandle_read" - read_off :: CInt -> Ptr Word8 -> Int -> CInt -> IO CInt - -foreign import ccall unsafe "__hscore_PrelHandle_write" - write_off :: CInt -> Ptr Word8 -> Int -> CInt -> IO CInt - foreign import ccall unsafe "fdReady" unsafe_fdReady :: CInt -> CInt -> CInt -> CInt -> IO CInt #else /* mingw32_HOST_OS.... */ -readRawBufferPtr :: String -> FD -> Ptr Word8 -> Int -> CInt -> IO CInt +readRawBufferPtr :: String -> FD -> Ptr Word8 -> Int -> CSize -> IO CInt readRawBufferPtr loc !fd buf off len | threaded = blockingReadRawBufferPtr loc fd buf off len | otherwise = asyncReadRawBufferPtr loc fd buf off len -writeRawBufferPtr :: String -> FD -> Ptr Word8 -> Int -> CInt -> IO CInt +writeRawBufferPtr :: String -> FD -> Ptr Word8 -> Int -> CSize -> IO CInt writeRawBufferPtr loc !fd buf off len | threaded = blockingWriteRawBufferPtr loc fd buf off len | otherwise = asyncWriteRawBufferPtr loc fd buf off len -readRawBufferPtrNoBlock :: String -> FD -> Ptr Word8 -> Int -> CInt -> IO CInt +readRawBufferPtrNoBlock :: String -> FD -> Ptr Word8 -> Int -> CSize -> IO CInt readRawBufferPtrNoBlock = readRawBufferPtr -writeRawBufferPtrNoBlock :: String -> FD -> Ptr Word8 -> Int -> CInt -> IO CInt +writeRawBufferPtrNoBlock :: String -> FD -> Ptr Word8 -> Int -> CSize -> IO CInt writeRawBufferPtrNoBlock = writeRawBufferPtr -- Async versions of the read/write primitives, for the non-threaded RTS -asyncReadRawBufferPtr :: String -> FD -> Ptr Word8 -> Int -> CInt -> IO CInt +asyncReadRawBufferPtr :: String -> FD -> Ptr Word8 -> Int -> CSize -> IO CInt asyncReadRawBufferPtr loc !fd buf off len = do (l, rc) <- asyncRead (fromIntegral (fdFD fd)) (fdIsSocket_ fd) (fromIntegral len) (buf `plusPtr` off) @@ -549,7 +545,7 @@ asyncReadRawBufferPtr loc !fd buf off len = do ioError (errnoToIOError loc (Errno (fromIntegral rc)) Nothing Nothing) else return (fromIntegral l) -asyncWriteRawBufferPtr :: String -> FD -> Ptr Word8 -> Int -> CInt -> IO CInt +asyncWriteRawBufferPtr :: String -> FD -> Ptr Word8 -> Int -> CSize -> IO CInt asyncWriteRawBufferPtr loc !fd buf off len = do (l, rc) <- asyncWrite (fromIntegral (fdFD fd)) (fdIsSocket_ fd) (fromIntegral len) (buf `plusPtr` off) @@ -560,48 +556,42 @@ asyncWriteRawBufferPtr loc !fd buf off len = do -- Blocking versions of the read/write primitives, for the threaded RTS -blockingReadRawBufferPtr :: String -> FD -> Ptr Word8 -> Int -> CInt -> IO CInt +blockingReadRawBufferPtr :: String -> FD -> Ptr Word8 -> Int -> CSize -> IO CInt blockingReadRawBufferPtr loc fd buf off len - = throwErrnoIfMinus1Retry loc $ + = fmap fromIntegral $ throwErrnoIfMinus1Retry loc $ if fdIsSocket fd - then safe_recv_off (fdFD fd) buf off len - else safe_read_off (fdFD fd) buf off len + then c_safe_recv (fdFD fd) (buf `plusPtr` off) len 0 + else c_safe_read (fdFD fd) (buf `plusPtr` off) len -blockingWriteRawBufferPtr :: String -> FD -> Ptr Word8-> Int -> CInt -> IO CInt +blockingWriteRawBufferPtr :: String -> FD -> Ptr Word8-> Int -> CSize -> IO CInt blockingWriteRawBufferPtr loc fd buf off len - = throwErrnoIfMinus1Retry loc $ + = fmap fromIntegral $ throwErrnoIfMinus1Retry loc $ if fdIsSocket fd - then safe_send_off (fdFD fd) buf off len - else safe_write_off (fdFD fd) buf off len + then c_safe_send (fdFD fd) (buf `plusPtr` off) len 0 + else c_safe_write (fdFD fd) (buf `plusPtr` off) len -- NOTE: "safe" versions of the read/write calls for use by the threaded RTS. -- These calls may block, but that's ok. -foreign import ccall safe "__hscore_PrelHandle_recv" - safe_recv_off :: CInt -> Ptr Word8 -> Int -> CInt -> IO CInt +foreign import stdcall safe "recv" + c_safe_recv :: CInt -> Ptr Word8 -> CSize -> CInt{-flags-} -> IO CSsize -foreign import ccall safe "__hscore_PrelHandle_send" - safe_send_off :: CInt -> Ptr Word8 -> Int -> CInt -> IO CInt +foreign import stdcall safe "send" + c_safe_send :: CInt -> Ptr Word8 -> CSize -> CInt{-flags-} -> IO CSsize #endif foreign import ccall "rtsSupportsBoundThreads" threaded :: Bool -foreign import ccall safe "__hscore_PrelHandle_read" - safe_read_off :: CInt -> Ptr Word8 -> Int -> CInt -> IO CInt - -foreign import ccall safe "__hscore_PrelHandle_write" - safe_write_off :: CInt -> Ptr Word8 -> Int -> CInt -> IO CInt - -- ----------------------------------------------------------------------------- -- utils #ifndef mingw32_HOST_OS -throwErrnoIfMinus1RetryOnBlock :: String -> IO CInt -> IO CInt -> IO CInt +throwErrnoIfMinus1RetryOnBlock :: String -> IO CSsize -> IO CSsize -> IO CSsize throwErrnoIfMinus1RetryOnBlock loc f on_block = do res <- f - if (res :: CInt) == -1 + if (res :: CSsize) == -1 then do err <- getErrno if err == eINTR diff --git a/libraries/base/System/Posix/Internals.hs b/libraries/base/System/Posix/Internals.hs index ac80574440..8916059e93 100644 --- a/libraries/base/System/Posix/Internals.hs +++ b/libraries/base/System/Posix/Internals.hs @@ -400,7 +400,10 @@ foreign import ccall unsafe "HsBase.h __hscore_mkdir" mkdir :: CString -> CInt -> IO CInt foreign import ccall unsafe "HsBase.h read" - c_read :: CInt -> Ptr CChar -> CSize -> IO CSsize + c_read :: CInt -> Ptr Word8 -> CSize -> IO CSsize + +foreign import ccall safe "read" + c_safe_read :: CInt -> Ptr Word8 -> CSize -> IO CSsize foreign import ccall unsafe "HsBase.h rewinddir" c_rewinddir :: Ptr CDir -> IO () @@ -412,7 +415,10 @@ foreign import ccall unsafe "HsBase.h umask" c_umask :: CMode -> IO CMode foreign import ccall unsafe "HsBase.h write" - c_write :: CInt -> Ptr CChar -> CSize -> IO CSsize + c_write :: CInt -> Ptr Word8 -> CSize -> IO CSsize + +foreign import ccall safe "write" + c_safe_write :: CInt -> Ptr Word8 -> CSize -> IO CSsize foreign import ccall unsafe "HsBase.h __hscore_ftruncate" c_ftruncate :: CInt -> COff -> IO CInt diff --git a/libraries/base/include/HsBase.h b/libraries/base/include/HsBase.h index ccabc1e1f9..92cc4e34fe 100644 --- a/libraries/base/include/HsBase.h +++ b/libraries/base/include/HsBase.h @@ -417,33 +417,6 @@ __hscore_setmode( int fd, HsBool toBin ) #if __GLASGOW_HASKELL__ -INLINE int -__hscore_PrelHandle_write( int fd, void *ptr, HsInt off, int sz ) -{ - return write(fd,(char *)ptr + off, sz); -} - -INLINE int -__hscore_PrelHandle_read( int fd, void *ptr, HsInt off, int sz ) -{ - return read(fd,(char *)ptr + off, sz); - -} - -#if defined(_MSC_VER) || defined(__MINGW32__) || defined(_WIN32) -INLINE int -__hscore_PrelHandle_send( int fd, void *ptr, HsInt off, int sz ) -{ - return send(fd,(char *)ptr + off, sz, 0); -} - -INLINE int -__hscore_PrelHandle_recv( int fd, void *ptr, HsInt off, int sz ) -{ - return recv(fd,(char *)ptr + off, sz, 0); -} -#endif - #endif /* __GLASGOW_HASKELL__ */ INLINE int |