-- else, we have to flush
else do flushed_buf <- flushWriteBuffer fd is_stream old_buf
+ -- TODO: we should do a non-blocking flush here
writeIORef ref flushed_buf
-- if we can fit in the buffer, then just loop
if count < size
seq fd $ seq so_far $ seq count $ do -- strictness hack
buf@Buffer{ bufBuf=raw, bufWPtr=w, bufRPtr=r, bufSize=sz } <- readIORef ref
if bufferEmpty buf
- then if count < sz
+ then if so_far > 0 then return so_far else
+ if count < sz
then do
mb_buf <- maybeFillReadBuffer fd (not can_block) is_stream buf
case mb_buf of
return (chunk, r)
-- ---------------------------------------------------------------------------
+-- pipes
+
+{-|
+(@createPipe@) creates an anonymous /pipe/ and returns a pair of
+handles, the first for reading and the second for writing. Both
+pipe ends can be inherited by a child process.
+
+> createPipe = createPipeEx (BinaryMode AppendMode)
+-}
+createPipe :: IO (Handle,Handle)
+createPipe = createPipeEx AppendMode
+
+{-|
+(@createPipeEx modeEx@) creates an anonymous /pipe/ and returns a pair of
+handles, the first for reading and the second for writing.
+The pipe mode @modeEx@ can be:
+
+ * @'TextMode' mode@ -- the pipe is opened in text mode.
+
+ * @'BinaryMode' mode@ -- the pipe is opened in binary mode.
+
+The @mode@ determines if child processes can inherit the pipe handles:
+
+ * 'ReadMode' -- The /read/ handle of the pipe is private to this process.
+
+ * 'WriteMode' -- The /write/ handle of the pipe is private to this process.
+
+ * 'ReadWriteMode' -- Both handles are private to this process.
+
+ * 'AppendMode' -- Both handles are available (inheritable) to child processes.
+ This mode can be used to /append/ (|) two seperate child processes.
+
+If a broken pipe is read, an end-of-file ('GHC.IOBase.EOF')
+exception is raised. If a broken pipe is written to, an invalid argument exception
+is raised ('GHC.IOBase.InvalidArgument').
+-}
+createPipeEx :: IOMode -> IO (Handle,Handle)
+createPipeEx mode = do
+#if 1
+ return (error "createPipeEx")
+#else
+
+#ifndef mingw32_TARGET_OS
+ -- ignore modeEx for Unix: just always inherit the descriptors
+ allocaArray 2 $ \p -> do
+ throwErrnoIfMinus1 "createPipe" (c_pipe p)
+ r <- peekElemOff p 0
+ hr <- openFd (fromIntegral r) (Just Stream) ("<fd="++show r++")>") ReadMode
+ False{-text mode-} False{-don't truncate-}
+ w <- peekElemOff p 1
+ hw <- openFd (fromIntegral w) (Just Stream) ("<fd="++show r++")>") WriteMode
+ False{-text mode-} False{-don't truncate-}
+ return (hr,hw)
+#else
+
+ alloca $ \pFdRead ->
+ alloca $ \pFdWrite ->
+ do{ r <- winCreatePipe (fromIntegral textmode) (fromIntegral inherit) 4096 pFdRead pFdWrite
+ ; when (r/=0) (ioError (userError ("unable to create pipe")))
+ ; fdRead <- do{ fd <- peek pFdRead
+ ; case mode of
+ WriteMode -> inheritFd fd -- a child process must be able to read from it
+ other -> return fd
+ }
+ ; fdWrite <- do{ fd <- peek pFdWrite
+ ; case mode of
+ ReadMode -> inheritFd fd -- a child process must be able to write to it
+ other -> return fd
+ }
+ ; hRead <- openFd (fromIntegral fd) (Just Stream)
+ "<pipe(read)>" ReadMode textmode False
+ ; hWrite <- openFd (fromIntegral fd) (Just Stream)
+ "<pipe(write)>" WriteMode textmode False
+ ; return (hRead,hWrite)
+ }
+ where
+ (mode,textmode) = case modeEx of
+ TextMode mode -> (mode,1::Int)
+ BinaryMode mode -> (mode,0::Int)
+
+ inherit :: Int
+ inherit = case mode of
+ ReadMode -> 0 -- not inheritable
+ WriteMode -> 0 -- not inheritable
+ ReadWriteMode -> 0 -- not inheritable
+ AppendMode -> 1 -- both inheritable
+
+inheritFd :: CInt -> IO CInt
+inheritFd fd0
+ = do{ fd1 <- c_dup fd0 -- dup() makes a file descriptor inheritable
+ ; c_close fd0
+ ; return fd1
+ }
+#endif
+#endif /* mingw32_TARGET_OS */
+
+-- ---------------------------------------------------------------------------
-- memcpy wrappers
foreign import ccall unsafe "__hscore_memcpy_src_off"