Support IO.hWaitForInput on Win32 platforms (on file and socket handles).
#undef DEBUG_DUMP
-- -----------------------------------------------------------------------------
--- $Id: PrelIO.hs,v 1.4 2001/11/26 20:04:00 sof Exp $
+-- $Id: PrelIO.hs,v 1.5 2001/12/03 20:59:08 sof Exp $
--
-- (c) The University of Glasgow, 1992-2001
--
else do
r <- throwErrnoIfMinus1Retry "hReady"
- (inputReady (fromIntegral (haFD handle_)) (fromIntegral msecs))
+ (inputReady (fromIntegral (haFD handle_)) (fromIntegral msecs) (haIsStream handle_))
return (r /= 0)
foreign import "inputReady" unsafe
- inputReady :: CInt -> CInt -> IO CInt
+ inputReady :: CInt -> CInt -> Bool -> IO CInt
-- ---------------------------------------------------------------------------
-- hGetChar
/* -----------------------------------------------------------------------------
- * $Id: HsStd.h,v 1.5 2001/11/26 20:04:00 sof Exp $
+ * $Id: HsStd.h,v 1.6 2001/12/03 20:59:08 sof Exp $
*
* Definitions for package `std' which are visible in Haskell land.
*
HsInt systemCmd(HsAddr cmd);
/* in inputReady.c */
-int inputReady(int fd, int msecs);
+int inputReady(int fd, int msecs, int isSock);
/* in progargs.c */
HsAddr get_prog_argv(void);
/*
* (c) The GRASP/AQUA Project, Glasgow University, 1994-1998
*
- * $Id: inputReady.c,v 1.9 2001/08/14 13:40:08 sewardj Exp $
+ * $Id: inputReady.c,v 1.10 2001/12/03 20:59:08 sof Exp $
*
* hReady Runtime Support
*/
* *character* from this file object without blocking?'
*/
int
-inputReady(int fd, int msecs)
+inputReady(int fd, int msecs, int isSock)
{
+ if
#ifndef mingw32_TARGET_OS
+ ( 1 ) {
+#else
+ ( isSock ) {
int maxfd, ready;
fd_set rfd;
struct timeval tv;
-#endif
-#ifdef mingw32_TARGET_OS
- return 1;
-#else
FD_ZERO(&rfd);
FD_SET(fd, &rfd);
/* 1 => Input ready, 0 => not ready, -1 => error */
return (ready);
-
+#endif
+#ifdef mingw32_TARGET_OS
+ } else {
+ DWORD rc;
+ HANDLE hFile = (HANDLE)_get_osfhandle(fd);
+
+ rc = WaitForSingleObject( hFile,
+ msecs /*millisecs*/);
+
+ /* 1 => Input ready, 0 => not ready, -1 => error */
+ switch (rc) {
+ case WAIT_TIMEOUT: return 0;
+ case WAIT_OBJECT_0: return 1;
+ default: return -1;
+ }
+ }
#endif
}