X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Flib%2Fstd%2FPrelHandle.lhs;h=a1faf9932c50d1565a73fb3f64a41bde88d8a39b;hb=382ca27d7b1e33640b9dab670bfbf3f32bb3f4cf;hp=5e32122c47c09779fd6f41ac28951439a8d5cbe3;hpb=d3aa7046cf134bf972551dbfd8ae561a0dbc07bc;p=ghc-hetmet.git

diff --git a/ghc/lib/std/PrelHandle.lhs b/ghc/lib/std/PrelHandle.lhs
index 5e32122..a1faf99 100644
--- a/ghc/lib/std/PrelHandle.lhs
+++ b/ghc/lib/std/PrelHandle.lhs
@@ -9,26 +9,29 @@ which are supported for them.
 
 \begin{code}
 {-# OPTIONS -fno-implicit-prelude -#include "cbits/stgio.h" #-}
-#include "cbits/error.h"
+#include "cbits/stgerror.h"
 
 #ifndef __HUGS__ /* Hugs just includes this in PreludeBuiltin so no header needed */
 module PrelHandle where
 
 import PrelBase
 import PrelAddr		( Addr, nullAddr )
-import PrelArr		( newVar, readVar, writeVar, ByteArray(..) )
+import PrelArr		( newVar, readVar, writeVar )
+import PrelByteArr	( ByteArray(..) )
 import PrelRead		( Read )
 import PrelList 	( span )
 import PrelIOBase
 import PrelException
 import PrelMaybe	( Maybe(..) )
 import PrelEnum
-import PrelNum
+import PrelNum		( toBig, Integer(..), Num(..) )
 import PrelShow
 import PrelAddr		( Addr, nullAddr )
-import PrelNum		( toInteger, toBig )
+import PrelReal		( toInteger )
 import PrelPack         ( packString )
+#ifndef __PARALLEL_HASKELL__
 import PrelWeak		( addForeignFinalizer )
+#endif
 import Ix
 
 #ifdef __CONCURRENT_HASKELL__
@@ -434,10 +437,8 @@ the file.  Otherwise, it returns @False@.
 
 \begin{code}
 hIsEOF :: Handle -> IO Bool
-hIsEOF handle =
-    wantReadableHandle "hIsEOF" handle $ \ handle_ -> do
-    let fo = haFO__ handle_
-    rc      <- mayBlock fo (fileEOF fo)  -- ConcHask: UNSAFE, may block
+hIsEOF handle = do
+    rc <- mayBlockRead "hIsEOF" handle fileEOF
     case rc of
       0 -> return False
       1 -> return True
@@ -902,12 +903,7 @@ hFillBufBA handle buf sz
 		            "hFillBufBA"
 			    ("illegal buffer size " ++ showsPrec 9 sz []))  -- 9 => should be parens'ified.
   | otherwise = 
-    wantReadableHandle "hFillBufBA" handle $ \ handle_ -> do
-    let fo  = haFO__ handle_
-    rc      <- mayBlock fo (readChunkBA fo buf sz)    -- ConcHask: UNSAFE, may block.
-    if rc >= (0::Int)
-     then return rc
-     else constructErrorAndFail "hFillBufBA"
+    mayBlockRead "hFillBufBA" handle (\fo -> readChunkBA fo buf sz)
 #endif
 
 hFillBuf :: Handle -> Addr -> Int -> IO Int
@@ -917,13 +913,7 @@ hFillBuf handle buf sz
 		            "hFillBuf"
 			    ("illegal buffer size " ++ showsPrec 9 sz []))  -- 9 => should be parens'ified.
   | otherwise = 
-    wantReadableHandle "hFillBuf" handle $ \ handle_ -> do
-    let fo  = haFO__ handle_
-    rc      <- mayBlock fo (readChunk fo buf sz)    -- ConcHask: UNSAFE, may block.
-    if rc >= 0
-     then return rc
-     else constructErrorAndFail "hFillBuf"
-
+    mayBlockRead "hFillBuf" handle (\fo -> readChunk fo buf sz)
 \end{code}
 
 The @hPutBuf hdl buf len@ action writes an already packed sequence of
@@ -1139,6 +1129,39 @@ mayBlock fo act = do
 	mayBlock fo act  -- output possible
      _ -> do
         return rc
+
+data MayBlock
+  = BlockRead Int
+  | BlockWrite Int
+  | NoBlock Int
+
+mayBlockRead :: String -> Handle -> (ForeignObj -> IO Int) -> IO Int
+mayBlockRead fname handle fn = do
+    r <- wantReadableHandle fname handle $ \ handle_ -> do
+	 let fo = haFO__ handle_
+         rc <- fn fo
+         case rc of
+           -5 -> do  -- (possibly blocking) read
+             fd <- getFileFd fo
+             return (BlockRead fd)
+  	   -6 -> do  -- (possibly blocking) write
+  	     fd <- getFileFd fo
+             return (BlockWrite fd)
+  	   -7 -> do  -- (possibly blocking) write on connected handle
+  	     fd <- getConnFileFd fo
+	     return (BlockWrite fd)
+           _ ->
+             if rc >= 0
+         	  then return (NoBlock rc)
+         	  else constructErrorAndFail fname
+    case r of
+	BlockRead fd -> do
+	   threadWaitRead fd
+	   mayBlockRead fname handle fn
+	BlockWrite fd -> do
+	   threadWaitWrite fd
+	   mayBlockRead fname handle fn
+	NoBlock c -> return c
 \end{code}
 
 Foreign import declarations of helper functions: