wantWritableHandle, wantReadableHandle, wantSeekableHandle,
newEmptyBuffer, allocateBuffer, readCharFromBuffer, writeCharIntoBuffer,
- flushWriteBufferOnly, flushWriteBuffer, flushReadBuffer, fillReadBuffer,
+ flushWriteBufferOnly, flushWriteBuffer, flushReadBuffer,
+ fillReadBuffer, fillReadBufferWithoutBlocking,
readRawBuffer, readRawBufferPtr,
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,
return buf{ bufWPtr=0, bufRPtr=0 }
flushWriteBuffer :: FD -> Bool -> Buffer -> IO Buffer
-flushWriteBuffer fd is_stream buf@Buffer{ bufBuf=b, bufRPtr=r, bufWPtr=w } = do
+flushWriteBuffer fd is_stream buf@Buffer{ bufBuf=b, bufRPtr=r, bufWPtr=w } =
+ seq fd $ do -- strictness hack
let bytes = w - r
#ifdef DEBUG_DUMP
puts ("flushWriteBuffer, fd=" ++ show fd ++ ", bytes=" ++ show bytes ++ "\n")
else return buf{ bufRPtr=0, bufWPtr=w+res' }
+fillReadBufferWithoutBlocking :: FD -> Bool -> Buffer -> IO Buffer
+fillReadBufferWithoutBlocking fd is_stream
+ buf@Buffer{ bufBuf=b, bufRPtr=r, bufWPtr=w, bufSize=size } =
+ -- buffer better be empty:
+ assert (r == 0 && w == 0) $ do
+#ifdef DEBUG_DUMP
+ puts ("fillReadBufferLoopNoBlock: bytes = " ++ show bytes ++ "\n")
+#endif
+ res <- readRawBufferNoBlock "fillReadBuffer" fd is_stream b
+ 0 (fromIntegral size)
+ let res' = fromIntegral res
+#ifdef DEBUG_DUMP
+ puts ("fillReadBufferLoopNoBlock: res' = " ++ show res' ++ "\n")
+#endif
+ return buf{ bufRPtr=0, bufWPtr=res' }
+
-- Low level routines for reading/writing to (raw)buffers:
#ifndef mingw32_TARGET_OS
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 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
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)
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
-- ---------------------------------------------------------------------------
-- Some operating systems delete empty files, so there is no guarantee
-- that the file will exist following an 'openFile' with @mode@
-- 'WriteMode' unless it is subsequently written to successfully.
--- The handle is positioned at the end of the file if `mode' is
--- `AppendMode', and otherwise at the beginning (in which case its
+-- The handle is positioned at the end of the file if @mode@ is
+-- 'AppendMode', and otherwise at the beginning (in which case its
-- internal position is 0).
-- The initial buffer mode is implementation-dependent.
--
-- ---------------------------------------------------------------------------
-- Looking ahead
--- | Computation 'hLookahead' returns the next character from the handle
+-- | Computation 'hLookAhead' returns the next character from the handle
-- without removing it from the input buffer, blocking until a character
-- is available.
--
-- further explanation of what the type represent.
-- | Computation 'hSetBuffering' @hdl mode@ sets the mode of buffering for
--- handle hdl on subsequent reads and writes.
+-- handle @hdl@ on subsequent reads and writes.
--
-- If the buffer mode is changed from 'BlockBuffering' or
-- 'LineBuffering' to 'NoBuffering', then
-- hFlush
-- | The action 'hFlush' @hdl@ causes any items buffered for output
--- in handle `hdl' to be sent immediately to the operating system.
+-- in handle @hdl@ to be sent immediately to the operating system.
--
-- This operation may fail with:
--
#endif
-- -----------------------------------------------------------------------------
+-- utils
+
+throwErrnoIfMinus1RetryOnBlock :: String -> IO CInt -> IO CInt -> IO CInt
+throwErrnoIfMinus1RetryOnBlock loc f on_block =
+ do
+ res <- f
+ if (res :: CInt) == -1
+ then do
+ err <- getErrno
+ if err == eINTR
+ then throwErrnoIfMinus1RetryOnBlock loc f on_block
+ else if err == eWOULDBLOCK || err == eAGAIN
+ then do on_block
+ else throwErrno loc
+ else return res
+
+-- -----------------------------------------------------------------------------
-- wrappers to platform-specific constants:
foreign import ccall unsafe "__hscore_supportsTextMode"
projects / haskell-directory.git / blobdiff