[project @ 2000-11-07 10:42:55 by simonmar]
[ghc-hetmet.git] / ghc / lib / std / PrelHandle.lhs
index e73f5b5..01b7182 100644 (file)
@@ -1,5 +1,7 @@
+% ------------------------------------------------------------------------------
+% $Id: PrelHandle.lhs,v 1.63 2000/11/07 10:42:56 simonmar Exp $
 %
-% (c) The AQUA Project, Glasgow University, 1994-1996
+% (c) The AQUA Project, Glasgow University, 1994-2000
 %
 
 \section[PrelHandle]{Module @PrelHandle@}
@@ -14,14 +16,15 @@ which are supported for them.
 #ifndef __HUGS__ /* Hugs just includes this in PreludeBuiltin so no header needed */
 module PrelHandle where
 
+import PrelArr
 import PrelBase
 import PrelAddr                ( Addr, nullAddr )
-import PrelByteArr     ( ByteArray(..), MutableByteArray(..) )
+import PrelByteArr     ( ByteArray(..) )
 import PrelRead                ( Read )
 import PrelList        ( span )
 import PrelIOBase
-import PrelException
 import PrelMaybe       ( Maybe(..) )
+import PrelException
 import PrelEnum
 import PrelNum         ( toBig, Integer(..), Num(..) )
 import PrelShow
@@ -31,12 +34,11 @@ import PrelPack         ( packString )
 #ifndef __PARALLEL_HASKELL__
 import PrelWeak                ( addForeignFinalizer )
 #endif
-import Ix
 
 import PrelConc
 
 #ifndef __PARALLEL_HASKELL__
-import PrelForeign  ( makeForeignObj )
+import PrelForeign  ( makeForeignObj, mkForeignObj )
 #endif
 
 #endif /* ndef(__HUGS__) */
@@ -53,6 +55,20 @@ import PrelForeign  ( makeForeignObj )
 #endif
 \end{code}
 
+\begin{code}
+mkBuffer__ :: FILE_OBJECT -> Int -> IO ()
+mkBuffer__ fo sz_in_bytes = do
+ chunk <- 
+  case sz_in_bytes of
+    0 -> return nullAddr  -- this has the effect of overwriting the pointer to the old buffer.
+    _ -> do
+     chunk <- malloc sz_in_bytes
+     if chunk == nullAddr
+      then ioException (IOError Nothing ResourceExhausted "mkBuffer__" "not enough virtual memory")
+      else return chunk
+ setBuf fo chunk sz_in_bytes
+\end{code}
+
 %*********************************************************
 %*                                                     *
 \subsection{Types @Handle@, @Handle__@}
@@ -99,7 +115,8 @@ but we might want to revisit this in the future --SDM ].
 \begin{code}
 withHandle :: Handle -> (Handle__ -> IO (Handle__,a)) -> IO a
 {-# INLINE withHandle #-}
-withHandle (Handle h) act = do
+withHandle (Handle h) act =
+   block $ do
    h_ <- takeMVar h
    (h',v)  <- catchException (act h_) (\ ex -> putMVar h h_ >> throw ex)
    putMVar h h'
@@ -107,7 +124,8 @@ withHandle (Handle h) act = do
 
 withHandle_ :: Handle -> (Handle__ -> IO a) -> IO a
 {-# INLINE withHandle_ #-}
-withHandle_ (Handle h) act = do
+withHandle_ (Handle h) act =
+   block $ do
    h_ <- takeMVar h
    v  <- catchException (act h_) (\ ex -> putMVar h h_ >> throw ex)
    putMVar h h_
@@ -115,7 +133,8 @@ withHandle_ (Handle h) act = do
    
 withHandle__ :: Handle -> (Handle__ -> IO Handle__) -> IO ()
 {-# INLINE withHandle__ #-}
-withHandle__ (Handle h) act = do
+withHandle__ (Handle h) act =
+   block $ do
    h_ <- takeMVar h
    h'  <- catchException (act h_) (\ ex -> putMVar h h_ >> throw ex)
    putMVar h h'
@@ -129,7 +148,7 @@ file object reference.
 nullFile__ :: FILE_OBJECT
 nullFile__ = 
 #ifndef __PARALLEL_HASKELL__
-    unsafePerformIO (makeForeignObj nullAddr)
+    unsafePerformIO (makeForeignObj nullAddr (return ()))
 #else
     nullAddr
 #endif
@@ -137,19 +156,12 @@ nullFile__ =
 
 mkClosedHandle__ :: Handle__
 mkClosedHandle__ = 
-  Handle__ 
-          nullFile__
-          ClosedHandle 
-          NoBuffering
-          "closed file"
-
-mkErrorHandle__ :: IOError -> Handle__
-mkErrorHandle__ ioe =
-  Handle__
-           nullFile__ 
-          (ErrorHandle ioe)
-          NoBuffering
-          "error handle"
+  Handle__ { haFO__         = nullFile__,
+            haType__       = ClosedHandle,
+            haBufferMode__ = NoBuffering,
+            haFilePath__   = "closed file",
+            haBuffers__    = []
+          }
 \end{code}
 
 %*********************************************************
@@ -159,11 +171,29 @@ mkErrorHandle__ ioe =
 %*********************************************************
 
 \begin{code}
+stdHandleFinalizer :: Handle -> IO ()
+stdHandleFinalizer (Handle hdl) = do
+  handle <- takeMVar hdl
+  let fo = haFO__ handle
+  freeStdFileObject fo
+  freeBuffers (haBuffers__ handle)
+
+handleFinalizer :: Handle -> IO ()
+handleFinalizer (Handle hdl) = do
+  handle <- takeMVar hdl
+  let fo = haFO__ handle
+  freeFileObject fo
+  freeBuffers (haBuffers__ handle)
+
+freeBuffers [] = return ()
+freeBuffers (b:bs) = do { free b; freeBuffers bs }
+
 foreign import "libHS_cbits" "freeStdFileObject" unsafe
         freeStdFileObject :: FILE_OBJECT -> IO ()
 foreign import "libHS_cbits" "freeFileObject" unsafe
         freeFileObject :: FILE_OBJECT -> IO ()
-
+foreign import "free" unsafe 
+       free :: Addr -> IO ()
 \end{code}
 
 %*********************************************************
@@ -190,8 +220,10 @@ stdout = unsafePerformIO (do
                              (0::Int){-writeable-}  -- ConcHask: SAFE, won't block
 
 #ifndef __PARALLEL_HASKELL__
-            fo <- makeForeignObj fo
-           addForeignFinalizer fo (freeStdFileObject fo)
+           fo <- mkForeignObj fo
+               -- I know this is deprecated, but I couldn't bring myself
+               -- to move fixIO into the prelude just so I could use makeForeignObj.
+               --      --SDM
 #endif
 
 #ifdef __HUGS__
@@ -203,9 +235,14 @@ stdout = unsafePerformIO (do
            (bm, bf_size)  <- getBMode__ fo
            mkBuffer__ fo bf_size
 #endif
-           newHandle (Handle__ fo WriteHandle bm "stdout")
-       _ -> do ioError <- constructError "stdout"
-               newHandle (mkErrorHandle__ ioError)
+           hdl <- newHandle (Handle__ fo WriteHandle bm "stdout" [])
+
+#ifndef __PARALLEL_HASKELL__
+           addForeignFinalizer fo (stdHandleFinalizer hdl)
+#endif
+           return hdl
+
+       _ -> constructErrorAndFail "stdout"
   )
 
 stdin = unsafePerformIO (do
@@ -217,19 +254,20 @@ stdin = unsafePerformIO (do
                              (1::Int){-readable-}  -- ConcHask: SAFE, won't block
 
 #ifndef __PARALLEL_HASKELL__
-            fo <- makeForeignObj fo
-           addForeignFinalizer fo (freeStdFileObject fo)
+            fo <- mkForeignObj fo
 #endif
            (bm, bf_size) <- getBMode__ fo
            mkBuffer__ fo bf_size
-           hdl <- newHandle (Handle__ fo ReadHandle bm "stdin")
+           hdl <- newHandle (Handle__ fo ReadHandle bm "stdin" [])
             -- when stdin and stdout are both connected to a terminal, ensure
-            -- that anything buffered on stdout is flushed prior to reading from stdin.
-            -- 
+            -- that anything buffered on stdout is flushed prior to reading from 
+            -- stdin.
+#ifndef __PARALLEL_HASKELL__
+           addForeignFinalizer fo (stdHandleFinalizer hdl)
+#endif
            hConnectTerms stdout hdl
            return hdl
-       _ -> do ioError <- constructError "stdin"
-               newHandle (mkErrorHandle__ ioError)
+       _ -> constructErrorAndFail "stdin"
   )
 
 
@@ -242,18 +280,19 @@ stderr = unsafePerformIO (do
                              (0::Int){-writeable-} -- ConcHask: SAFE, won't block
 
 #ifndef __PARALLEL_HASKELL__
-            fo <- makeForeignObj fo
-           addForeignFinalizer fo (freeStdFileObject fo)
+            fo <- mkForeignObj fo
 #endif
-            hdl <- 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.
+#ifndef __PARALLEL_HASKELL__
+           addForeignFinalizer fo (stdHandleFinalizer hdl)
+#endif
            hConnectTo stdout hdl
            return hdl
 
-       _ -> do ioError <- constructError "stderr"
-               newHandle (mkErrorHandle__ ioError)
+       _ -> constructErrorAndFail "stderr"
   )
 \end{code}
 
@@ -283,12 +322,15 @@ openFileEx f m = do
                       (binary::Int)     -- ConcHask: SAFE, won't block
     if fo /= nullAddr then do
 #ifndef __PARALLEL_HASKELL__
-       fo  <- makeForeignObj fo
-       addForeignFinalizer fo (freeFileObject fo)
+       fo  <- mkForeignObj fo
 #endif
        (bm, bf_size)  <- getBMode__ fo
         mkBuffer__ fo bf_size
-       newHandle (Handle__ fo htype bm f)
+       hdl <- newHandle (Handle__ fo htype bm f [])
+#ifndef __PARALLEL_HASKELL__
+       addForeignFinalizer fo (handleFinalizer hdl)
+#endif
+       return hdl
       else do
        constructErrorAndFailWithInfo "openFile" f
   where
@@ -341,7 +383,6 @@ hClose :: Handle -> IO ()
 hClose handle =
     withHandle__ handle $ \ handle_ -> do
     case haType__ handle_ of 
-      ErrorHandle theError -> ioError theError
       ClosedHandle        -> return handle_
       _ -> do
           rc      <- closeFile (haFO__ handle_)
@@ -354,11 +395,15 @@ hClose handle =
              is finalized. (we overwrite the file ptr in the underlying
             FileObject with a NULL as part of closeFile())
          -}
-          if rc == (0::Int)
-          then return (handle_{ haType__   = ClosedHandle,
-                                haFO__     = nullFile__ })
-           else constructErrorAndFail "hClose"
 
+          if (rc /= 0)
+           then constructErrorAndFail "hClose"
+
+                 -- free the spare buffers (except the handle buffer)
+                 -- associated with this handle.
+          else do freeBuffers (haBuffers__ handle_)
+                  return (handle_{ haType__    = ClosedHandle,
+                                   haBuffers__ = [] })
 \end{code}
 
 Computation $hClose hdl$ makes handle {\em hdl} closed.  Before the
@@ -381,7 +426,6 @@ hFileSize :: Handle -> IO Integer
 hFileSize handle =
     withHandle_ handle $ \ handle_ -> do
     case haType__ handle_ of 
-      ErrorHandle theError     -> ioError theError
       ClosedHandle             -> ioe_closedHandle "hFileSize" handle
       SemiClosedHandle                 -> ioe_closedHandle "hFileSize" handle
 #ifdef __HUGS__
@@ -472,15 +516,15 @@ hSetBuffering :: Handle -> BufferMode -> IO ()
 hSetBuffering handle mode =
     case mode of
       BlockBuffering (Just n) 
-        | n <= 0 -> ioError
+        | n <= 0 -> ioException
                         (IOError (Just handle)
                                  InvalidArgument
                                  "hSetBuffering"
-                                 ("illegal buffer size " ++ showsPrec 9 n []))  -- 9 => should be parens'ified.
+                                 ("illegal buffer size " ++ showsPrec 9 n []))  
+                                       -- 9 => should be parens'ified.
       _ ->
           withHandle__ handle $ \ handle_ -> do
           case haType__ handle_ of
-            ErrorHandle theError -> ioError theError
              ClosedHandle        -> ioe_closedHandle "hSetBuffering" handle
              _ -> do
                {- Note:
@@ -654,7 +698,6 @@ hIsOpen :: Handle -> IO Bool
 hIsOpen handle =
     withHandle_ handle $ \ handle_ -> do
     case haType__ handle_ of 
-      ErrorHandle theError -> ioError theError
       ClosedHandle         -> return False
       SemiClosedHandle     -> return False
       _                   -> return True
@@ -663,7 +706,6 @@ hIsClosed :: Handle -> IO Bool
 hIsClosed handle =
     withHandle_ handle $ \ handle_ -> do
     case haType__ handle_ of 
-      ErrorHandle theError -> ioError theError
       ClosedHandle        -> return True
       _                   -> return False
 
@@ -681,7 +723,6 @@ hIsReadable :: Handle -> IO Bool
 hIsReadable handle =
     withHandle_ handle $ \ handle_ -> do
     case haType__ handle_ of 
-      ErrorHandle theError -> ioError theError
       ClosedHandle        -> ioe_closedHandle "hIsReadable" handle
       SemiClosedHandle            -> ioe_closedHandle "hIsReadable" handle
       htype               -> return (isReadable htype)
@@ -694,7 +735,6 @@ hIsWritable :: Handle -> IO Bool
 hIsWritable handle =
     withHandle_ handle $ \ handle_ -> do
     case haType__ handle_ of 
-      ErrorHandle theError -> ioError theError
       ClosedHandle        -> ioe_closedHandle "hIsWritable" handle
       SemiClosedHandle            -> ioe_closedHandle "hIsWritable" handle
       htype               -> return (isWritable htype)
@@ -716,7 +756,7 @@ getBMode__ fo = do
     n  -> return (BlockBuffering (Just n), n)
  where
    default_buffer_size :: Int
-   default_buffer_size = (const_BUFSIZ - 1)
+   default_buffer_size = const_BUFSIZ
 \end{code}
 
 Querying how a handle buffers its data:
@@ -726,7 +766,6 @@ hGetBuffering :: Handle -> IO BufferMode
 hGetBuffering handle = 
     withHandle_ handle $ \ handle_ -> do
     case haType__ handle_ of 
-      ErrorHandle theError -> ioError theError
       ClosedHandle        -> ioe_closedHandle "hGetBuffering" handle
       _ -> 
          {-
@@ -741,7 +780,6 @@ hIsSeekable :: Handle -> IO Bool
 hIsSeekable handle =
     withHandle_ handle $ \ handle_ -> do
     case haType__ handle_ of 
-      ErrorHandle theError -> ioError theError
       ClosedHandle        -> ioe_closedHandle "hIsSeekable" handle
       SemiClosedHandle            -> ioe_closedHandle "hIsSeekable" handle
       AppendHandle        -> return False
@@ -772,7 +810,6 @@ hSetEcho handle on = do
      else
       withHandle_ handle $ \ handle_ -> do
       case haType__ handle_ of 
-         ErrorHandle theError -> ioError theError
          ClosedHandle        -> ioe_closedHandle "hSetEcho" handle
          _ -> do
             rc <- setTerminalEcho (haFO__ handle_) (if on then 1 else 0)  -- ConcHask: SAFE, won't block
@@ -788,7 +825,6 @@ hGetEcho handle = do
      else
        withHandle_ handle $ \ handle_ -> do
        case haType__ handle_ of 
-         ErrorHandle theError -> ioError theError
          ClosedHandle        -> ioe_closedHandle "hGetEcho" handle
          _ -> do
             rc <- getTerminalEcho (haFO__ handle_)  -- ConcHask: SAFE, won't block
@@ -801,7 +837,6 @@ hIsTerminalDevice :: Handle -> IO Bool
 hIsTerminalDevice handle = do
     withHandle_ handle $ \ handle_ -> do
      case haType__ handle_ of 
-       ErrorHandle theError -> ioError theError
        ClosedHandle        -> ioe_closedHandle "hIsTerminalDevice" handle
        _ -> do
           rc <- isTerminalDevice (haFO__ handle_)   -- ConcHask: SAFE, won't block
@@ -855,7 +890,7 @@ slurpFile fname = do
     ioError (userError "slurpFile: file too big")
    else do
      let sz_i = fromInteger sz
-     chunk <- allocMemory__ sz_i
+     chunk <- malloc sz_i
      if chunk == nullAddr 
       then do
         hClose handle
@@ -870,73 +905,6 @@ slurpFile fname = do
         then constructErrorAndFail "slurpFile"
         else return (chunk, rc)
 
-#ifndef __HUGS__ /* Hugs' Prelude doesn't need this */
-hFillBufBA :: Handle -> MutableByteArray RealWorld a -> Int -> IO Int
-hFillBufBA handle buf sz
-  | sz <= 0 = ioError (IOError (Just handle)
-                           InvalidArgument
-                           "hFillBufBA"
-                           ("illegal buffer size " ++ showsPrec 9 sz []))  -- 9 => should be parens'ified.
-  | otherwise = hFillBuf' sz 0
-  where
-  hFillBuf' sz len = do
-       r <- mayBlockRead "hFillBufBA" handle (\fo -> readChunkBA fo buf len sz)
-       if r >= sz || r == 0  -- r == 0 indicates EOF
-           then return (len+r)
-           else hFillBuf' (sz-r) (len+r)
-#endif
-
-hFillBuf :: Handle -> Addr -> Int -> IO Int
-hFillBuf handle buf sz
-  | sz <= 0 = ioError (IOError (Just handle)
-                           InvalidArgument
-                           "hFillBuf"
-                           ("illegal buffer size " ++ showsPrec 9 sz [])) 
-                                       -- 9 => should be parens'ified.
-  | otherwise = hFillBuf' sz 0
-  where
-  hFillBuf' sz len = do
-       r <- mayBlockRead "hFillBuf" handle (\fo -> readChunk fo buf len sz)
-       if r >= sz || r == 0  -- r == 0 indicates EOF
-           then return (len+r)
-           else hFillBuf' (sz-r) (len+r)
-\end{code}
-
-The @hPutBuf hdl buf len@ action writes an already packed sequence of
-bytes to the file/channel managed by @hdl@ - non-standard.
-
-\begin{code}
-hPutBuf :: Handle -> Addr -> Int -> IO ()
-hPutBuf handle buf sz
-  | sz <= 0 = ioError (IOError (Just handle)
-                           InvalidArgument
-                           "hPutBuf"
-                           ("illegal buffer size " ++ showsPrec 9 sz [])) 
-                                       -- 9 => should be parens'ified.
-  | otherwise = hPutBuf' sz 0
-  where
-  hPutBuf' sz len = do
-       r <- mayBlockWrite "hPutBuf" handle (\fo -> writeBuf fo buf len sz)
-       if r >= sz
-           then return ()
-           else hPutBuf' (sz-r) (len+r) -- <= sz indicates blocking
-
-#ifndef __HUGS__ /* An_ one Hugs doesn't provide */
-hPutBufBA :: Handle -> MutableByteArray RealWorld a -> Int -> IO ()
-hPutBufBA handle buf sz
-  | sz <= 0 = ioError (IOError (Just handle)
-                           InvalidArgument
-                           "hPutBufBA"
-                           ("illegal buffer size " ++ showsPrec 9 sz [])) 
-                                       -- 9 => should be parens'ified.
-  | otherwise = hPutBuf' sz 0
-  where
-  hPutBuf' sz len = do
-       r <- mayBlockWrite "hPutBufBA" handle (\fo -> writeBufBA fo buf len sz)
-       if r >= sz
-           then return ()
-           else hPutBuf' (sz-r) (len+r) -- <= sz indicates blocking
-#endif
 \end{code}
 
 Sometimes it's useful to get at the file descriptor that
@@ -947,7 +915,6 @@ getHandleFd :: Handle -> IO Int
 getHandleFd handle =
     withHandle_ handle $ \ handle_ -> do
     case (haType__ handle_) of
-      ErrorHandle theError -> ioError theError
       ClosedHandle        -> ioe_closedHandle "getHandleFd" handle
       _ -> do
           fd <- getFileFd (haFO__ handle_)
@@ -970,17 +937,20 @@ ioeGetFileName        :: IOError -> Maybe FilePath
 ioeGetErrorString     :: IOError -> String
 ioeGetHandle          :: IOError -> Maybe Handle
 
-ioeGetHandle   (IOError h _ _ _)   = h
-ioeGetErrorString (IOError _ iot _ str) =
+ioeGetHandle   (IOException (IOError h _ _ _))   = h
+ioeGetHandle   _ = error "IO.ioeGetHandle: not an IO error"
+
+ioeGetErrorString (IOException (IOError _ iot _ str)) =
  case iot of
    EOF -> "end of file"
    _   -> str
+ioeGetErrorString   _ = error "IO.ioeGetErrorString: not an IO error"
 
-ioeGetFileName (IOError _ _  _ str) = 
+ioeGetFileName (IOException (IOError _ _  _ str)) = 
  case span (/=':') str of
    (_,[])  -> Nothing
    (fs,_)  -> Just fs
-
+ioeGetFileName   _ = error "IO.ioeGetFileName: not an IO error"
 \end{code}
 
 'Top-level' IO actions want to catch exceptions (e.g., forkIO and 
@@ -1020,16 +990,17 @@ reportError bombOut str = do
     else
      return ()
 
-foreign label "ErrorHdrHook" 
+foreign import ccall "addrOf_ErrorHdrHook" unsafe
         addrOf_ErrorHdrHook :: Addr
 
 foreign import ccall "writeErrString__" unsafe
        writeErrString :: Addr -> ByteArray Int -> Int -> IO ()
 
-foreign import ccall "stackOverflow"
+-- SUP: Are the hooks allowed to re-enter Haskell land? If yes, remove the unsafe below.
+foreign import ccall "stackOverflow" unsafe
        callStackOverflowHook :: IO ()
 
-foreign import ccall "stg_exit"
+foreign import ccall "stg_exit" unsafe
        stg_exit :: Int -> IO ()
 \end{code}
 
@@ -1042,11 +1013,10 @@ wantReadableHandle :: String -> Handle -> (Handle__ -> IO a) -> IO a
 wantReadableHandle fun handle act = 
     withHandle_ handle $ \ handle_ -> do
     case haType__ handle_ of 
-      ErrorHandle theError -> ioError theError
       ClosedHandle        -> ioe_closedHandle fun handle
       SemiClosedHandle            -> ioe_closedHandle fun handle
-      AppendHandle        -> ioError not_readable_error
-      WriteHandle         -> ioError not_readable_error
+      AppendHandle        -> ioException not_readable_error
+      WriteHandle         -> ioException not_readable_error
       _                   -> act handle_
   where
    not_readable_error = 
@@ -1055,23 +1025,29 @@ wantReadableHandle fun handle act =
 
 wantWriteableHandle :: String -> Handle -> (Handle__ -> IO a) -> IO a
 wantWriteableHandle fun handle act = 
-    withHandle_ handle $ \ handle_ -> do
-    case haType__ handle_ of 
-      ErrorHandle theError -> ioError theError
+    withHandle_ handle $ \ handle_ ->
+       checkWriteableHandle fun handle handle_ (act handle_)
+
+wantWriteableHandle_ :: String -> Handle -> (Handle__ -> IO (Handle__, a)) -> IO a
+wantWriteableHandle_ fun handle act = 
+    withHandle handle $ \ handle_ -> 
+       checkWriteableHandle fun handle handle_ (act handle_)
+
+checkWriteableHandle fun handle handle_ act
+  = case haType__ handle_ of 
       ClosedHandle        -> ioe_closedHandle fun handle
       SemiClosedHandle            -> ioe_closedHandle fun handle
       ReadHandle          -> ioError not_writeable_error
-      _                   -> act handle_
+      _                   -> act
   where
    not_writeable_error = 
-          IOError (Just handle) IllegalOperation fun
-                  ("handle is not open for writing")
+          IOException (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 -> ioError theError
       ClosedHandle        -> ioe_closedHandle fun handle
       SemiClosedHandle            -> ioe_closedHandle fun handle
       _                   -> act handle_
@@ -1080,16 +1056,9 @@ wantSeekableHandle :: String -> Handle -> (Handle__ -> IO a) -> IO a
 wantSeekableHandle fun handle act =
     withHandle_ handle $ \ handle_ -> do
     case haType__ handle_ of 
-      ErrorHandle theError -> ioError theError
       ClosedHandle        -> ioe_closedHandle fun handle
       SemiClosedHandle    -> ioe_closedHandle fun handle
       _                   -> act handle_
-  where
-   not_seekable_error = 
-          IOError (Just handle) 
-                  IllegalOperation fun
-                  ("handle is not seekable")
-
 \end{code}
 
 Internal function for creating an @IOError@ representing the
@@ -1097,7 +1066,8 @@ access to a closed file.
 
 \begin{code}
 ioe_closedHandle :: String -> Handle -> IO a
-ioe_closedHandle fun h = ioError (IOError (Just h) IllegalOperation fun "handle is closed")
+ioe_closedHandle fun h = ioError (IOException (IOError (Just h) IllegalOperation fun 
+                                       "handle is closed"))
 \end{code}
 
 Internal helper functions for Concurrent Haskell implementation
@@ -1123,10 +1093,10 @@ mayBlock fo act = do
      _ -> do
         return rc
 
-data MayBlock
+data MayBlock a
   = BlockRead Int
   | BlockWrite Int
-  | NoBlock Int
+  | NoBlock a
 
 mayBlockRead :: String -> Handle -> (FILE_OBJECT -> IO Int) -> IO Int
 mayBlockRead fname handle fn = do
@@ -1156,6 +1126,38 @@ mayBlockRead fname handle fn = do
           mayBlockRead fname handle fn
        NoBlock c -> return c
 
+mayBlockRead' :: String -> Handle
+       -> (FILE_OBJECT -> IO Int)
+       -> (FILE_OBJECT -> Int -> IO a)
+       -> IO a
+mayBlockRead' fname handle fn io = 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 do a <- io fo rc 
+                         return (NoBlock a)
+                 else constructErrorAndFail fname
+    case r of
+       BlockRead fd -> do
+          threadWaitRead fd
+          mayBlockRead' fname handle fn io
+       BlockWrite fd -> do
+          threadWaitWrite fd
+          mayBlockRead' fname handle fn io
+       NoBlock c -> return c
+
 mayBlockWrite :: String -> Handle -> (FILE_OBJECT -> IO Int) -> IO Int
 mayBlockWrite fname handle fn = do
     r <- wantWriteableHandle fname handle $ \ handle_ -> do
@@ -1211,10 +1213,14 @@ foreign import "libHS_cbits" "writeFileObject" unsafe
            writeFileObject  :: FILE_OBJECT -> Int -> IO Int{-ret code-}
 foreign import "libHS_cbits" "filePutc" unsafe
            filePutc         :: FILE_OBJECT -> Char -> IO Int{-ret code-}
+foreign import "libHS_cbits" "write_" unsafe
+           write_           :: FILE_OBJECT -> Addr -> Int -> IO Int{-ret code-}
 foreign import "libHS_cbits" "getBufStart" unsafe
            getBufStart      :: FILE_OBJECT -> Int -> IO Addr
 foreign import "libHS_cbits" "getWriteableBuf" unsafe
            getWriteableBuf  :: FILE_OBJECT -> IO Addr
+foreign import "libHS_cbits" "getBuf" unsafe
+           getBuf           :: FILE_OBJECT -> IO Addr
 foreign import "libHS_cbits" "getBufWPtr" unsafe
            getBufWPtr       :: FILE_OBJECT -> IO Int
 foreign import "libHS_cbits" "setBufWPtr" unsafe
@@ -1253,14 +1259,6 @@ foreign import "libHS_cbits" "ungetChar" unsafe
            ungetChar        :: FILE_OBJECT -> Char -> IO Int{-ret code-}
 foreign import "libHS_cbits" "readChunk" unsafe
            readChunk        :: FILE_OBJECT -> Addr -> Int -> Int -> IO Int{-ret code-}
-foreign import "libHS_cbits" "readChunk" unsafe
-           readChunkBA      :: FILE_OBJECT -> MutableByteArray s a -> Int -> Int -> IO Int{-ret code-}
-foreign import "libHS_cbits" "writeBuf" unsafe
-           writeBuf         :: FILE_OBJECT -> Addr -> Int -> Int -> IO Int{-ret code-}
-#ifndef __HUGS__
-foreign import "libHS_cbits" "writeBufBA" unsafe
-           writeBufBA       :: FILE_OBJECT -> MutableByteArray s a -> Int -> Int -> IO Int{-ret code-}
-#endif
 foreign import "libHS_cbits" "getFileFd" unsafe
            getFileFd        :: FILE_OBJECT -> IO Int{-fd-}
 #ifdef __HUGS__
@@ -1289,7 +1287,7 @@ foreign import "libHS_cbits" "openFile" unsafe
 foreign import "libHS_cbits" "const_BUFSIZ" unsafe
            const_BUFSIZ          :: Int
 
-foreign import "libHS_cbits" "setBinaryMode__" 
+foreign import "libHS_cbits" "setBinaryMode__" unsafe
           setBinaryMode :: FILE_OBJECT -> Int -> IO Int
 \end{code}