Commit bbe9c555 authored by sof's avatar sof
Browse files

[project @ 1998-11-23 15:44:21 by sof]

Extend hConnectTo to also allow output handles to be connected, i.e.,

    h1 <- openFile "foo" WriteMode
    h2 <- openFile "bar" WriteMode
    hConnectTo h1 h2

  will cause h1's buffer to be flushed when h2's buffer overflows
  (and it is just about to be flushed.) The implementation is currently
  not as lazy as that, it flushes h1's buffer regardless of whether h2's
  buffer overflows or not.

  This is used to connect 'stderr' and 'stdout', i.e., output on
  'stderr' will now cause 'stdout' output to (first) be flushed.
parent 9a13d5c8
......@@ -329,6 +329,7 @@ hPutChar :: Handle -> Char -> IO ()
hPutChar handle c = do
handle_ <- wantWriteableHandle "hPutChar" handle
let fo = haFO__ handle_
flushConnectedHandle fo
rc <- mayBlock fo (_ccall_ filePutc fo c) -- ConcHask: UNSAFE, may block.
writeHandle handle handle_
if rc == 0
......@@ -345,6 +346,7 @@ hPutStr :: Handle -> String -> IO ()
hPutStr handle str = do
handle_ <- wantWriteableHandle "hPutStr" handle
let fo = haFO__ handle_
flushConnectedHandle fo
case haBufferMode__ handle_ of
LineBuffering -> do
buf <- _ccall_ getWriteableBuf fo
......
......@@ -150,7 +150,12 @@ stderr = unsafePerformIO (do
#ifndef __PARALLEL_HASKELL__
fo <- makeForeignObj fo (``&freeStdFileObject''::Addr)
#endif
newHandle (Handle__ fo WriteHandle NoBuffering "stderr")
hdl <- newHandle (Handle__ fo WriteHandle NoBuffering "stderr")
-- when stderr and stdout are both connected to a terminal, ensure
-- that anything buffered on stdout is flushed prior to writing on stderr.
--
hConnectTo stdout hdl
return hdl
_ -> do ioError <- constructError "stderr"
newHandle (mkErrorHandle__ ioError)
)
......@@ -774,12 +779,20 @@ hConnectTo hW hR = hConnectHdl_ hW hR 0{-connect regardless-}
hConnectHdl_ :: Handle -> Handle -> Int -> IO ()
hConnectHdl_ hW hR is_tty = do
hW_ <- wantWriteableHandle "hConnectTo" hW
hR_ <- wantReadableHandle "hConnectTo" hR
hW_ <- wantRWHandle "hConnectTo" hW
hR_ <- wantRWHandle "hConnectTo" hR
_ccall_ setConnectedTo (haFO__ hR_) (haFO__ hW_) is_tty -- ConcHask: SAFE, won't block
writeHandle hR hR_
writeHandle hW hW_
#ifndef __PARALLEL_HASKELL__
#define FILE_OBJECT ForeignObj
#else
#define FILE_OBJECT Addr
#endif
flushConnectedHandle :: FILE_OBJECT -> IO ()
flushConnectedHandle fo = _ccall_ flushConnectedHandle fo
\end{code}
As an extension, we also allow characters to be pushed back.
......@@ -985,6 +998,26 @@ wantWriteableHandle fun handle = do
IOError (Just handle) IllegalOperation fun
("handle is not open for writing")
-- either R or W.
wantRWHandle :: String -> Handle -> IO Handle__
wantRWHandle fun handle = do
handle_ <- readHandle handle
case haType__ handle_ of
ErrorHandle ioError -> do
writeHandle handle handle_
fail ioError
ClosedHandle -> do
writeHandle handle handle_
ioe_closedHandle fun handle
SemiClosedHandle -> do
writeHandle handle handle_
ioe_closedHandle fun handle
other -> return handle_
where
not_readable_error =
IOError (Just handle) IllegalOperation fun
("handle is not open for reading or writing")
wantSeekableHandle :: String -> Handle -> IO Handle__
wantSeekableHandle fun handle = do
handle_ <- readHandle handle
......
......@@ -49,7 +49,7 @@ StgChar c;
fo->flags = (fo->flags & ~FILEOBJ_RW_READ) | FILEOBJ_RW_WRITE;
/* check whether we can just add it to the buffer.. */
/* check whether we can just add it to the buffer.. */
if ( FILEOBJ_UNBUFFERED(fo) ) {
;
} else {
......
......@@ -80,8 +80,21 @@ StgForeignObj ptr;
return 0;
}
\end{code}
void
flushConnectedHandle(ptr)
StgForeignObj ptr;
{
StgInt rc;
IOFileObject* fo = (IOFileObject*)ptr;
/* if the stream is connected to an output stream, flush it first */
if ( fo->connectedTo != NULL && fo->connectedTo->fd != -1 &&
(fo->connectedTo->flags & FILEOBJ_WRITE) ) {
rc = flushBuffer((StgForeignObj)fo->connectedTo);
}
/* Willfully ignore return code for now */
return;
}
\end{code}
......@@ -90,6 +90,7 @@ StgInt fileSize PROTO((StgForeignObj, StgByteArray));
StgInt flushFile PROTO((StgForeignObj));
StgInt flushBuffer PROTO((StgForeignObj));
StgInt flushReadBuffer PROTO((StgForeignObj));
void flushConnectedHandle PROTO((StgForeignObj));
/* freeFile.lc */
void freeStdFile PROTO((StgForeignObj));
......
......@@ -76,6 +76,7 @@ StgInt len;
if (len == 0 )
return 0;
/* First of all, check if we do need to flush the buffer .. */
/* Note - in the case of line buffering, we do not currently check
whether we need to flush buffer due to line terminators in the
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment