[project @ 2001-12-03 20:59:08 by sof]

Support IO.hWaitForInput on Win32 platforms (on file and socket handles).

diff --git a/ghc/lib/std/PrelIO.hs b/ghc/lib/std/PrelIO.hs
index 6c2e612..5cf8746 100644 (file)
--- a/ghc/lib/std/PrelIO.hs
+++ b/ghc/lib/std/PrelIO.hs
@@ -3,7 +3,7 @@
 #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
 --
@@ -135,11 +135,11 @@ hWaitForInput h msecs = do
        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

diff --git a/ghc/lib/std/cbits/HsStd.h b/ghc/lib/std/cbits/HsStd.h
index 8957189..39d6ca2 100644 (file)
--- a/ghc/lib/std/cbits/HsStd.h
+++ b/ghc/lib/std/cbits/HsStd.h
@@ -1,5 +1,5 @@
 /* -----------------------------------------------------------------------------
- * $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.
  *
@@ -91,7 +91,7 @@ int *ghcErrno(void);
 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);

diff --git a/ghc/lib/std/cbits/inputReady.c b/ghc/lib/std/cbits/inputReady.c
index 69737c5..bf86afb 100644 (file)
--- a/ghc/lib/std/cbits/inputReady.c
+++ b/ghc/lib/std/cbits/inputReady.c
@@ -1,7 +1,7 @@
 /* 
  * (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
  */
@@ -16,17 +16,17 @@
  * *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);
 
@@ -45,6 +45,21 @@ inputReady(int fd, int msecs)
 
     /* 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
 }