Move some catch definitions around to avoid an import loop
[ghc-base.git] / GHC / Handle.hs
index 8527e6f..6255a79 100644 (file)
@@ -1,4 +1,6 @@
-{-# OPTIONS_GHC -fno-implicit-prelude -#include "HsBase.h" #-}
+{-# OPTIONS_GHC -XNoImplicitPrelude -#include "HsBase.h" #-}
+{-# OPTIONS_GHC -fno-warn-unused-matches #-}
+{-# OPTIONS_GHC -fno-warn-unused-binds #-}
 {-# OPTIONS_HADDOCK hide #-}
 
 #undef DEBUG_DUMP
@@ -38,7 +40,7 @@ module GHC.Handle (
 
   stdin, stdout, stderr,
   IOMode(..), openFile, openBinaryFile, fdToHandle_stat, fdToHandle, fdToHandle',
-  hFileSize, hSetFileSize, hIsEOF, isEOF, hLookAhead, hSetBuffering, hSetBinaryMode,
+  hFileSize, hSetFileSize, hIsEOF, isEOF, hLookAhead, hLookAhead', hSetBuffering, hSetBinaryMode,
   hFlush, hDuplicate, hDuplicateTo,
 
   hClose, hClose_help,
@@ -58,7 +60,6 @@ module GHC.Handle (
  ) where
 
 import Control.Monad
-import Data.Bits
 import Data.Maybe
 import Foreign
 import Foreign.C
@@ -75,9 +76,8 @@ import GHC.List
 import GHC.IOBase
 import GHC.Exception
 import GHC.Enum
-import GHC.Num          ( Integer(..), Num(..) )
+import GHC.Num          ( Integer, Num(..) )
 import GHC.Show
-import GHC.Real         ( toInteger )
 #if defined(DEBUG_DUMP)
 import GHC.Pack
 #endif
@@ -98,7 +98,8 @@ import GHC.Conc
 -- Are files opened by default in text or binary mode, if the user doesn't
 -- specify?
 
-dEFAULT_OPEN_IN_BINARY_MODE = False :: Bool
+dEFAULT_OPEN_IN_BINARY_MODE :: Bool
+dEFAULT_OPEN_IN_BINARY_MODE = False
 
 -- ---------------------------------------------------------------------------
 -- Creating a new handle
@@ -145,11 +146,8 @@ withHandle' fun h m act =
    block $ do
    h_ <- takeMVar m
    checkBufferInvariants h_
-   (h',v)  <- catchException (act h_)
-                (\ err -> putMVar m h_ >>
-                          case err of
-                             IOException ex -> ioError (augmentIOError ex fun h)
-                             _ -> throw err)
+   (h',v)  <- (act h_ `catchAny` \err -> putMVar m h_ >> throw err)
+              `catchException` \ex -> ioError (augmentIOError ex fun h)
    checkBufferInvariants h'
    putMVar m h'
    return v
@@ -164,11 +162,8 @@ withHandle_' fun h m act =
    block $ do
    h_ <- takeMVar m
    checkBufferInvariants h_
-   v  <- catchException (act h_)
-                (\ err -> putMVar m h_ >>
-                          case err of
-                             IOException ex -> ioError (augmentIOError ex fun h)
-                             _ -> throw err)
+   v  <- (act h_ `catchAny` \err -> putMVar m h_ >> throw err)
+         `catchException` \ex -> ioError (augmentIOError ex fun h)
    checkBufferInvariants h_
    putMVar m h_
    return v
@@ -179,26 +174,26 @@ withAllHandles__ fun h@(DuplexHandle _ r w) act = do
   withHandle__' fun h r act
   withHandle__' fun h w act
 
+withHandle__' :: String -> Handle -> MVar Handle__ -> (Handle__ -> IO Handle__)
+              -> IO ()
 withHandle__' fun h m act =
    block $ do
    h_ <- takeMVar m
    checkBufferInvariants h_
-   h'  <- catchException (act h_)
-                (\ err -> putMVar m h_ >>
-                          case err of
-                             IOException ex -> ioError (augmentIOError ex fun h)
-                             _ -> throw err)
+   h'  <- (act h_ `catchAny` \err -> putMVar m h_ >> throw err)
+          `catchException` \ex -> ioError (augmentIOError ex fun h)
    checkBufferInvariants h'
    putMVar m h'
    return ()
 
-augmentIOError (IOError _ iot _ str fp) fun h
-  = IOError (Just h) iot fun str filepath
+augmentIOError :: IOException -> String -> Handle -> IOException
+augmentIOError ioe@IOError{ ioe_filename = fp } fun h
+  = ioe { ioe_handle = Just h, ioe_location = fun, ioe_filename = filepath }
   where filepath
           | Just _ <- fp = fp
           | otherwise = case h of
-                          FileHandle fp _     -> Just fp
-                          DuplexHandle fp _ _ -> Just fp
+                          FileHandle path _     -> Just path
+                          DuplexHandle path _ _ -> Just path
 
 -- ---------------------------------------------------------------------------
 -- Wrapper for write operations.
@@ -216,6 +211,7 @@ wantWritableHandle'
 wantWritableHandle' fun h m act
    = withHandle_' fun h m (checkWritableHandle act)
 
+checkWritableHandle :: (Handle__ -> IO a) -> Handle__ -> IO a
 checkWritableHandle act handle_
   = case haType handle_ of
       ClosedHandle         -> ioe_closedHandle
@@ -249,6 +245,7 @@ wantReadableHandle'
 wantReadableHandle' fun h m act
   = withHandle_' fun h m (checkReadableHandle act)
 
+checkReadableHandle :: (Handle__ -> IO a) -> Handle__ -> IO a
 checkReadableHandle act handle_ =
     case haType handle_ of
       ClosedHandle         -> ioe_closedHandle
@@ -270,10 +267,11 @@ checkReadableHandle act handle_ =
 wantSeekableHandle :: String -> Handle -> (Handle__ -> IO a) -> IO a
 wantSeekableHandle fun h@(DuplexHandle _ _ _) _act =
   ioException (IOError (Just h) IllegalOperation fun
-                   "handle is not seekable" Nothing)
+                   "handle is not seekable" Nothing Nothing)
 wantSeekableHandle fun h@(FileHandle _ m) act =
   withHandle_' fun h m (checkSeekableHandle act)
 
+checkSeekableHandle :: (Handle__ -> IO a) -> Handle__ -> IO a
 checkSeekableHandle act handle_ =
     case haType handle_ of
       ClosedHandle      -> ioe_closedHandle
@@ -291,31 +289,32 @@ ioe_closedHandle, ioe_EOF,
 
 ioe_closedHandle = ioException
    (IOError Nothing IllegalOperation ""
-        "handle is closed" Nothing)
+        "handle is closed" Nothing Nothing)
 ioe_EOF = ioException
-   (IOError Nothing EOF "" "" Nothing)
+   (IOError Nothing EOF "" "" Nothing Nothing)
 ioe_notReadable = ioException
    (IOError Nothing IllegalOperation ""
-        "handle is not open for reading" Nothing)
+        "handle is not open for reading" Nothing Nothing)
 ioe_notWritable = ioException
    (IOError Nothing IllegalOperation ""
-        "handle is not open for writing" Nothing)
+        "handle is not open for writing" Nothing Nothing)
 ioe_notSeekable = ioException
    (IOError Nothing IllegalOperation ""
-        "handle is not seekable" Nothing)
+        "handle is not seekable" Nothing Nothing)
 ioe_notSeekable_notBin = ioException
    (IOError Nothing IllegalOperation ""
       "seek operations on text-mode handles are not allowed on this platform"
-        Nothing)
+        Nothing Nothing)
 
-ioe_finalizedHandle fp = throw (IOException
+ioe_finalizedHandle :: FilePath -> Handle__
+ioe_finalizedHandle fp = throw
    (IOError Nothing IllegalOperation ""
-        "handle is finalized" (Just fp)))
+        "handle is finalized" Nothing (Just fp))
 
 ioe_bufsiz :: Int -> IO a
 ioe_bufsiz n = ioException
    (IOError Nothing InvalidArgument "hSetBuffering"
-        ("illegal buffer size " ++ showsPrec 9 n []) Nothing)
+        ("illegal buffer size " ++ showsPrec 9 n []) Nothing Nothing)
                                 -- 9 => should be parens'ified.
 
 -- -----------------------------------------------------------------------------
@@ -345,7 +344,7 @@ handleFinalizer fp m = do
   handle_ <- takeMVar m
   case haType handle_ of
       ClosedHandle -> return ()
-      _ -> do flushWriteBufferOnly handle_ `catchException` \_ -> return ()
+      _ -> do flushWriteBufferOnly handle_ `catchAny` \_ -> return ()
                 -- ignore errors and async exceptions, and close the
                 -- descriptor anyway...
               hClose_handle_ handle_
@@ -355,6 +354,7 @@ handleFinalizer fp m = do
 -- ---------------------------------------------------------------------------
 -- Grimy buffer operations
 
+checkBufferInvariants :: Handle__ -> IO ()
 #ifdef DEBUG
 checkBufferInvariants h_ = do
  let ref = haBuffer h_
@@ -370,7 +370,7 @@ checkBufferInvariants h_ = do
    then error "buffer invariant violation"
    else return ()
 #else
-checkBufferInvariants h_ = return ()
+checkBufferInvariants _ = return ()
 #endif
 
 newEmptyBuffer :: RawBuffer -> BufferState -> Int -> Buffer
@@ -381,18 +381,18 @@ allocateBuffer :: Int -> BufferState -> IO Buffer
 allocateBuffer sz@(I# size) state = IO $ \s -> 
    -- We sometimes need to pass the address of this buffer to
    -- a "safe" foreign call, hence it must be immovable.
-  case newPinnedByteArray# size s of { (# s, b #) ->
-  (# s, newEmptyBuffer b state sz #) }
+  case newPinnedByteArray# size s of { (# s', b #) ->
+  (# s', newEmptyBuffer b state sz #) }
 
 writeCharIntoBuffer :: RawBuffer -> Int -> Char -> IO Int
 writeCharIntoBuffer slab (I# off) (C# c)
   = IO $ \s -> case writeCharArray# slab off c s of 
-                 s -> (# s, I# (off +# 1#) #)
+               s' -> (# s', I# (off +# 1#) #)
 
 readCharFromBuffer :: RawBuffer -> Int -> IO (Char, Int)
 readCharFromBuffer slab (I# off)
   = IO $ \s -> case readCharArray# slab off s of 
-                 (# s, c #) -> (# s, (C# c, I# (off +# 1#)) #)
+                 (# s', c #) -> (# s', (C# c, I# (off +# 1#)) #)
 
 getBuffer :: FD -> BufferState -> IO (IORef Buffer, BufferMode)
 getBuffer fd state = do
@@ -483,6 +483,8 @@ fillReadBuffer fd is_line is_stream
 -- appears to be what GHC has done for a long time, and I suspect it
 -- is more useful than line buffering in most cases.
 
+fillReadBufferLoop :: FD -> Bool -> Bool -> Buffer -> RawBuffer -> Int -> Int
+                   -> IO Buffer
 fillReadBufferLoop fd is_line is_stream buf b w size = do
   let bytes = size - w
   if bytes == 0  -- buffer full?
@@ -546,42 +548,52 @@ cases are wrong here.  The cases that are wrong:
     but that leaves a small race window where the data can be read
     from the file descriptor before we issue our blocking read().
   * readRawBufferNoBlock for a blocking FD
+
+NOTE [2363]:
+
+In the threaded RTS we could just make safe calls to read()/write()
+for file descriptors in blocking mode without worrying about blocking
+other threads, but the problem with this is that the thread will be
+uninterruptible while it is blocked in the foreign call.  See #2363.
+So now we always call fdReady() before reading, and if fdReady
+indicates that there's no data, we call threadWaitRead.
+
 -}
 
 readRawBuffer :: String -> FD -> Bool -> RawBuffer -> Int -> CInt -> IO CInt
 readRawBuffer loc fd is_nonblock buf off len
-  | is_nonblock  = unsafe_read
-  | threaded     = safe_read
+  | is_nonblock  = unsafe_read -- unsafe is ok, it can't block
   | otherwise    = do r <- throwErrnoIfMinus1 loc 
-                                (fdReady (fromIntegral fd) 0 0 False)
+                                (unsafe_fdReady (fromIntegral fd) 0 0 0)
                       if r /= 0
-                        then unsafe_read
-                        else do threadWaitRead (fromIntegral fd); unsafe_read
+                        then read
+                        else do threadWaitRead (fromIntegral fd); read
   where
     do_read call = throwErrnoIfMinus1RetryMayBlock loc call 
                             (threadWaitRead (fromIntegral fd))
+    read        = if threaded then safe_read else unsafe_read
     unsafe_read = do_read (read_rawBuffer fd buf off len)
     safe_read   = do_read (safe_read_rawBuffer fd buf off len)
 
 readRawBufferPtr :: String -> FD -> Bool -> Ptr CChar -> Int -> CInt -> IO CInt
 readRawBufferPtr loc fd is_nonblock buf off len
-  | is_nonblock  = unsafe_read
-  | threaded     = safe_read
+  | is_nonblock  = unsafe_read -- unsafe is ok, it can't block
   | otherwise    = do r <- throwErrnoIfMinus1 loc 
-                                (fdReady (fromIntegral fd) 0 0 False)
+                                (unsafe_fdReady (fromIntegral fd) 0 0 0)
                       if r /= 0 
-                        then unsafe_read
-                        else do threadWaitRead (fromIntegral fd); unsafe_read
+                        then read
+                        else do threadWaitRead (fromIntegral fd); read
   where
-        do_read call = throwErrnoIfMinus1RetryMayBlock loc call 
-                                (threadWaitRead (fromIntegral fd))
-        unsafe_read = do_read (read_off fd buf off len)
-        safe_read   = do_read (safe_read_off fd buf off len)
+    do_read call = throwErrnoIfMinus1RetryMayBlock loc call 
+                            (threadWaitRead (fromIntegral fd))
+    read        = if threaded then safe_read else unsafe_read
+    unsafe_read = do_read (read_off fd buf off len)
+    safe_read   = do_read (safe_read_off fd buf off len)
 
 readRawBufferNoBlock :: String -> FD -> Bool -> RawBuffer -> Int -> CInt -> IO CInt
 readRawBufferNoBlock loc fd is_nonblock buf off len
-  | is_nonblock  = unsafe_read
-  | otherwise    = do r <- fdReady (fromIntegral fd) 0 0 False
+  | is_nonblock  = unsafe_read -- unsafe is ok, it can't block
+  | otherwise    = do r <- unsafe_fdReady (fromIntegral fd) 0 0 0
                       if r /= 0 then safe_read
                                 else return 0
        -- XXX see note [nonblock]
@@ -592,8 +604,8 @@ readRawBufferNoBlock loc fd is_nonblock buf off len
 
 readRawBufferPtrNoBlock :: String -> FD -> Bool -> Ptr CChar -> Int -> CInt -> IO CInt
 readRawBufferPtrNoBlock loc fd is_nonblock buf off len
-  | is_nonblock  = unsafe_read
-  | otherwise    = do r <- fdReady (fromIntegral fd) 0 0 False
+  | is_nonblock  = unsafe_read -- unsafe is ok, it can't block
+  | otherwise    = do r <- unsafe_fdReady (fromIntegral fd) 0 0 0
                       if r /= 0 then safe_read
                                 else return 0
        -- XXX see note [nonblock]
@@ -604,29 +616,29 @@ readRawBufferPtrNoBlock loc fd is_nonblock buf off len
 
 writeRawBuffer :: String -> FD -> Bool -> RawBuffer -> Int -> CInt -> IO CInt
 writeRawBuffer loc fd is_nonblock buf off len
-  | is_nonblock = unsafe_write
-  | threaded    = safe_write
-  | otherwise   = do r <- fdReady (fromIntegral fd) 1 0 False
+  | is_nonblock = unsafe_write -- unsafe is ok, it can't block
+  | otherwise   = do r <- unsafe_fdReady (fromIntegral fd) 1 0 0
                      if r /= 0 
-                        then safe_write
-                        else do threadWaitWrite (fromIntegral fd); unsafe_write
+                        then write
+                        else do threadWaitWrite (fromIntegral fd); write
   where  
     do_write call = throwErrnoIfMinus1RetryMayBlock loc call
                         (threadWaitWrite (fromIntegral fd)) 
+    write        = if threaded then safe_write else unsafe_write
     unsafe_write = do_write (write_rawBuffer fd buf off len)
     safe_write   = do_write (safe_write_rawBuffer (fromIntegral fd) buf off len)
 
 writeRawBufferPtr :: String -> FD -> Bool -> Ptr CChar -> Int -> CInt -> IO CInt
 writeRawBufferPtr loc fd is_nonblock buf off len
-  | is_nonblock = unsafe_write
-  | threaded    = safe_write
-  | otherwise   = do r <- fdReady (fromIntegral fd) 1 0 False
+  | is_nonblock = unsafe_write -- unsafe is ok, it can't block
+  | otherwise   = do r <- unsafe_fdReady (fromIntegral fd) 1 0 0
                      if r /= 0 
-                        then safe_write
-                        else do threadWaitWrite (fromIntegral fd); unsafe_write
+                        then write
+                        else do threadWaitWrite (fromIntegral fd); write
   where
     do_write call = throwErrnoIfMinus1RetryMayBlock loc call
                         (threadWaitWrite (fromIntegral fd)) 
+    write         = if threaded then safe_write else unsafe_write
     unsafe_write  = do_write (write_off fd buf off len)
     safe_write    = do_write (safe_write_off (fromIntegral fd) buf off len)
 
@@ -642,8 +654,8 @@ foreign import ccall unsafe "__hscore_PrelHandle_write"
 foreign import ccall unsafe "__hscore_PrelHandle_write"
    write_off :: CInt -> Ptr CChar -> Int -> CInt -> IO CInt
 
-foreign import ccall safe "fdReady"
-  fdReady :: CInt -> CInt -> CInt -> Bool -> IO CInt
+foreign import ccall unsafe "fdReady"
+  unsafe_fdReady :: CInt -> CInt -> CInt -> CInt -> IO CInt
 
 #else /* mingw32_HOST_OS.... */
 
@@ -675,6 +687,8 @@ readRawBufferPtrNoBlock :: String -> FD -> Bool -> Ptr CChar -> Int -> CInt -> I
 readRawBufferPtrNoBlock = readRawBufferPtr
 -- Async versions of the read/write primitives, for the non-threaded RTS
 
+asyncReadRawBuffer :: String -> FD -> Bool -> RawBuffer -> Int -> CInt
+                   -> IO CInt
 asyncReadRawBuffer loc fd is_stream buf off len = do
     (l, rc) <- asyncReadBA (fromIntegral fd) (if is_stream then 1 else 0) 
                  (fromIntegral len) off buf
@@ -683,6 +697,8 @@ asyncReadRawBuffer loc fd is_stream buf off len = do
         ioError (errnoToIOError loc (Errno (fromIntegral rc)) Nothing Nothing)
       else return (fromIntegral l)
 
+asyncReadRawBufferPtr :: String -> FD -> Bool -> Ptr CChar -> Int -> CInt
+                      -> IO CInt
 asyncReadRawBufferPtr loc fd is_stream buf off len = do
     (l, rc) <- asyncRead (fromIntegral fd) (if is_stream then 1 else 0) 
                         (fromIntegral len) (buf `plusPtr` off)
@@ -691,6 +707,8 @@ asyncReadRawBufferPtr loc fd is_stream buf off len = do
         ioError (errnoToIOError loc (Errno (fromIntegral rc)) Nothing Nothing)
       else return (fromIntegral l)
 
+asyncWriteRawBuffer :: String -> FD -> Bool -> RawBuffer -> Int -> CInt
+                    -> IO CInt
 asyncWriteRawBuffer loc fd is_stream buf off len = do
     (l, rc) <- asyncWriteBA (fromIntegral fd) (if is_stream then 1 else 0) 
                         (fromIntegral len) off buf
@@ -699,6 +717,8 @@ asyncWriteRawBuffer loc fd is_stream buf off len = do
         ioError (errnoToIOError loc (Errno (fromIntegral rc)) Nothing Nothing)
       else return (fromIntegral l)
 
+asyncWriteRawBufferPtr :: String -> FD -> Bool -> CString -> Int -> CInt
+                       -> IO CInt
 asyncWriteRawBufferPtr loc fd is_stream buf off len = do
     (l, rc) <- asyncWrite (fromIntegral fd) (if is_stream then 1 else 0) 
                   (fromIntegral len) (buf `plusPtr` off)
@@ -709,6 +729,8 @@ asyncWriteRawBufferPtr loc fd is_stream buf off len = do
 
 -- Blocking versions of the read/write primitives, for the threaded RTS
 
+blockingReadRawBuffer :: String -> CInt -> Bool -> RawBuffer -> Int -> CInt
+                      -> IO CInt
 blockingReadRawBuffer loc fd True buf off len = 
   throwErrnoIfMinus1Retry loc $
     safe_recv_rawBuffer fd buf off len
@@ -716,6 +738,8 @@ blockingReadRawBuffer loc fd False buf off len =
   throwErrnoIfMinus1Retry loc $
     safe_read_rawBuffer fd buf off len
 
+blockingReadRawBufferPtr :: String -> CInt -> Bool -> CString -> Int -> CInt
+                         -> IO CInt
 blockingReadRawBufferPtr loc fd True buf off len = 
   throwErrnoIfMinus1Retry loc $
     safe_recv_off fd buf off len
@@ -723,6 +747,8 @@ blockingReadRawBufferPtr loc fd False buf off len =
   throwErrnoIfMinus1Retry loc $
     safe_read_off fd buf off len
 
+blockingWriteRawBuffer :: String -> CInt -> Bool -> RawBuffer -> Int -> CInt
+                       -> IO CInt
 blockingWriteRawBuffer loc fd True buf off len = 
   throwErrnoIfMinus1Retry loc $
     safe_send_rawBuffer fd buf off len
@@ -730,6 +756,8 @@ blockingWriteRawBuffer loc fd False buf off len =
   throwErrnoIfMinus1Retry loc $
     safe_write_rawBuffer fd buf off len
 
+blockingWriteRawBufferPtr :: String -> CInt -> Bool -> CString -> Int -> CInt
+                          -> IO CInt
 blockingWriteRawBufferPtr loc fd True buf off len = 
   throwErrnoIfMinus1Retry loc $
     safe_send_off fd buf off len
@@ -776,9 +804,10 @@ foreign import ccall safe "__hscore_PrelHandle_write"
 -- or output channel respectively.  The third manages output to the
 -- standard error channel. These handles are initially open.
 
-fd_stdin  = 0 :: FD
-fd_stdout = 1 :: FD
-fd_stderr = 2 :: FD
+fd_stdin, fd_stdout, fd_stderr :: FD
+fd_stdin  = 0
+fd_stdout = 1
+fd_stderr = 2
 
 -- | A handle managing input from the Haskell program's standard input channel.
 stdin :: Handle
@@ -813,8 +842,9 @@ stderr = unsafePerformIO $ do
 -- ---------------------------------------------------------------------------
 -- Opening and Closing Files
 
-addFilePathToIOError fun fp (IOError h iot _ str _)
-  = IOError h iot fun str (Just fp)
+addFilePathToIOError :: String -> FilePath -> IOException -> IOException
+addFilePathToIOError fun fp ioe
+  = ioe{ ioe_location = fun, ioe_filename = Just fp }
 
 -- | Computation 'openFile' @file mode@ allocates and returns a new, open
 -- handle to manage the file @file@.  It manages input if @mode@
@@ -863,6 +893,7 @@ openBinaryFile fp m =
     (openFile' fp m True)
     (\e -> ioError (addFilePathToIOError "openBinaryFile" fp e))
 
+openFile' :: String -> IOMode -> Bool -> IO Handle
 openFile' filepath mode binary =
   withCString filepath $ \ f ->
 
@@ -895,7 +926,7 @@ openFile' filepath mode binary =
     stat@(fd_type,_,_) <- fdStat fd
 
     h <- fdToHandle_stat fd (Just stat) False filepath mode binary
-            `catchException` \e -> do c_close fd; throw e
+            `catchAny` \e -> do c_close fd; throw e
         -- NB. don't forget to close the FD if fdToHandle' fails, otherwise
         -- this FD leaks.
         -- ASSERT: if we just created the file, then fdToHandle' won't fail
@@ -914,6 +945,8 @@ openFile' filepath mode binary =
     return h
 
 
+std_flags, output_flags, read_flags, write_flags, rw_flags,
+    append_flags :: CInt
 std_flags    = o_NONBLOCK   .|. o_NOCTTY
 output_flags = std_flags    .|. o_CREAT
 read_flags   = std_flags    .|. o_RDONLY 
@@ -961,15 +994,18 @@ fdToHandle_stat fd mb_stat is_socket filepath mode binary = do
     case fd_type of
         Directory -> 
            ioException (IOError Nothing InappropriateType "openFile"
-                           "is a directory" Nothing) 
+                           "is a directory" Nothing Nothing) 
 
         -- regular files need to be locked
         RegularFile -> do
 #ifndef mingw32_HOST_OS
+           -- On Windows we use explicit exclusion via sopen() to implement
+           -- this locking (see __hscore_open()); on Unix we have to
+           -- implment it in the RTS.
            r <- lockFile fd dev ino (fromBool write)
            when (r == -1)  $
                 ioException (IOError Nothing ResourceBusy "openFile"
-                                   "file is locked" Nothing)
+                                   "file is locked" Nothing Nothing)
 #endif
            mkFileHandle fd is_socket filepath ha_type binary
 
@@ -1038,9 +1074,11 @@ mkFileHandle fd is_stream filepath ha_type binary = do
   -- turn off buffering.  We don't correctly handle the case of switching
   -- from read mode to write mode on a buffered text-mode handle, see bug
   -- \#679.
-  bmode <- case ha_type of
-                ReadWriteHandle | not binary -> return NoBuffering
-                _other                       -> return bmode
+  bmode2 <- case ha_type of
+                 ReadWriteHandle | not binary -> return NoBuffering
+                 _other                       -> return bmode
+#else
+  let bmode2 = bmode
 #endif
 
   spares <- newIORef BufferListNil
@@ -1049,7 +1087,7 @@ mkFileHandle fd is_stream filepath ha_type binary = do
                         haType = ha_type,
                         haIsBin = binary,
                         haIsStream = is_stream,
-                        haBufferMode = bmode,
+                        haBufferMode = bmode2,
                         haBuffer = buf,
                         haBuffers = spares,
                         haOtherSide = Nothing
@@ -1088,7 +1126,7 @@ mkDuplexHandle fd is_stream filepath binary = do
   addMVarFinalizer write_side (handleFinalizer filepath write_side)
   return (DuplexHandle filepath read_side write_side)
    
-
+initBufferState :: HandleType -> BufferState
 initBufferState ReadHandle = ReadBuffer
 initBufferState _          = WriteBuffer
 
@@ -1117,6 +1155,7 @@ hClose h@(DuplexHandle _ r w) = do
      Nothing -> return ()
      Just e  -> throwIO e
 
+hClose' :: Handle -> MVar Handle__ -> IO (Maybe SomeException)
 hClose' h m = withHandle' "hClose" h m $ hClose_help
 
 -- hClose_help is also called by lazyRead (in PrelIO) when EOF is read
@@ -1124,13 +1163,14 @@ hClose' h m = withHandle' "hClose" h m $ hClose_help
 -- then closed immediately.  We have to be careful with DuplexHandles
 -- though: we have to leave the closing to the finalizer in that case,
 -- because the write side may still be in use.
-hClose_help :: Handle__ -> IO (Handle__, Maybe Exception)
+hClose_help :: Handle__ -> IO (Handle__, Maybe SomeException)
 hClose_help handle_ =
   case haType handle_ of 
       ClosedHandle -> return (handle_,Nothing)
       _ -> do flushWriteBufferOnly handle_ -- interruptible
               hClose_handle_ handle_
 
+hClose_handle_ :: Handle__ -> IO (Handle__, Maybe SomeException)
 hClose_handle_ handle_ = do
     let fd = haFD handle_
 
@@ -1172,6 +1212,7 @@ hClose_handle_ handle_ = do
             maybe_exception)
 
 {-# NOINLINE noBuffer #-}
+noBuffer :: Buffer
 noBuffer = unsafePerformIO $ allocateBuffer 1 ReadBuffer
 
 -----------------------------------------------------------------------------
@@ -1191,7 +1232,7 @@ hFileSize handle =
               if r /= -1
                  then return r
                  else ioException (IOError Nothing InappropriateType "hFileSize"
-                                   "not a regular file" Nothing)
+                                   "not a regular file" Nothing Nothing)
 
 
 -- | 'hSetFileSize' @hdl@ @size@ truncates the physical file with handle @hdl@ to @size@ bytes.
@@ -1242,18 +1283,20 @@ isEOF = hIsEOF stdin
 --  * 'isEOFError' if the end of file has been reached.
 
 hLookAhead :: Handle -> IO Char
-hLookAhead handle = do
-  wantReadableHandle "hLookAhead"  handle $ \handle_ -> do
+hLookAhead handle =
+  wantReadableHandle "hLookAhead"  handle hLookAhead'
+
+hLookAhead' :: Handle__ -> IO Char
+hLookAhead' handle_ = do
   let ref     = haBuffer handle_
       fd      = haFD handle_
-      is_line = haBufferMode handle_ == LineBuffering
   buf <- readIORef ref
 
   -- fill up the read buffer if necessary
   new_buf <- if bufferEmpty buf
                 then fillReadBuffer fd True (haIsStream handle_) buf
                 else return buf
-  
+
   writeIORef ref new_buf
 
   (c,_) <- readCharFromBuffer (bufBuf buf) (bufRPtr buf)
@@ -1654,6 +1697,8 @@ dupHandle h other_side h_ = do
                 Just r -> withHandle_' "dupHandle" h r (return . haFD)
   dupHandle_ other_side h_ new_fd
 
+dupHandleTo :: Maybe (MVar Handle__) -> Handle__ -> Handle__
+            -> IO (Handle__, Handle__)
 dupHandleTo other_side hto_ h_ = do
   flushBuffer h_
   -- Windows' dup2 does not return the new descriptor, unlike Unix
@@ -1701,7 +1746,7 @@ hDuplicateTo h1@(DuplexHandle _ r1 w1) h2@(DuplexHandle _ r2 w2)  = do
    withHandle' "hDuplicateTo" h1 r1 (dupHandleTo (Just w1) r2_)
 hDuplicateTo h1 _ =
    ioException (IOError (Just h1) IllegalOperation "hDuplicateTo" 
-                "handles are incompatible" Nothing)
+                "handles are incompatible" Nothing Nothing)
 
 -- ---------------------------------------------------------------------------
 -- showing Handles.
@@ -1713,6 +1758,7 @@ hShow :: Handle -> IO String
 hShow h@(FileHandle path _) = showHandle' path False h
 hShow h@(DuplexHandle path _ _) = showHandle' path True h
 
+showHandle' :: String -> Bool -> Handle -> IO String
 showHandle' filepath is_duplex h = 
   withHandle_ "showHandle" h $ \hdl_ ->
     let