projects / ghc-hetmet.git / blobdiff
? search:
summary | shortlog | log | commit | commitdiff | tree
raw | inline | side by side
[project @ 1999-09-12 16:24:46 by sof]
[ghc-hetmet.git] / ghc / lib / std / PrelHandle.lhs
diff --git a/ghc/lib/std/PrelHandle.lhs b/ghc/lib/std/PrelHandle.lhs
index b433372..5085b9c 100644 (file)
--- a/ghc/lib/std/PrelHandle.lhs
+++ b/ghc/lib/std/PrelHandle.lhs
@@ -15,23 +15,28 @@ which are supported for them.
 module PrelHandle where
 
 import PrelBase
 module PrelHandle where
 
 import PrelBase
-import PrelArr         ( newVar, readVar, writeVar, ByteArray )
+import PrelAddr                ( Addr, nullAddr )
+import PrelArr         ( newVar, readVar, writeVar, ByteArray(..) )
 import PrelRead                ( Read )
 import PrelList        ( span )
 import PrelIOBase
 import PrelRead                ( Read )
 import PrelList        ( span )
 import PrelIOBase
-import PrelException   ( Exception(..), throw, catch, fail, catchException )
+import PrelException
 import PrelMaybe       ( Maybe(..) )
 import PrelMaybe       ( Maybe(..) )
+import PrelEnum
+import PrelNum
+import PrelShow
 import PrelAddr                ( Addr, nullAddr )
 import PrelAddr                ( Addr, nullAddr )
-import PrelBounded      ()   -- get at Bounded Int instance.
-import PrelNum         ( toInteger )
-import PrelWeak                ( addForeignFinaliser )
+import PrelNum         ( toInteger, toBig )
+import PrelPack         ( packString )
+import PrelWeak                ( addForeignFinalizer )
+import Ix
+
 #if __CONCURRENT_HASKELL__
 import PrelConc
 #endif
 #if __CONCURRENT_HASKELL__
 import PrelConc
 #endif
-import Ix
 
 #ifndef __PARALLEL_HASKELL__
 
 #ifndef __PARALLEL_HASKELL__
-import PrelForeign  ( makeForeignObj, writeForeignObj )
+import PrelForeign  ( makeForeignObj )
 #endif
 
 #endif /* ndef(__HUGS__) */
 #endif
 
 #endif /* ndef(__HUGS__) */
@@ -53,7 +58,6 @@ import PrelForeign  ( makeForeignObj, writeForeignObj )
 #else
 #define FILE_OBJECT        Addr
 #endif
 #else
 #define FILE_OBJECT        Addr
 #endif
-
 \end{code}
 
 %*********************************************************
 \end{code}
 
 %*********************************************************
@@ -67,33 +71,71 @@ The @Handle@ and @Handle__@ types are defined in @IOBase@.
 \begin{code}
 {-# INLINE newHandle   #-}
 {-# INLINE withHandle #-}
 \begin{code}
 {-# INLINE newHandle   #-}
 {-# INLINE withHandle #-}
-{-# INLINE writeHandle #-}
 newHandle     :: Handle__ -> IO Handle
 newHandle     :: Handle__ -> IO Handle
-withHandle    :: Handle   -> (Handle__ -> IO a) -> IO a
-writeHandle   :: Handle -> Handle__ -> IO ()
 
 #if defined(__CONCURRENT_HASKELL__)
 
 -- Use MVars for concurrent Haskell
 newHandle hc  = newMVar        hc      >>= \ h ->
                return (Handle h)
 
 #if defined(__CONCURRENT_HASKELL__)
 
 -- Use MVars for concurrent Haskell
 newHandle hc  = newMVar        hc      >>= \ h ->
                return (Handle h)
+#else 
+
+-- Use ordinary MutableVars for non-concurrent Haskell
+newHandle hc  = stToIO (newVar hc      >>= \ h ->
+                       return (Handle h))
+#endif
+\end{code}
+
+%*********************************************************
+%*                                                     *
+\subsection{@withHandle@ operations}
+%*                                                     *
+%*********************************************************
+
+In the concurrent world, handles are locked during use.  This is done
+by wrapping an MVar around the handle which acts as a mutex over
+operations on the handle.
 
 
-  -- withHandle grabs the handle lock, performs
-  -- some operation over it, making sure that we
-  -- unlock & reset the handle state should an
-  -- exception occur while performing said op.
+To avoid races, we use the following bracketing operations.  The idea
+is to obtain the lock, do some operation and replace the lock again,
+whether the operation succeeded or failed.  We also want to handle the
+case where the thread receives an exception while processing the IO
+operation: in these cases we also want to relinquish the lock.
+
+There are three versions of @withHandle@: corresponding to the three
+possible combinations of:
+
+       - the operation may side-effect the handle
+       - the operation may return a result
+
+If the operation generates an error or an exception is raised, the
+orignal handle is always replaced [ this is the case at the moment,
+but we might want to revisit this in the future --SDM ].
+
+\begin{code}
+#ifdef __CONCURRENT_HASKELL__
+withHandle :: Handle -> (Handle__ -> IO (Handle__,a)) -> IO a
 withHandle (Handle h) act = do
    h_ <- takeMVar h
 withHandle (Handle h) act = do
    h_ <- takeMVar h
+   (h',v)  <- catchException (act h_) (\ ex -> putMVar h h_ >> throw ex)
+   putMVar h h'
+   return v
+
+withHandle_ :: Handle -> (Handle__ -> IO a) -> IO a
+withHandle_ (Handle h) act = do
+   h_ <- takeMVar h
    v  <- catchException (act h_) (\ ex -> putMVar h h_ >> throw ex)
    v  <- catchException (act h_) (\ ex -> putMVar h h_ >> throw ex)
+   putMVar h h_
    return v
    
    return v
    
-writeHandle (Handle h) hc = putMVar h hc
-#else 
-
--- Use ordinary MutableVars for non-concurrent Haskell
-newHandle hc  = stToIO (newVar hc      >>= \ h ->
-                       return (Handle h))
+withHandle__ :: Handle -> (Handle__ -> IO Handle__) -> IO ()
+withHandle__ (Handle h) act = do
+   h_ <- takeMVar h
+   h'  <- catchException (act h_) (\ ex -> putMVar h h_ >> throw ex)
+   putMVar h h'
+   return ()
 
 
+#else
    -- of questionable value to install this exception
    -- handler, but let's do it in the non-concurrent
    -- case too, for now.
    -- of questionable value to install this exception
    -- handler, but let's do it in the non-concurrent
    -- case too, for now.
@@ -102,9 +144,7 @@ withHandle (Handle h) act = do
    v  <- catchException (act h_) (\ ex -> stToIO (writeVar h h_) >> throw ex)
    return v
 
    v  <- catchException (act h_) (\ ex -> stToIO (writeVar h h_) >> throw ex)
    return v
 
-writeHandle (Handle h) hc = stToIO (writeVar h hc)
 #endif
 #endif
-
 \end{code}
 
 nullFile__ is only used for closed handles, plugging it in as a null
 \end{code}
 
 nullFile__ is only used for closed handles, plugging it in as a null
@@ -139,7 +179,7 @@ mkErrorHandle__ ioe =
 
 %*********************************************************
 %*                                                     *
 
 %*********************************************************
 %*                                                     *
-\subsection{Handle Finalisers}
+\subsection{Handle Finalizers}
 %*                                                     *
 %*********************************************************
 
 %*                                                     *
 %*********************************************************
 
@@ -167,24 +207,28 @@ two manage input or output from the Haskell program's standard input
 or output channel respectively.  The third manages output to the
 standard error channel. These handles are initially open.
 
 or output channel respectively.  The third manages output to the
 standard error channel. These handles are initially open.
 
+
 \begin{code}
 stdin, stdout, stderr :: Handle
 
 stdout = unsafePerformIO (do
 \begin{code}
 stdin, stdout, stderr :: Handle
 
 stdout = unsafePerformIO (do
-    rc <- CCALL(getLock) 1 1   -- ConcHask: SAFE, won't block
-    case rc of
+    rc <- CCALL(getLock) (1::Int) (1::Int)   -- ConcHask: SAFE, won't block
+    case (rc::Int) of
        0 -> newHandle (mkClosedHandle__)
        1 -> do
 #ifndef __CONCURRENT_HASKELL__
        0 -> newHandle (mkClosedHandle__)
        1 -> do
 #ifndef __CONCURRENT_HASKELL__
-           fo <- CCALL(openStdFile) 1 1{-flush on close-} 0{-writeable-}  -- ConcHask: SAFE, won't block
+           fo <- CCALL(openStdFile) (1::Int) 
+                                    (1::Int){-flush on close-}
+                                    (0::Int){-writeable-}  -- ConcHask: SAFE, won't block
 #else
 #else
-           fo <- CCALL(openStdFile) 1 (1{-flush on close-} {-+ 128 don't block on I/O-})
-                                       0{-writeable-}  -- ConcHask: SAFE, won't block
+           fo <- CCALL(openStdFile) (1::Int)
+                                    ((1{-flush on close-} + 128 {- don't block on I/O-})::Int)
+                                    (0::Int){-writeable-}  -- ConcHask: SAFE, won't block
 #endif
 
 #ifndef __PARALLEL_HASKELL__
             fo <- makeForeignObj fo
 #endif
 
 #ifndef __PARALLEL_HASKELL__
             fo <- makeForeignObj fo
-           addForeignFinaliser fo (freeStdFileObject fo)
+           addForeignFinalizer fo (freeStdFileObject fo)
 #endif
 
 #ifdef __HUGS__
 #endif
 
 #ifdef __HUGS__
@@ -202,20 +246,23 @@ stdout = unsafePerformIO (do
   )
 
 stdin = unsafePerformIO (do
   )
 
 stdin = unsafePerformIO (do
-    rc <- CCALL(getLock) 0 0   -- ConcHask: SAFE, won't block
-    case rc of
+    rc <- CCALL(getLock) (0::Int) (0::Int)   -- ConcHask: SAFE, won't block
+    case (rc::Int) of
        0 -> newHandle (mkClosedHandle__)
        1 -> do
 #ifndef __CONCURRENT_HASKELL__
        0 -> newHandle (mkClosedHandle__)
        1 -> do
 #ifndef __CONCURRENT_HASKELL__
-           fo <- CCALL(openStdFile) 0 0{-don't flush on close -} 1{-readable-}  -- ConcHask: SAFE, won't block
+           fo <- CCALL(openStdFile) (0::Int)
+                                    (0::Int){-don't flush on close -}
+                                    (1::Int){-readable-}  -- ConcHask: SAFE, won't block
 #else
 #else
-           fo <- CCALL(openStdFile) 0 (0{-flush on close-} {- + 128  don't block on I/O-})
-                                       1{-readable-}  -- ConcHask: SAFE, won't block
+           fo <- CCALL(openStdFile) (0::Int)
+                                    ((0{-flush on close-} + 128 {- don't block on I/O-})::Int)
+                                    (1::Int){-readable-}  -- ConcHask: SAFE, won't block
 #endif
 
 #ifndef __PARALLEL_HASKELL__
             fo <- makeForeignObj fo
 #endif
 
 #ifndef __PARALLEL_HASKELL__
             fo <- makeForeignObj fo
-           addForeignFinaliser fo (freeStdFileObject fo)
+           addForeignFinalizer fo (freeStdFileObject fo)
 #endif
            (bm, bf_size) <- getBMode__ fo
            mkBuffer__ fo bf_size
 #endif
            (bm, bf_size) <- getBMode__ fo
            mkBuffer__ fo bf_size
@@ -231,22 +278,31 @@ stdin = unsafePerformIO (do
 
 
 stderr = unsafePerformIO (do
 
 
 stderr = unsafePerformIO (do
-    rc <- CCALL(getLock) 2 1  -- ConcHask: SAFE, won't block
-    case rc of
+    rc <- CCALL(getLock) (2::Int) (1::Int){-writeable-}  -- ConcHask: SAFE, won't block
+    case (rc::Int) of
        0 -> newHandle (mkClosedHandle__)
        1 -> do
 #ifndef __CONCURRENT_HASKELL__
        0 -> newHandle (mkClosedHandle__)
        1 -> do
 #ifndef __CONCURRENT_HASKELL__
-           fo <- CCALL(openStdFile) 2 1{-flush on close-} 0{-writeable-} -- ConcHask: SAFE, won't block
+           fo <- CCALL(openStdFile) (2::Int)
+                                    (1::Int){-flush on close-}
+                                    (0::Int){-writeable-} -- ConcHask: SAFE, won't block
 #else
 #else
-           fo <- CCALL(openStdFile) 2 (1{-flush on close-} {- + 128  don't block on I/O-})
-                                       0{-writeable-} -- ConcHask: SAFE, won't block
+           fo <- CCALL(openStdFile) (2::Int)
+                                    ((1{-flush on close-} + 128 {- don't block on I/O-})::Int)
+                                    (0::Int){-writeable-} -- ConcHask: SAFE, won't block
 #endif
 
 #ifndef __PARALLEL_HASKELL__
             fo <- makeForeignObj fo
 #endif
 
 #ifndef __PARALLEL_HASKELL__
             fo <- makeForeignObj fo
-           addForeignFinaliser fo (freeStdFileObject fo)
+           addForeignFinalizer fo (freeStdFileObject fo)
 #endif
 #endif
-            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.
+           hConnectTo stdout hdl
+           return hdl
+
        _ -> do ioError <- constructError "stderr"
                newHandle (mkErrorHandle__ ioError)
   )
        _ -> do ioError <- constructError "stderr"
                newHandle (mkErrorHandle__ ioError)
   )
@@ -273,11 +329,13 @@ openFile fp im = openFileEx fp (TextMode im)
 openFileEx :: FilePath -> IOModeEx -> IO Handle
 
 openFileEx f m = do
 openFileEx :: FilePath -> IOModeEx -> IO Handle
 
 openFileEx f m = do
-    fo <- CCALL(openFile) (primPackString f) file_mode binary file_flags -- ConcHask: SAFE, won't block
+    fo <- CCALL(openFile) (primPackString f) (file_mode::Int) 
+                                            (binary::Int)
+                                            (file_flags::Int) -- ConcHask: SAFE, won't block
     if fo /= nullAddr then do
 #ifndef __PARALLEL_HASKELL__
        fo  <- makeForeignObj fo
     if fo /= nullAddr then do
 #ifndef __PARALLEL_HASKELL__
        fo  <- makeForeignObj fo
-       addForeignFinaliser fo (freeFileObject fo)
+       addForeignFinalizer fo (freeFileObject fo)
 #endif
        (bm, bf_size)  <- getBMode__ fo
         mkBuffer__ fo bf_size
 #endif
        (bm, bf_size)  <- getBMode__ fo
         mkBuffer__ fo bf_size
@@ -287,13 +345,15 @@ openFileEx f m = do
   where
     (imo, binary) =
       case m of
   where
     (imo, binary) =
       case m of
-        BinaryMode imo -> (imo, 1)
-       TextMode imo   -> (imo, 0)
+        BinaryMode bmo -> (bmo, 1)
+       TextMode tmo   -> (tmo, 0)
 
 #ifndef __CONCURRENT_HASKELL__
     file_flags = file_flags'
 #else
 
 #ifndef __CONCURRENT_HASKELL__
     file_flags = file_flags'
 #else
-    file_flags = file_flags' {-+ 128  Don't block on I/O-}
+       -- See comment next to 'stderr' for why we leave
+       -- non-blocking off for now.
+    file_flags = file_flags' + 128  -- Don't block on I/O
 #endif
 
     (file_flags', file_mode) =
 #endif
 
     (file_flags', file_mode) =
@@ -338,31 +398,24 @@ implementation is free to impose stricter conditions.
 hClose :: Handle -> IO ()
 
 hClose handle =
 hClose :: Handle -> IO ()
 
 hClose handle =
-    withHandle handle $ \ handle_ -> do
+    withHandle__ handle $ \ handle_ -> do
     case haType__ handle_ of 
     case haType__ handle_ of 
-      ErrorHandle ioError -> do
-         writeHandle handle handle_
-         fail ioError
-      ClosedHandle -> do
-          writeHandle handle handle_
-         ioe_closedHandle "hClose" handle 
+      ErrorHandle theError -> ioError theError
+      ClosedHandle        -> return handle_
       _ -> do
       _ -> do
-          rc      <- CCALL(closeFile) (haFO__ handle_) 1{-flush if you can-}  -- ConcHask: SAFE, won't block
+          rc      <- CCALL(closeFile) (haFO__ handle_) (1::Int){-flush if you can-}  -- ConcHask: SAFE, won't block
           {- We explicitly close a file object so that we can be told
              if there were any errors. Note that after @hClose@
              has been performed, the ForeignObj embedded in the Handle
              is still lying around in the heap, so care is taken
              to avoid closing the file object when the ForeignObj
           {- We explicitly close a file object so that we can be told
              if there were any errors. Note that after @hClose@
              has been performed, the ForeignObj embedded in the Handle
              is still lying around in the heap, so care is taken
              to avoid closing the file object when the ForeignObj
-             is finalised. (we overwrite the file ptr in the underlying
+             is finalized. (we overwrite the file ptr in the underlying
             FileObject with a NULL as part of closeFile())
          -}
             FileObject with a NULL as part of closeFile())
          -}
-          if rc == 0 
-          then
-             writeHandle handle (handle_{ haType__   = ClosedHandle,
-                                          haFO__     = nullFile__ })
-           else do
-            writeHandle handle handle_
-            constructErrorAndFail "hClose"
+          if rc == (0::Int)
+          then return (handle_{ haType__   = ClosedHandle,
+                                haFO__     = nullFile__ })
+           else constructErrorAndFail "hClose"
 
 \end{code}
 
 
 \end{code}
 
@@ -384,29 +437,22 @@ which can be read from {\em hdl}.
 \begin{code}
 hFileSize :: Handle -> IO Integer
 hFileSize handle =
 \begin{code}
 hFileSize :: Handle -> IO Integer
 hFileSize handle =
-    withHandle handle $ \ handle_ -> do
+    withHandle_ handle $ \ handle_ -> do
     case haType__ handle_ of 
     case haType__ handle_ of 
-      ErrorHandle ioError -> do
-         writeHandle handle handle_
-         fail ioError
-      ClosedHandle -> do
-         writeHandle handle handle_
-         ioe_closedHandle "hFileSize" handle
-      SemiClosedHandle -> do
-         writeHandle handle handle_
-         ioe_closedHandle "hFileSize" handle
+      ErrorHandle theError     -> ioError theError
+      ClosedHandle             -> ioe_closedHandle "hFileSize" handle
+      SemiClosedHandle                 -> ioe_closedHandle "hFileSize" handle
 #ifdef __HUGS__
 #ifdef __HUGS__
-      other -> do
+      _ -> do
           mem <- primNewByteArray sizeof_int64
           rc <- CCALL(fileSize_int64) (haFO__ handle_) mem  -- ConcHask: SAFE, won't block
           mem <- primNewByteArray sizeof_int64
           rc <- CCALL(fileSize_int64) (haFO__ handle_) mem  -- ConcHask: SAFE, won't block
-          writeHandle handle handle_
           if rc == 0 then do
             result <- primReadInt64Array mem 0
              return (primInt64ToInteger result)
            else 
              constructErrorAndFail "hFileSize"
 #else
           if rc == 0 then do
             result <- primReadInt64Array mem 0
              return (primInt64ToInteger result)
            else 
              constructErrorAndFail "hFileSize"
 #else
-      other ->
+      _ ->
           -- HACK!  We build a unique MP_INT of the right shape to hold
           -- a single unsigned word, and we let the C routine 
          -- change the data bits
           -- HACK!  We build a unique MP_INT of the right shape to hold
           -- a single unsigned word, and we let the C routine 
          -- change the data bits
@@ -414,12 +460,11 @@ hFileSize handle =
          -- For some reason, this fails to typecheck if converted to a do
          -- expression --SDM
           _casm_ ``%r = 1;'' >>= \(I# hack#) ->
          -- For some reason, this fails to typecheck if converted to a do
          -- expression --SDM
           _casm_ ``%r = 1;'' >>= \(I# hack#) ->
-          case int2Integer hack# of
-            result@(J# _ _ d#) -> do
-                rc <- CCALL(fileSize) (haFO__ handle_) d#  -- ConcHask: SAFE, won't block
-                writeHandle handle handle_
-                if rc == 0 then
-                  return result
+          case int2Integer# hack# of
+              (# s, d #) -> do
+                rc <- CCALL(fileSize) (haFO__ handle_) d  -- ConcHask: SAFE, won't block
+                if rc == (0::Int) then
+                  return (J# s d)
                  else
                   constructErrorAndFail "hFileSize"
 #endif
                  else
                   constructErrorAndFail "hFileSize"
 #endif
@@ -436,7 +481,6 @@ hIsEOF handle =
     wantReadableHandle "hIsEOF" handle $ \ handle_ -> do
     let fo = haFO__ handle_
     rc      <- mayBlock fo (CCALL(fileEOF) fo)  -- ConcHask: UNSAFE, may block
     wantReadableHandle "hIsEOF" handle $ \ handle_ -> do
     let fo = haFO__ handle_
     rc      <- mayBlock fo (CCALL(fileEOF) fo)  -- ConcHask: UNSAFE, may block
-    writeHandle handle handle_
     case rc of
       0 -> return False
       1 -> return True
     case rc of
       0 -> return False
       1 -> return True
@@ -484,19 +528,16 @@ hSetBuffering :: Handle -> BufferMode -> IO ()
 hSetBuffering handle mode =
     case mode of
       BlockBuffering (Just n) 
 hSetBuffering handle mode =
     case mode of
       BlockBuffering (Just n) 
-        | n <= 0 -> fail (IOError (Just handle)
+        | n <= 0 -> ioError
+                        (IOError (Just handle)
                                  InvalidArgument
                                  "hSetBuffering"
                                  ("illegal buffer size " ++ showsPrec 9 n []))  -- 9 => should be parens'ified.
       _ ->
                                  InvalidArgument
                                  "hSetBuffering"
                                  ("illegal buffer size " ++ showsPrec 9 n []))  -- 9 => should be parens'ified.
       _ ->
-          withHandle handle $ \ handle_ -> do
+          withHandle__ handle $ \ handle_ -> do
           case haType__ handle_ of
           case haType__ handle_ of
-            ErrorHandle ioError -> do
-               writeHandle handle handle_
-               fail ioError
-             ClosedHandle -> do
-               writeHandle handle handle_
-               ioe_closedHandle "hSetBuffering" handle
+            ErrorHandle theError -> ioError theError
+             ClosedHandle        -> ioe_closedHandle "hSetBuffering" handle
              _ -> do
                {- Note:
                    - we flush the old buffer regardless of whether
              _ -> do
                {- Note:
                    - we flush the old buffer regardless of whether
@@ -512,10 +553,9 @@ hSetBuffering handle mode =
                 rc <- mayBlock fo (CCALL(setBuffering) fo bsize) -- ConcHask: UNSAFE, may block
                 if rc == 0 
                 then do
                 rc <- mayBlock fo (CCALL(setBuffering) fo bsize) -- ConcHask: UNSAFE, may block
                 if rc == 0 
                 then do
-                  writeHandle handle (handle_{ haBufferMode__ = mode })
+                  return (handle_{ haBufferMode__ = mode })
                  else do
                   -- Note: failure to change the buffer size will cause old buffer to be flushed.
                  else do
                   -- Note: failure to change the buffer size will cause old buffer to be flushed.
-                  writeHandle handle handle_
                   constructErrorAndFail "hSetBuffering"
   where
     bsize :: Int
                   constructErrorAndFail "hSetBuffering"
   where
     bsize :: Int
@@ -536,7 +576,6 @@ hFlush handle =
     wantWriteableHandle "hFlush" handle $ \ handle_ -> do
     let fo = haFO__ handle_
     rc     <- mayBlock fo (CCALL(flushFile) fo)   -- ConcHask: UNSAFE, may block
     wantWriteableHandle "hFlush" handle $ \ handle_ -> do
     let fo = haFO__ handle_
     rc     <- mayBlock fo (CCALL(flushFile) fo)   -- ConcHask: UNSAFE, may block
-    writeHandle handle handle_
     if rc == 0 then 
        return ()
      else
     if rc == 0 then 
        return ()
      else
@@ -571,8 +610,7 @@ hGetPosn :: Handle -> IO HandlePosn
 hGetPosn handle =
     wantSeekableHandle "hGetPosn" handle $ \ handle_ -> do
     posn    <- CCALL(getFilePosn) (haFO__ handle_)   -- ConcHask: SAFE, won't block
 hGetPosn handle =
     wantSeekableHandle "hGetPosn" handle $ \ handle_ -> do
     posn    <- CCALL(getFilePosn) (haFO__ handle_)   -- ConcHask: SAFE, won't block
-    writeHandle handle handle_
-    if posn /= -1 then
+    if posn /= -1 then do
       return (HandlePosn handle posn)
      else
       constructErrorAndFail "hGetPosn"
       return (HandlePosn handle posn)
      else
       constructErrorAndFail "hGetPosn"
@@ -582,8 +620,7 @@ hSetPosn (HandlePosn handle posn) =
     wantSeekableHandle "hSetPosn" handle $ \ handle_ -> do -- not as silly as it looks: the handle may have been closed in the meantime.
     let fo = haFO__ handle_
     rc     <- mayBlock fo (CCALL(setFilePosn) fo posn)    -- ConcHask: UNSAFE, may block
     wantSeekableHandle "hSetPosn" handle $ \ handle_ -> do -- not as silly as it looks: the handle may have been closed in the meantime.
     let fo = haFO__ handle_
     rc     <- mayBlock fo (CCALL(setFilePosn) fo posn)    -- ConcHask: UNSAFE, may block
-    writeHandle handle handle_
-    if rc == 0 then 
+    if rc == 0 then do
        return ()
      else
        constructErrorAndFail "hSetPosn"
        return ()
      else
        constructErrorAndFail "hSetPosn"
@@ -620,13 +657,13 @@ hSeek handle mode offset =
     let fo = haFO__ handle_
     rc      <- mayBlock fo (CCALL(seekFile_int64) fo whence (primIntegerToInt64 offset))  -- ConcHask: UNSAFE, may block
 #else
     let fo = haFO__ handle_
     rc      <- mayBlock fo (CCALL(seekFile_int64) fo whence (primIntegerToInt64 offset))  -- ConcHask: UNSAFE, may block
 #else
-hSeek handle mode offset@(J# _ s# d#) =
+hSeek handle mode i@(S# _) = hSeek handle mode (toBig i)
+hSeek handle mode (J# s# d#) =
     wantSeekableHandle "hSeek" handle $ \ handle_ -> do
     let fo = haFO__ handle_
     rc      <- mayBlock fo (CCALL(seekFile) fo whence (I# s#) d#)  -- ConcHask: UNSAFE, may block
 #endif
     wantSeekableHandle "hSeek" handle $ \ handle_ -> do
     let fo = haFO__ handle_
     rc      <- mayBlock fo (CCALL(seekFile) fo whence (I# s#) d#)  -- ConcHask: UNSAFE, may block
 #endif
-    writeHandle handle handle_
-    if rc == 0 then 
+    if rc == 0 then do
        return ()
      else
        constructErrorAndFail "hSeek"
        return ()
      else
        constructErrorAndFail "hSeek"
@@ -657,34 +694,20 @@ $( Just n )$ for block-buffering of {\em n} bytes.
 \begin{code}
 hIsOpen :: Handle -> IO Bool
 hIsOpen handle =
 \begin{code}
 hIsOpen :: Handle -> IO Bool
 hIsOpen handle =
-    withHandle handle $ \ handle_ -> do
+    withHandle_ handle $ \ handle_ -> do
     case haType__ handle_ of 
     case haType__ handle_ of 
-      ErrorHandle ioError -> do
-         writeHandle handle handle_
-          fail ioError
-      ClosedHandle -> do
-         writeHandle handle handle_
-         return False
-      SemiClosedHandle -> do
-         writeHandle handle handle_
-         return False
-      _ -> do
-         writeHandle handle handle_
-         return True
+      ErrorHandle theError -> ioError theError
+      ClosedHandle         -> return False
+      SemiClosedHandle     -> return False
+      _                   -> return True
 
 hIsClosed :: Handle -> IO Bool
 hIsClosed handle =
 
 hIsClosed :: Handle -> IO Bool
 hIsClosed handle =
-    withHandle handle $ \ handle_ -> do
+    withHandle_ handle $ \ handle_ -> do
     case haType__ handle_ of 
     case haType__ handle_ of 
-      ErrorHandle ioError -> do
-         writeHandle handle handle_
-          fail ioError
-      ClosedHandle -> do
-         writeHandle handle handle_
-         return True
-      _ -> do
-         writeHandle handle handle_
-         return False
+      ErrorHandle theError -> ioError theError
+      ClosedHandle        -> return True
+      _                   -> return False
 
 {- not defined, nor exported, but mentioned
    here for documentation purposes:
 
 {- not defined, nor exported, but mentioned
    here for documentation purposes:
@@ -698,20 +721,12 @@ hIsClosed handle =
 
 hIsReadable :: Handle -> IO Bool
 hIsReadable handle =
 
 hIsReadable :: Handle -> IO Bool
 hIsReadable handle =
-    withHandle handle $ \ handle_ -> do
+    withHandle_ handle $ \ handle_ -> do
     case haType__ handle_ of 
     case haType__ handle_ of 
-      ErrorHandle ioError -> do
-         writeHandle handle handle_
-          fail ioError
-      ClosedHandle -> do
-         writeHandle handle handle_
-          ioe_closedHandle "hIsReadable" handle
-      SemiClosedHandle -> do
-         writeHandle handle handle_
-          ioe_closedHandle "hIsReadable" handle
-      htype -> do
-         writeHandle handle handle_
-         return (isReadable htype)
+      ErrorHandle theError -> ioError theError
+      ClosedHandle        -> ioe_closedHandle "hIsReadable" handle
+      SemiClosedHandle            -> ioe_closedHandle "hIsReadable" handle
+      htype               -> return (isReadable htype)
   where
     isReadable ReadHandle      = True
     isReadable ReadWriteHandle = True
   where
     isReadable ReadHandle      = True
     isReadable ReadWriteHandle = True
@@ -719,20 +734,12 @@ hIsReadable handle =
 
 hIsWritable :: Handle -> IO Bool
 hIsWritable handle =
 
 hIsWritable :: Handle -> IO Bool
 hIsWritable handle =
-    withHandle handle $ \ handle_ -> do
+    withHandle_ handle $ \ handle_ -> do
     case haType__ handle_ of 
     case haType__ handle_ of 
-      ErrorHandle ioError -> do
-         writeHandle handle handle_
-          fail ioError
-      ClosedHandle -> do
-         writeHandle handle handle_
-          ioe_closedHandle "hIsWritable" handle
-      SemiClosedHandle -> do
-         writeHandle handle handle_
-          ioe_closedHandle "hIsWritable" handle
-      htype -> do
-         writeHandle handle handle_
-         return (isWritable htype)
+      ErrorHandle theError -> ioError theError
+      ClosedHandle        -> ioe_closedHandle "hIsWritable" handle
+      SemiClosedHandle            -> ioe_closedHandle "hIsWritable" handle
+      htype               -> return (isWritable htype)
   where
     isWritable AppendHandle    = True
     isWritable WriteHandle     = True
   where
     isWritable AppendHandle    = True
     isWritable WriteHandle     = True
@@ -763,46 +770,30 @@ Querying how a handle buffers its data:
 \begin{code}
 hGetBuffering :: Handle -> IO BufferMode
 hGetBuffering handle = 
 \begin{code}
 hGetBuffering :: Handle -> IO BufferMode
 hGetBuffering handle = 
-    withHandle handle $ \ handle_ -> do
+    withHandle_ handle $ \ handle_ -> do
     case haType__ handle_ of 
     case haType__ handle_ of 
-      ErrorHandle ioError -> do
-         writeHandle handle handle_
-          fail ioError
-      ClosedHandle -> do
-         writeHandle handle handle_
-          ioe_closedHandle "hGetBuffering" handle
-      _ -> do
+      ErrorHandle theError -> ioError theError
+      ClosedHandle        -> ioe_closedHandle "hGetBuffering" handle
+      _ -> 
          {-
           We're being non-standard here, and allow the buffering
           of a semi-closed handle to be queried.   -- sof 6/98
           -}
          {-
           We're being non-standard here, and allow the buffering
           of a semi-closed handle to be queried.   -- sof 6/98
           -}
-         let v = haBufferMode__ handle_
-         writeHandle handle handle_
-         return v  -- could be stricter..
-
+         return (haBufferMode__ handle_)  -- could be stricter..
 \end{code}
 
 \begin{code}
 hIsSeekable :: Handle -> IO Bool
 hIsSeekable handle =
 \end{code}
 
 \begin{code}
 hIsSeekable :: Handle -> IO Bool
 hIsSeekable handle =
-    withHandle handle $ \ handle_ -> do
+    withHandle_ handle $ \ handle_ -> do
     case haType__ handle_ of 
     case haType__ handle_ of 
-      ErrorHandle ioError -> do
-         writeHandle handle handle_
-          fail ioError
-      ClosedHandle -> do
-         writeHandle handle handle_
-          ioe_closedHandle "hIsSeekable" handle
-      SemiClosedHandle -> do
-         writeHandle handle handle_
-          ioe_closedHandle "hIsSeekable" handle
-      AppendHandle -> do
-         writeHandle handle handle_
-         return False
-      other -> do
+      ErrorHandle theError -> ioError theError
+      ClosedHandle        -> ioe_closedHandle "hIsSeekable" handle
+      SemiClosedHandle            -> ioe_closedHandle "hIsSeekable" handle
+      AppendHandle        -> return False
+      _ -> do
          rc <- CCALL(seekFileP) (haFO__ handle_)   -- ConcHask: SAFE, won't block
          rc <- CCALL(seekFileP) (haFO__ handle_)   -- ConcHask: SAFE, won't block
-         writeHandle handle handle_
-         case rc of
+         case (rc::Int) of
             0 -> return False
             1 -> return True
             _ -> constructErrorAndFail "hIsSeekable"
             0 -> return False
             1 -> return True
             _ -> constructErrorAndFail "hIsSeekable"
@@ -825,18 +816,13 @@ hSetEcho handle on = do
     if not isT
      then return ()
      else
     if not isT
      then return ()
      else
-      withHandle handle $ \ handle_ -> do
+      withHandle_ handle $ \ handle_ -> do
       case haType__ handle_ of 
       case haType__ handle_ of 
-         ErrorHandle ioError ->  do 
-            writeHandle handle handle_
-           fail ioError
-         ClosedHandle     ->  do
-            writeHandle handle handle_
-           ioe_closedHandle "hSetEcho" handle
-         other -> do
-            rc <- CCALL(setTerminalEcho) (haFO__ handle_) (if on then 1 else 0)  -- ConcHask: SAFE, won't block
-           writeHandle handle handle_
-           if rc /= -1
+         ErrorHandle theError -> ioError theError
+         ClosedHandle        -> ioe_closedHandle "hSetEcho" handle
+         _ -> do
+            rc <- CCALL(setTerminalEcho) (haFO__ handle_) ((if on then 1 else 0)::Int)  -- ConcHask: SAFE, won't block
+           if rc /= ((-1)::Int)
             then return ()
             else constructErrorAndFail "hSetEcho"
 
             then return ()
             else constructErrorAndFail "hSetEcho"
 
@@ -846,36 +832,26 @@ hGetEcho handle = do
     if not isT
      then return False
      else
     if not isT
      then return False
      else
-       withHandle handle $ \ handle_ -> do
+       withHandle_ handle $ \ handle_ -> do
        case haType__ handle_ of 
        case haType__ handle_ of 
-         ErrorHandle ioError ->  do 
-            writeHandle handle handle_
-           fail ioError
-         ClosedHandle     ->  do
-            writeHandle handle handle_
-           ioe_closedHandle "hGetEcho" handle
-         other -> do
+         ErrorHandle theError -> ioError theError
+         ClosedHandle        -> ioe_closedHandle "hGetEcho" handle
+         _ -> do
             rc <- CCALL(getTerminalEcho) (haFO__ handle_)  -- ConcHask: SAFE, won't block
             rc <- CCALL(getTerminalEcho) (haFO__ handle_)  -- ConcHask: SAFE, won't block
-           writeHandle handle handle_
-           case rc of
+           case (rc::Int) of
              1 -> return True
              0 -> return False
              _ -> constructErrorAndFail "hSetEcho"
 
 hIsTerminalDevice :: Handle -> IO Bool
 hIsTerminalDevice handle = do
              1 -> return True
              0 -> return False
              _ -> constructErrorAndFail "hSetEcho"
 
 hIsTerminalDevice :: Handle -> IO Bool
 hIsTerminalDevice handle = do
-    withHandle handle $ \ handle_ -> do
-    case haType__ handle_ of 
-       ErrorHandle ioError ->  do 
-            writeHandle handle handle_
-           fail ioError
-       ClosedHandle       ->  do
-            writeHandle handle handle_
-           ioe_closedHandle "hIsTerminalDevice" handle
-       other -> do
+    withHandle_ handle $ \ handle_ -> do
+     case haType__ handle_ of 
+       ErrorHandle theError -> ioError theError
+       ClosedHandle        -> ioe_closedHandle "hIsTerminalDevice" handle
+       _ -> do
           rc <- CCALL(isTerminalDevice) (haFO__ handle_)   -- ConcHask: SAFE, won't block
           rc <- CCALL(isTerminalDevice) (haFO__ handle_)   -- ConcHask: SAFE, won't block
-         writeHandle handle handle_
-         case rc of
+         case (rc::Int) of
            1 -> return True
            0 -> return False
            _ -> constructErrorAndFail "hIsTerminalDevice"
            1 -> return True
            0 -> return False
            _ -> constructErrorAndFail "hIsTerminalDevice"
@@ -889,13 +865,19 @@ hConnectTo :: Handle -> Handle -> IO ()
 hConnectTo hW hR = hConnectHdl_ hW hR 0{-connect regardless-}
 
 hConnectHdl_ :: Handle -> Handle -> Int -> IO ()
 hConnectTo hW hR = hConnectHdl_ hW hR 0{-connect regardless-}
 
 hConnectHdl_ :: Handle -> Handle -> Int -> IO ()
-hConnectHdl_ hW hR is_tty = 
-  wantWriteableHandle "hConnectTo" hW $ \ hW_ -> do
-  wantReadableHandle  "hConnectTo" hR $ \ hR_ -> do
+hConnectHdl_ hW hR is_tty =
+  wantRWHandle "hConnectTo" hW $ \ hW_ ->
+  wantRWHandle "hConnectTo" hR $ \ hR_ -> do
   CCALL(setConnectedTo) (haFO__ hR_) (haFO__ hW_) is_tty  -- ConcHask: SAFE, won't block
   CCALL(setConnectedTo) (haFO__ hR_) (haFO__ hW_) is_tty  -- ConcHask: SAFE, won't block
-  writeHandle hR hR_
-  writeHandle hW hW_
 
 
+#ifndef __PARALLEL_HASKELL__
+#define FILE_OBJECT     ForeignObj
+#else
+#define FILE_OBJECT     Addr
+#endif
+
+flushConnectedBuf :: FILE_OBJECT -> IO ()
+flushConnectedBuf fo = CCALL(flushConnectedBuf) fo
 \end{code}
 
 As an extension, we also allow characters to be pushed back.
 \end{code}
 
 As an extension, we also allow characters to be pushed back.
@@ -908,8 +890,7 @@ hUngetChar :: Handle -> Char -> IO ()
 hUngetChar handle c = 
     wantReadableHandle "hLookAhead" handle $ \ handle_ -> do
     rc      <- CCALL(ungetChar) (haFO__ handle_) c  -- ConcHask: SAFE, won't block
 hUngetChar handle c = 
     wantReadableHandle "hLookAhead" handle $ \ handle_ -> do
     rc      <- CCALL(ungetChar) (haFO__ handle_) c  -- ConcHask: SAFE, won't block
-    writeHandle handle handle_
-    if rc == (-1)
+    if rc == ((-1)::Int)
      then constructErrorAndFail "hUngetChar"
      else return ()
 
      then constructErrorAndFail "hUngetChar"
      else return ()
 
@@ -926,7 +907,7 @@ slurpFile fname = do
   handle <- openFile fname ReadMode
   sz     <- hFileSize handle
   if sz > toInteger (maxBound::Int) then 
   handle <- openFile fname ReadMode
   sz     <- hFileSize handle
   if sz > toInteger (maxBound::Int) then 
-    fail (userError "slurpFile: file too big")
+    ioError (userError "slurpFile: file too big")
    else do
      let sz_i = fromInteger sz
      chunk <- CCALL(allocMemory__) (sz_i::Int)
    else do
      let sz_i = fromInteger sz
      chunk <- CCALL(allocMemory__) (sz_i::Int)
@@ -934,20 +915,20 @@ slurpFile fname = do
       then do
         hClose handle
         constructErrorAndFail "slurpFile"
       then do
         hClose handle
         constructErrorAndFail "slurpFile"
-      else
-        withHandle handle $ \ handle_ -> do
-        let fo = haFO__ handle_
-       rc      <- mayBlock fo (CCALL(readChunk) fo chunk sz_i)    -- ConcHask: UNSAFE, may block.
-        writeHandle handle handle_
+      else do
+        rc <- withHandle_ handle ( \ handle_ -> do
+          let fo = haFO__ handle_
+         mayBlock fo (CCALL(readChunk) fo chunk sz_i)    -- ConcHask: UNSAFE, may block.
+        )
        hClose handle
        hClose handle
-        if rc < 0
+        if rc < (0::Int)
         then constructErrorAndFail "slurpFile"
         else return (chunk, rc)
 
 #ifndef __HUGS__ /* Hugs' Prelude doesn't need this */
 hFillBufBA :: Handle -> ByteArray Int -> Int -> IO Int
 hFillBufBA handle buf sz
         then constructErrorAndFail "slurpFile"
         else return (chunk, rc)
 
 #ifndef __HUGS__ /* Hugs' Prelude doesn't need this */
 hFillBufBA :: Handle -> ByteArray Int -> Int -> IO Int
 hFillBufBA handle buf sz
-  | sz <= 0 = fail (IOError (Just handle)
+  | sz <= 0 = ioError (IOError (Just handle)
                            InvalidArgument
                            "hFillBufBA"
                            ("illegal buffer size " ++ showsPrec 9 sz []))  -- 9 => should be parens'ified.
                            InvalidArgument
                            "hFillBufBA"
                            ("illegal buffer size " ++ showsPrec 9 sz []))  -- 9 => should be parens'ified.
@@ -959,15 +940,14 @@ hFillBufBA handle buf sz
 #else
     rc      <- mayBlock fo (CCALL(readChunk) fo buf sz)    -- ConcHask: UNSAFE, may block.
 #endif
 #else
     rc      <- mayBlock fo (CCALL(readChunk) fo buf sz)    -- ConcHask: UNSAFE, may block.
 #endif
-    writeHandle handle handle_
-    if rc >= 0
+    if rc >= (0::Int)
      then return rc
      else constructErrorAndFail "hFillBufBA"
 #endif
 
 hFillBuf :: Handle -> Addr -> Int -> IO Int
 hFillBuf handle buf sz
      then return rc
      else constructErrorAndFail "hFillBufBA"
 #endif
 
 hFillBuf :: Handle -> Addr -> Int -> IO Int
 hFillBuf handle buf sz
-  | sz <= 0 = fail (IOError (Just handle)
+  | sz <= 0 = ioError (IOError (Just handle)
                            InvalidArgument
                            "hFillBuf"
                            ("illegal buffer size " ++ showsPrec 9 sz []))  -- 9 => should be parens'ified.
                            InvalidArgument
                            "hFillBuf"
                            ("illegal buffer size " ++ showsPrec 9 sz []))  -- 9 => should be parens'ified.
@@ -975,7 +955,6 @@ hFillBuf handle buf sz
     wantReadableHandle "hFillBuf" handle $ \ handle_ -> do
     let fo  = haFO__ handle_
     rc      <- mayBlock fo (CCALL(readChunk) fo buf sz)    -- ConcHask: UNSAFE, may block.
     wantReadableHandle "hFillBuf" handle $ \ handle_ -> do
     let fo  = haFO__ handle_
     rc      <- mayBlock fo (CCALL(readChunk) fo buf sz)    -- ConcHask: UNSAFE, may block.
-    writeHandle handle handle_
     if rc >= 0
      then return rc
      else constructErrorAndFail "hFillBuf"
     if rc >= 0
      then return rc
      else constructErrorAndFail "hFillBuf"
@@ -991,19 +970,17 @@ hPutBuf handle buf len =
     wantWriteableHandle "hPutBuf" handle $ \ handle_ -> do
     let fo  = haFO__ handle_
     rc      <- mayBlock fo (CCALL(writeBuf) fo buf len)  -- ConcHask: UNSAFE, may block.
     wantWriteableHandle "hPutBuf" handle $ \ handle_ -> do
     let fo  = haFO__ handle_
     rc      <- mayBlock fo (CCALL(writeBuf) fo buf len)  -- ConcHask: UNSAFE, may block.
-    writeHandle handle handle_
-    if rc == 0
+    if rc == (0::Int)
      then return ()
      else constructErrorAndFail "hPutBuf"
 
      then return ()
      else constructErrorAndFail "hPutBuf"
 
-#ifndef __HUGS__ /* Another one Hugs doesn't provide */
+#ifndef __HUGS__ /* An_ one Hugs doesn't provide */
 hPutBufBA :: Handle -> ByteArray Int -> Int -> IO ()
 hPutBufBA handle buf len =
     wantWriteableHandle "hPutBufBA" handle $ \ handle_ -> do
     let fo = haFO__ handle_
     rc      <- mayBlock fo (CCALL(writeBufBA) fo buf len)  -- ConcHask: UNSAFE, may block.
 hPutBufBA :: Handle -> ByteArray Int -> Int -> IO ()
 hPutBufBA handle buf len =
     wantWriteableHandle "hPutBufBA" handle $ \ handle_ -> do
     let fo = haFO__ handle_
     rc      <- mayBlock fo (CCALL(writeBufBA) fo buf len)  -- ConcHask: UNSAFE, may block.
-    writeHandle handle handle_
-    if rc == 0
+    if rc == (0::Int)
      then return ()
      else constructErrorAndFail "hPutBuf"
 #endif
      then return ()
      else constructErrorAndFail "hPutBuf"
 #endif
@@ -1014,18 +991,13 @@ the Handle contains..
 
 \begin{code}
 getHandleFd :: Handle -> IO Int
 
 \begin{code}
 getHandleFd :: Handle -> IO Int
-getHandleFd handle = do
-    withHandle handle $ \ handle_ -> do
+getHandleFd handle =
+    withHandle_ handle $ \ handle_ -> do
     case (haType__ handle_) of
     case (haType__ handle_) of
-      ErrorHandle ioError -> do
-         writeHandle handle handle_
-          fail ioError
-      ClosedHandle -> do
-         writeHandle handle handle_
-         ioe_closedHandle "getHandleFd" handle
+      ErrorHandle theError -> ioError theError
+      ClosedHandle        -> ioe_closedHandle "getHandleFd" handle
       _ -> do
           fd <- CCALL(getFileFd) (haFO__ handle_)
       _ -> do
           fd <- CCALL(getFileFd) (haFO__ handle_)
-         writeHandle handle handle_
          return fd
 \end{code}
 
          return fd
 \end{code}
 
@@ -1053,35 +1025,76 @@ ioeGetErrorString (IOError _ iot _ str) =
 
 ioeGetFileName (IOError _ _  _ str) = 
  case span (/=':') str of
 
 ioeGetFileName (IOError _ _  _ str) = 
  case span (/=':') str of
-   (fs,[]) -> Nothing
+   (_,[])  -> Nothing
    (fs,_)  -> Just fs
 
 \end{code}
 
    (fs,_)  -> Just fs
 
 \end{code}
 
+'Top-level' IO actions want to catch exceptions (e.g., forkIO and 
+PrelMain.mainIO) and report them - topHandler is the exception
+handler they should use for this:
+
+\begin{code}
+-- make sure we handle errors while reporting the error!
+-- (e.g. evaluating the string passed to 'error' might generate
+--  another error, etc.)
+topHandler :: Bool -> Exception -> IO ()
+topHandler bombOut err = catchException (real_handler bombOut err) (topHandler bombOut)
+
+real_handler :: Bool -> Exception -> IO ()
+real_handler bombOut ex =
+  case ex of
+       AsyncException StackOverflow -> reportStackOverflow bombOut
+       ErrorCall s -> reportError bombOut s
+       other       -> reportError bombOut (showsPrec 0 other "\n")
+
+reportStackOverflow :: Bool -> IO ()
+reportStackOverflow bombOut = do
+   (hFlush stdout) `catchException` (\ _ -> return ())
+   callStackOverflowHook
+   if bombOut then
+     stg_exit 2
+    else
+     return ()
+
+reportError :: Bool -> String -> IO ()
+reportError bombOut str = do
+   (hFlush stdout) `catchException` (\ _ -> return ())
+   let bs@(ByteArray (_,len) _) = packString str
+   writeErrString addrOf_ErrorHdrHook bs len
+   if bombOut then
+     stg_exit 1
+    else
+     return ()
+
+foreign label "ErrorHdrHook" 
+        addrOf_ErrorHdrHook :: Addr
+
+foreign import ccall "writeErrString__" 
+       writeErrString :: Addr -> ByteArray Int -> Int -> IO ()
+
+foreign import ccall "stackOverflow"
+       callStackOverflowHook :: IO ()
+
+foreign import ccall "stg_exit"
+       stg_exit :: Int -> IO ()
+\end{code}
+
+
 A number of operations want to get at a readable or writeable handle, and fail
 if it isn't:
 
 \begin{code}
 wantReadableHandle :: String -> Handle -> (Handle__ -> IO a) -> IO a
 wantReadableHandle fun handle act = 
 A number of operations want to get at a readable or writeable handle, and fail
 if it isn't:
 
 \begin{code}
 wantReadableHandle :: String -> Handle -> (Handle__ -> IO a) -> IO a
 wantReadableHandle fun handle act = 
-    withHandle handle $ \ handle_ -> do
+    withHandle_ handle $ \ handle_ -> do
     case haType__ handle_ of 
     case haType__ handle_ of 
-      ErrorHandle ioError -> do
-         writeHandle handle handle_
-          fail ioError
-      ClosedHandle -> do
-         writeHandle handle handle_
-         ioe_closedHandle fun handle
-      SemiClosedHandle -> do
-         writeHandle handle handle_
-         ioe_closedHandle fun handle
-      AppendHandle -> do
-         writeHandle handle handle_
-         fail not_readable_error
-      WriteHandle -> do
-         writeHandle handle handle_
-         fail not_readable_error
-      other -> act handle_
+      ErrorHandle theError -> ioError theError
+      ClosedHandle        -> ioe_closedHandle fun handle
+      SemiClosedHandle            -> ioe_closedHandle fun handle
+      AppendHandle        -> ioError not_readable_error
+      WriteHandle         -> ioError not_readable_error
+      _                   -> act handle_
   where
    not_readable_error = 
           IOError (Just handle) IllegalOperation fun   
   where
    not_readable_error = 
           IOError (Just handle) IllegalOperation fun   
@@ -1089,43 +1102,36 @@ wantReadableHandle fun handle act =
 
 wantWriteableHandle :: String -> Handle -> (Handle__ -> IO a) -> IO a
 wantWriteableHandle fun handle act = 
 
 wantWriteableHandle :: String -> Handle -> (Handle__ -> IO a) -> IO a
 wantWriteableHandle fun handle act = 
-    withHandle handle $ \ handle_ -> do
+    withHandle_ handle $ \ handle_ -> do
     case haType__ handle_ of 
     case haType__ handle_ of 
-      ErrorHandle ioError -> do
-         writeHandle handle handle_
-          fail ioError
-      ClosedHandle -> do
-         writeHandle handle handle_
-         ioe_closedHandle fun handle
-      SemiClosedHandle -> do
-         writeHandle handle handle_
-         ioe_closedHandle fun handle
-      ReadHandle -> do
-         writeHandle handle handle_
-         fail not_writeable_error
-      other -> act handle_
+      ErrorHandle theError -> ioError theError
+      ClosedHandle        -> ioe_closedHandle fun handle
+      SemiClosedHandle            -> ioe_closedHandle fun handle
+      ReadHandle          -> ioError not_writeable_error
+      _                   -> act handle_
   where
    not_writeable_error = 
           IOError (Just handle) IllegalOperation fun
                   ("handle is not open for writing")
 
   where
    not_writeable_error = 
           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_
+
 wantSeekableHandle :: String -> Handle -> (Handle__ -> IO a) -> IO a
 wantSeekableHandle fun handle act =
 wantSeekableHandle :: String -> Handle -> (Handle__ -> IO a) -> IO a
 wantSeekableHandle fun handle act =
-    withHandle handle $ \ handle_ -> do
+    withHandle_ handle $ \ handle_ -> do
     case haType__ handle_ of 
     case haType__ handle_ of 
-      ErrorHandle ioError -> do
-         writeHandle handle handle_
-          fail ioError
-      ClosedHandle -> do
-         writeHandle handle handle_
-         ioe_closedHandle fun handle
-      SemiClosedHandle -> do
-         writeHandle handle handle_
-         ioe_closedHandle fun handle
-      AppendHandle -> do
-         writeHandle handle handle_
-         fail not_seekable_error
-      _ -> act handle_
+      ErrorHandle theError -> ioError theError
+      ClosedHandle        -> ioe_closedHandle fun handle
+      SemiClosedHandle    -> ioe_closedHandle fun handle
+      AppendHandle        -> ioError not_seekable_error
+      _                   -> act handle_
   where
    not_seekable_error = 
           IOError (Just handle) 
   where
    not_seekable_error = 
           IOError (Just handle) 
@@ -1139,7 +1145,7 @@ access to a closed file.
 
 \begin{code}
 ioe_closedHandle :: String -> Handle -> IO a
 
 \begin{code}
 ioe_closedHandle :: String -> Handle -> IO a
-ioe_closedHandle fun h = fail (IOError (Just h) IllegalOperation fun "handle is closed")
+ioe_closedHandle fun h = ioError (IOError (Just h) IllegalOperation fun "handle is closed")
 \end{code}
 
 Internal helper functions for Concurrent Haskell implementation
 \end{code}
 
 Internal helper functions for Concurrent Haskell implementation
@@ -1152,9 +1158,6 @@ mayBlock :: ForeignObj -> IO Int -> IO Int
 mayBlock :: Addr  -> IO Int -> IO Int
 #endif
 
 mayBlock :: Addr  -> IO Int -> IO Int
 #endif
 
-#ifndef notyet /*__CONCURRENT_HASKELL__*/
-mayBlock  _ act = act
-#else
 mayBlock fo act = do
    rc <- act
    case rc of
 mayBlock fo act = do
    rc <- act
    case rc of
@@ -1177,19 +1180,6 @@ mayBlock fo act = do
        CCALL(setNonBlockingIOFlag__) fo      -- reset file object.
        CCALL(setConnNonBlockingIOFlag__) fo  -- reset (connected) file object.
         return rc
        CCALL(setNonBlockingIOFlag__) fo      -- reset file object.
        CCALL(setConnNonBlockingIOFlag__) fo  -- reset (connected) file object.
         return rc
-
-#endif
-
-#ifdef __HUGS__
-threadDelay, threadWaitRead, threadWaitWrite :: Int -> IO ()
-
--- Hugs does actually have the primops needed to implement these
--- but, like GHC, the primops don't actually do anything...
-threadDelay     _ = return ()
-threadWaitRead  _ = return ()
-threadWaitWrite _ = return ()
-#endif
-
 \end{code}
 
 
 \end{code}
 
 
@@ -1215,55 +1205,56 @@ type FILE_OBJ  = ForeignObj -- as passed into functions
 type FILE_OBJ  = Addr
 #endif
 
 type FILE_OBJ  = Addr
 #endif
 
-foreign import stdcall "libHS_cbits.so" "setBuf"                prim_setBuf           :: FILE_OBJ -> Addr -> Int -> IO ()
-foreign import stdcall "libHS_cbits.so" "getBufSize"            prim_getBufSize       :: FILE_OBJ -> IO Int
-foreign import stdcall "libHS_cbits.so" "inputReady"            prim_inputReady       :: FILE_OBJ -> Int -> IO RC
-foreign import stdcall "libHS_cbits.so" "fileGetc"              prim_fileGetc         :: FILE_OBJ -> IO Int
-foreign import stdcall "libHS_cbits.so" "fileLookAhead"         prim_fileLookAhead    :: FILE_OBJ -> IO Int
-foreign import stdcall "libHS_cbits.so" "readBlock"             prim_readBlock        :: FILE_OBJ -> IO Int
-foreign import stdcall "libHS_cbits.so" "readLine"              prim_readLine         :: FILE_OBJ -> IO Int
-foreign import stdcall "libHS_cbits.so" "readChar"              prim_readChar         :: FILE_OBJ -> IO Int
-foreign import stdcall "libHS_cbits.so" "writeFileObject"       prim_writeFileObject  :: FILE_OBJ -> Int -> IO RC
-foreign import stdcall "libHS_cbits.so" "filePutc"              prim_filePutc         :: FILE_OBJ -> Char -> IO RC
-foreign import stdcall "libHS_cbits.so" "getBufStart"           prim_getBufStart      :: FILE_OBJ -> Int -> IO Addr
-foreign import stdcall "libHS_cbits.so" "getWriteableBuf"       prim_getWriteableBuf  :: FILE_OBJ -> IO Addr
-foreign import stdcall "libHS_cbits.so" "getBufWPtr"            prim_getBufWPtr       :: FILE_OBJ -> IO Int
-foreign import stdcall "libHS_cbits.so" "setBufWPtr"            prim_setBufWPtr       :: FILE_OBJ -> Int -> IO ()
-foreign import stdcall "libHS_cbits.so" "closeFile"             prim_closeFile        :: FILE_OBJ -> Flush -> IO RC
-foreign import stdcall "libHS_cbits.so" "fileEOF"               prim_fileEOF          :: FILE_OBJ -> IO RC
-foreign import stdcall "libHS_cbits.so" "setBuffering"           prim_setBuffering     :: FILE_OBJ -> Int -> IO RC
-foreign import stdcall "libHS_cbits.so" "flushFile"              prim_flushFile        :: FILE_OBJ -> IO RC
-foreign import stdcall "libHS_cbits.so" "getBufferMode"          prim_getBufferMode    :: FILE_OBJ -> IO RC
-foreign import stdcall "libHS_cbits.so" "seekFile_int64"         prim_seekFile_int64   :: FILE_OBJ -> Int -> Int64 -> IO RC
-foreign import stdcall "libHS_cbits.so" "seekFileP"              prim_seekFileP        :: FILE_OBJ -> IO RC
-foreign import stdcall "libHS_cbits.so" "setTerminalEcho"        prim_setTerminalEcho  :: FILE_OBJ -> Int -> IO RC
-foreign import stdcall "libHS_cbits.so" "getTerminalEcho"        prim_getTerminalEcho  :: FILE_OBJ -> IO RC
-foreign import stdcall "libHS_cbits.so" "isTerminalDevice"       prim_isTerminalDevice :: FILE_OBJ -> IO RC
-foreign import stdcall "libHS_cbits.so" "setConnectedTo"         prim_setConnectedTo   :: FILE_OBJ -> FILE_OBJ -> Int -> IO ()
-foreign import stdcall "libHS_cbits.so" "ungetChar"              prim_ungetChar        :: FILE_OBJ -> Char -> IO RC
-foreign import stdcall "libHS_cbits.so" "readChunk"              prim_readChunk        :: FILE_OBJ -> Addr          -> Int -> IO RC
-foreign import stdcall "libHS_cbits.so" "writeBuf"               prim_writeBuf         :: FILE_OBJ -> Addr -> Int -> IO RC
-foreign import stdcall "libHS_cbits.so" "getFileFd"              prim_getFileFd        :: FILE_OBJ -> IO FD
-foreign import stdcall "libHS_cbits.so" "fileSize_int64"         prim_fileSize_int64   :: FILE_OBJ -> Bytes -> IO RC
-foreign import stdcall "libHS_cbits.so" "getFilePosn"            prim_getFilePosn      :: FILE_OBJ -> IO Int
-foreign import stdcall "libHS_cbits.so" "setFilePosn"            prim_setFilePosn      :: FILE_OBJ -> Int -> IO Int
-foreign import stdcall "libHS_cbits.so" "getConnFileFd"         prim_getConnFileFd    :: FILE_OBJ -> IO FD
-foreign import stdcall "libHS_cbits.so" "allocMemory__"          prim_allocMemory__    :: Int -> IO Addr
-foreign import stdcall "libHS_cbits.so" "getLock"               prim_getLock          :: FD -> Exclusive -> IO RC
-foreign import stdcall "libHS_cbits.so" "openStdFile"           prim_openStdFile      :: FD -> OpenStdFlags -> Readable -> IO IOFileAddr
-foreign import stdcall "libHS_cbits.so" "openFile"              prim_openFile         :: CString -> How -> Binary -> OpenFlags -> IO IOFileAddr
-foreign import stdcall "libHS_cbits.so" "freeFileObject"        prim_freeFileObject    :: FILE_OBJ -> IO ()
-foreign import stdcall "libHS_cbits.so" "freeStdFileObject"     prim_freeStdFileObject :: FILE_OBJ -> IO ()
-foreign import stdcall "libHS_cbits.so" "const_BUFSIZ"          const_BUFSIZ          :: Int
-
-foreign import stdcall "libHS_cbits.so" "setConnNonBlockingIOFlag__"   prim_setConnNonBlockingIOFlag__   :: FILE_OBJ -> IO ()
-foreign import stdcall "libHS_cbits.so" "clearConnNonBlockingIOFlag__" prim_clearConnNonBlockingIOFlag__ :: FILE_OBJ -> IO ()
-foreign import stdcall "libHS_cbits.so" "setNonBlockingIOFlag__"       prim_setNonBlockingIOFlag__       :: FILE_OBJ -> IO ()
-foreign import stdcall "libHS_cbits.so" "clearNonBlockingIOFlag__"     prim_clearNonBlockingIOFlag__     :: FILE_OBJ -> IO ()
-
-foreign import stdcall "libHS_cbits.so" "getErrStr__"  prim_getErrStr__  :: IO Addr 
-foreign import stdcall "libHS_cbits.so" "getErrNo__"   prim_getErrNo__   :: IO Int  
-foreign import stdcall "libHS_cbits.so" "getErrType__" prim_getErrType__ :: IO Int  
+foreign import ccall "libHS_cbits.so" "setBuf"                unsafe prim_setBuf           :: FILE_OBJ -> Addr -> Int -> IO ()
+foreign import ccall "libHS_cbits.so" "getBufSize"            unsafe prim_getBufSize       :: FILE_OBJ -> IO Int
+foreign import ccall "libHS_cbits.so" "inputReady"            unsafe prim_inputReady       :: FILE_OBJ -> Int -> IO RC
+foreign import ccall "libHS_cbits.so" "fileGetc"              unsafe prim_fileGetc         :: FILE_OBJ -> IO Int
+foreign import ccall "libHS_cbits.so" "fileLookAhead"         unsafe prim_fileLookAhead    :: FILE_OBJ -> IO Int
+foreign import ccall "libHS_cbits.so" "readBlock"             unsafe prim_readBlock        :: FILE_OBJ -> IO Int
+foreign import ccall "libHS_cbits.so" "readLine"              unsafe prim_readLine         :: FILE_OBJ -> IO Int
+foreign import ccall "libHS_cbits.so" "readChar"              unsafe prim_readChar         :: FILE_OBJ -> IO Int
+foreign import ccall "libHS_cbits.so" "writeFileObject"       unsafe prim_writeFileObject  :: FILE_OBJ -> Int -> IO RC
+foreign import ccall "libHS_cbits.so" "filePutc"              unsafe prim_filePutc         :: FILE_OBJ -> Char -> IO RC
+foreign import ccall "libHS_cbits.so" "getBufStart"           unsafe prim_getBufStart      :: FILE_OBJ -> Int -> IO Addr
+foreign import ccall "libHS_cbits.so" "getWriteableBuf"       unsafe prim_getWriteableBuf  :: FILE_OBJ -> IO Addr
+foreign import ccall "libHS_cbits.so" "getBufWPtr"            unsafe prim_getBufWPtr       :: FILE_OBJ -> IO Int
+foreign import ccall "libHS_cbits.so" "setBufWPtr"            unsafe prim_setBufWPtr       :: FILE_OBJ -> Int -> IO ()
+foreign import ccall "libHS_cbits.so" "closeFile"             unsafe prim_closeFile        :: FILE_OBJ -> Flush -> IO RC
+foreign import ccall "libHS_cbits.so" "fileEOF"               unsafe prim_fileEOF           :: FILE_OBJ -> IO RC
+foreign import ccall "libHS_cbits.so" "setBuffering"          unsafe prim_setBuffering      :: FILE_OBJ -> Int -> IO RC
+foreign import ccall "libHS_cbits.so" "flushFile"             unsafe prim_flushFile         :: FILE_OBJ -> IO RC
+foreign import ccall "libHS_cbits.so" "flushConnectedBuf"     unsafe prim_flushConnectedBuf :: FILE_OBJ -> IO RC
+foreign import ccall "libHS_cbits.so" "getBufferMode"         unsafe prim_getBufferMode     :: FILE_OBJ -> IO RC
+foreign import ccall "libHS_cbits.so" "seekFile_int64"        unsafe prim_seekFile_int64    :: FILE_OBJ -> Int -> Int64 -> IO RC
+foreign import ccall "libHS_cbits.so" "seekFileP"             unsafe prim_seekFileP        :: FILE_OBJ -> IO RC
+foreign import ccall "libHS_cbits.so" "setTerminalEcho"       unsafe prim_setTerminalEcho  :: FILE_OBJ -> Int -> IO RC
+foreign import ccall "libHS_cbits.so" "getTerminalEcho"       unsafe prim_getTerminalEcho  :: FILE_OBJ -> IO RC
+foreign import ccall "libHS_cbits.so" "isTerminalDevice"      unsafe prim_isTerminalDevice :: FILE_OBJ -> IO RC
+foreign import ccall "libHS_cbits.so" "setConnectedTo"        unsafe prim_setConnectedTo   :: FILE_OBJ -> FILE_OBJ -> Int -> IO ()
+foreign import ccall "libHS_cbits.so" "ungetChar"             unsafe prim_ungetChar        :: FILE_OBJ -> Char -> IO RC
+foreign import ccall "libHS_cbits.so" "readChunk"             unsafe prim_readChunk        :: FILE_OBJ -> Addr          -> Int -> IO RC
+foreign import ccall "libHS_cbits.so" "writeBuf"              unsafe prim_writeBuf         :: FILE_OBJ -> Addr -> Int -> IO RC
+foreign import ccall "libHS_cbits.so" "getFileFd"             unsafe prim_getFileFd        :: FILE_OBJ -> IO FD
+foreign import ccall "libHS_cbits.so" "fileSize_int64"        unsafe prim_fileSize_int64   :: FILE_OBJ -> Bytes -> IO RC
+foreign import ccall "libHS_cbits.so" "getFilePosn"           unsafe prim_getFilePosn      :: FILE_OBJ -> IO Int
+foreign import ccall "libHS_cbits.so" "setFilePosn"           unsafe prim_setFilePosn      :: FILE_OBJ -> Int -> IO Int
+foreign import ccall "libHS_cbits.so" "getConnFileFd"         unsafe prim_getConnFileFd    :: FILE_OBJ -> IO FD
+foreign import ccall "libHS_cbits.so" "allocMemory__"         unsafe prim_allocMemory__    :: Int -> IO Addr
+foreign import ccall "libHS_cbits.so" "getLock"               unsafe prim_getLock          :: FD -> Exclusive -> IO RC
+foreign import ccall "libHS_cbits.so" "openStdFile"           unsafe prim_openStdFile      :: FD -> OpenStdFlags -> Readable -> IO IOFileAddr
+foreign import ccall "libHS_cbits.so" "openFile"              unsafe prim_openFile         :: CString -> How -> Binary -> OpenFlags -> IO IOFileAddr
+foreign import ccall "libHS_cbits.so" "freeFileObject"        unsafe prim_freeFileObject    :: FILE_OBJ -> IO ()
+foreign import ccall "libHS_cbits.so" "freeStdFileObject"     unsafe prim_freeStdFileObject :: FILE_OBJ -> IO ()
+foreign import ccall "libHS_cbits.so" "const_BUFSIZ"          unsafe const_BUFSIZ          :: Int
+
+foreign import ccall "libHS_cbits.so" "setConnNonBlockingIOFlag__"   unsafe prim_setConnNonBlockingIOFlag__   :: FILE_OBJ -> IO ()
+foreign import ccall "libHS_cbits.so" "clearConnNonBlockingIOFlag__" unsafe prim_clearConnNonBlockingIOFlag__ :: FILE_OBJ -> IO ()
+foreign import ccall "libHS_cbits.so" "setNonBlockingIOFlag__"       unsafe prim_setNonBlockingIOFlag__       :: FILE_OBJ -> IO ()
+foreign import ccall "libHS_cbits.so" "clearNonBlockingIOFlag__"     unsafe prim_clearNonBlockingIOFlag__     :: FILE_OBJ -> IO ()
+
+foreign import ccall "libHS_cbits.so" "getErrStr__"  unsafe prim_getErrStr__  :: IO Addr 
+foreign import ccall "libHS_cbits.so" "getErrNo__"   unsafe prim_getErrNo__   :: IO Int  
+foreign import ccall "libHS_cbits.so" "getErrType__" unsafe prim_getErrType__ :: IO Int  
 
 #endif
 \end{code}
 
 #endif
 \end{code}
Glasgow Haskell Compiler with heterogeneous metaprogramming (generalized arrows and modal types)