summary |
shortlog |
log |
commit | commitdiff |
tree
raw |
patch |
inline | side by side (from parent 1:
fc3a5e1)
Re-integrated mod. that seems to have been dropped on the
floor when new-rts moved back onto the main trunk. Here's
the commit msg. that was originally used:
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 a
write to h2 causes h2's buffer to overflow or not.
This is used to connect 'stderr' and 'stdout', i.e., output on
'stderr' will now cause 'stdout' output to (first) be flushed.
hPutChar handle c =
wantWriteableHandle "hPutChar" handle $ \ handle_ -> do
let fo = haFO__ handle_
hPutChar handle c =
wantWriteableHandle "hPutChar" handle $ \ handle_ -> do
let fo = haFO__ handle_
rc <- mayBlock fo (CCALL(filePutc) fo c) -- ConcHask: UNSAFE, may block.
writeHandle handle handle_
if rc == 0
rc <- mayBlock fo (CCALL(filePutc) fo c) -- ConcHask: UNSAFE, may block.
writeHandle handle handle_
if rc == 0
hPutStr handle str =
wantWriteableHandle "hPutStr" handle $ \ handle_ -> do
let fo = haFO__ handle_
hPutStr handle str =
wantWriteableHandle "hPutStr" handle $ \ handle_ -> do
let fo = haFO__ handle_
case haBufferMode__ handle_ of
LineBuffering -> do
buf <- CCALL(getWriteableBuf) fo
case haBufferMode__ handle_ of
LineBuffering -> do
buf <- CCALL(getWriteableBuf) fo
fo <- makeForeignObj fo
addForeignFinaliser fo (freeStdFileObject fo)
#endif
fo <- makeForeignObj fo
addForeignFinaliser fo (freeStdFileObject fo)
#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 to
+ -- stderr.
+ hConnectTo stdout hdl
+ return hdl
+
_ -> do ioError <- constructError "stderr"
newHandle (mkErrorHandle__ ioError)
)
_ -> do ioError <- constructError "stderr"
newHandle (mkErrorHandle__ ioError)
)
hConnectHdl_ :: Handle -> Handle -> Int -> IO ()
hConnectHdl_ hW hR is_tty =
hConnectHdl_ :: Handle -> Handle -> Int -> IO ()
hConnectHdl_ hW hR is_tty =
- wantWriteableHandle "hConnectTo" hW $ \ hW_ -> do
- wantReadableHandle "hConnectTo" hR $ \ hR_ -> do
+ wantRWHandle "hConnectTo" hW $ \ hW_ -> do
+ wantRWHandle "hConnectTo" hR $ \ hR_ -> do
CCALL(setConnectedTo) (haFO__ hR_) (haFO__ hW_) is_tty -- ConcHask: SAFE, won't block
writeHandle hR hR_
writeHandle hW hW_
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
+
+flushConnectedBuf :: FILE_OBJECT -> IO ()
+flushConnectedBuf fo = CCALL(flushConnectedBuf) fo
\end{code}
As an extension, we also allow characters to be pushed back.
\end{code}
As an extension, we also allow characters to be pushed back.
IOError (Just handle) IllegalOperation fun
("handle is not open for writing")
IOError (Just handle) IllegalOperation fun
("handle is not open for writing")
+wantRWHandle :: String -> Handle -> (Handle__ -> IO a) -> IO a
+wantRWHandle fun handle act =
+ withHandle handle $ \ handle_ -> do
+ case haType__ handle_ of
+ ErrorHandle theError -> do
+ writeHandle handle handle_
+ ioError theError
+ ClosedHandle -> do
+ writeHandle handle handle_
+ ioe_closedHandle fun handle
+ SemiClosedHandle -> do
+ writeHandle handle handle_
+ ioe_closedHandle fun handle
+ _ -> act handle_
+ where
+ not_rw_error =
+ IOError (Just handle) IllegalOperation fun
+ ("handle is not open for reading or writing")
+
wantSeekableHandle :: String -> Handle -> (Handle__ -> IO a) -> IO a
wantSeekableHandle fun handle act =
withHandle handle $ \ handle_ -> do
wantSeekableHandle :: String -> Handle -> (Handle__ -> IO a) -> IO a
wantSeekableHandle fun handle act =
withHandle handle $ \ handle_ -> do
foreign import ccall "libHS_cbits.so" "getBufWPtr" unsafe prim_getBufWPtr :: FILE_OBJ -> IO Int
foreign import ccall "libHS_cbits.so" "setBufWPtr" unsafe prim_setBufWPtr :: FILE_OBJ -> Int -> IO ()
foreign import ccall "libHS_cbits.so" "closeFile" unsafe prim_closeFile :: FILE_OBJ -> Flush -> IO RC
foreign import ccall "libHS_cbits.so" "getBufWPtr" unsafe prim_getBufWPtr :: FILE_OBJ -> IO Int
foreign import ccall "libHS_cbits.so" "setBufWPtr" unsafe prim_setBufWPtr :: FILE_OBJ -> Int -> IO ()
foreign import ccall "libHS_cbits.so" "closeFile" unsafe prim_closeFile :: FILE_OBJ -> Flush -> IO RC
-foreign import ccall "libHS_cbits.so" "fileEOF" unsafe prim_fileEOF :: FILE_OBJ -> IO RC
-foreign import ccall "libHS_cbits.so" "setBuffering" unsafe prim_setBuffering :: FILE_OBJ -> Int -> IO RC
-foreign import ccall "libHS_cbits.so" "flushFile" unsafe prim_flushFile :: FILE_OBJ -> IO RC
-foreign import ccall "libHS_cbits.so" "getBufferMode" unsafe prim_getBufferMode :: FILE_OBJ -> IO RC
-foreign import ccall "libHS_cbits.so" "seekFile_int64" unsafe prim_seekFile_int64 :: FILE_OBJ -> Int -> Int64 -> IO RC
+foreign import ccall "libHS_cbits.so" "fileEOF" unsafe prim_fileEOF :: FILE_OBJ -> IO RC
+foreign import ccall "libHS_cbits.so" "setBuffering" unsafe prim_setBuffering :: FILE_OBJ -> Int -> IO RC
+foreign import ccall "libHS_cbits.so" "flushFile" unsafe prim_flushFile :: FILE_OBJ -> IO RC
+foreign import ccall "libHS_cbits.so" "flushConnectedBuf" unsafe prim_flushConnectedBuf :: FILE_OBJ -> IO RC
+foreign import ccall "libHS_cbits.so" "getBufferMode" unsafe prim_getBufferMode :: FILE_OBJ -> IO RC
+foreign import ccall "libHS_cbits.so" "seekFile_int64" unsafe prim_seekFile_int64 :: FILE_OBJ -> Int -> Int64 -> IO RC
foreign import ccall "libHS_cbits.so" "seekFileP" unsafe prim_seekFileP :: FILE_OBJ -> IO RC
foreign import ccall "libHS_cbits.so" "setTerminalEcho" unsafe prim_setTerminalEcho :: FILE_OBJ -> Int -> IO RC
foreign import ccall "libHS_cbits.so" "getTerminalEcho" unsafe prim_getTerminalEcho :: FILE_OBJ -> IO RC
foreign import ccall "libHS_cbits.so" "seekFileP" unsafe prim_seekFileP :: FILE_OBJ -> IO RC
foreign import ccall "libHS_cbits.so" "setTerminalEcho" unsafe prim_setTerminalEcho :: FILE_OBJ -> Int -> IO RC
foreign import ccall "libHS_cbits.so" "getTerminalEcho" unsafe prim_getTerminalEcho :: FILE_OBJ -> IO RC
/*
* (c) The GRASP/AQUA Project, Glasgow University, 1994-1998
*
/*
* (c) The GRASP/AQUA Project, Glasgow University, 1994-1998
*
- * $Id: flushFile.c,v 1.3 1998/12/02 13:27:32 simonm Exp $
+ * $Id: flushFile.c,v 1.4 1999/01/15 17:54:23 sof Exp $
*
* hFlush Runtime Support
*/
*
* hFlush Runtime Support
*/
fo->bufWPtr=0;
return 0;
}
fo->bufWPtr=0;
return 0;
}
+
+void
+flushConnectedBuf(ptr)
+StgForeignPtr ptr;
+{
+ StgInt rc;
+ IOFileObject* fo = (IOFileObject*)ptr;
+
+ /* if the stream is connected to an output stream, flush it. */
+ if ( fo->connectedTo != NULL && fo->connectedTo->fd != -1 &&
+ (fo->connectedTo->flags & FILEOBJ_WRITE) ) {
+ rc = flushBuffer((StgForeignPtr)fo->connectedTo);
+ }
+ /* Willfully ignore the return code for now. */
+ return;
+}
+
+
/*
* (c) The GRASP/AQUA Project, Glasgow University, 1994-1998
*
/*
* (c) The GRASP/AQUA Project, Glasgow University, 1994-1998
*
- * $Id: stgio.h,v 1.8 1998/12/02 13:27:58 simonm Exp $
+ * $Id: stgio.h,v 1.9 1999/01/15 17:54:23 sof Exp $
*
* Helper code for GHC's IO subsystem.
*/
*
* Helper code for GHC's IO subsystem.
*/
StgInt flushFile (StgForeignPtr);
StgInt flushBuffer (StgForeignPtr);
StgInt flushReadBuffer (StgForeignPtr);
StgInt flushFile (StgForeignPtr);
StgInt flushBuffer (StgForeignPtr);
StgInt flushReadBuffer (StgForeignPtr);
+void flushConnectedBuf (StgForeignPtr);
/* freeFile.c */
void freeStdFile (StgForeignPtr);
/* freeFile.c */
void freeStdFile (StgForeignPtr);