projects / ghc-hetmet.git / blobdiff
? search:
summary | shortlog | log | commit | commitdiff | tree
raw | inline | side by side
[project @ 2000-03-23 17:45:17 by simonpj]
[ghc-hetmet.git] / ghc / lib / std / PrelHandle.lhs
diff --git a/ghc/lib/std/PrelHandle.lhs b/ghc/lib/std/PrelHandle.lhs
index c1ca8b2..5372159 100644 (file)
--- a/ghc/lib/std/PrelHandle.lhs
+++ b/ghc/lib/std/PrelHandle.lhs
@@ -9,29 +9,49 @@ which are supported for them.
 
 \begin{code}
 {-# OPTIONS -fno-implicit-prelude -#include "cbits/stgio.h" #-}
 
 \begin{code}
 {-# OPTIONS -fno-implicit-prelude -#include "cbits/stgio.h" #-}
-#include "error.h"
-
+#include "cbits/stgerror.h"
 
 
+#ifndef __HUGS__ /* Hugs just includes this in PreludeBuiltin so no header needed */
 module PrelHandle where
 
 import PrelBase
 module PrelHandle where
 
 import PrelBase
-import PrelArr         ( newVar, readVar, writeVar, ByteArray )
+import PrelAddr                ( Addr, nullAddr )
+import PrelByteArr     ( ByteArray(..), MutableByteArray(..) )
 import PrelRead                ( Read )
 import PrelList        ( span )
 import PrelIOBase
 import PrelRead                ( Read )
 import PrelList        ( span )
 import PrelIOBase
+import PrelException
 import PrelMaybe       ( Maybe(..) )
 import PrelMaybe       ( Maybe(..) )
+import PrelEnum
+import PrelNum         ( toBig, Integer(..), Num(..) )
+import PrelShow
 import PrelAddr                ( Addr, nullAddr )
 import PrelAddr                ( Addr, nullAddr )
-import PrelBounded      ()   -- get at Bounded Int instance.
-import PrelNum         ( toInteger )
+import PrelReal                ( toInteger )
+import PrelPack         ( packString )
+#ifndef __PARALLEL_HASKELL__
+import PrelWeak                ( addForeignFinalizer )
+#endif
 import Ix
 
 import Ix
 
+import PrelConc
+
 #ifndef __PARALLEL_HASKELL__
 #ifndef __PARALLEL_HASKELL__
-import PrelForeign  ( ForeignObj, makeForeignObj, writeForeignObj )
+import PrelForeign  ( makeForeignObj )
 #endif
 
 #endif
 
-import PrelConc                                -- concurrent only
-\end{code}
+#endif /* ndef(__HUGS__) */
+
+#ifdef __HUGS__
+#define __CONCURRENT_HASKELL__
+#define stToIO id
+#endif
 
 
+#ifndef __PARALLEL_HASKELL__
+#define FILE_OBJECT        ForeignObj
+#else
+#define FILE_OBJECT        Addr
+#endif
+\end{code}
 
 %*********************************************************
 %*                                                     *
 
 %*********************************************************
 %*                                                     *
@@ -43,32 +63,107 @@ The @Handle@ and @Handle__@ types are defined in @IOBase@.
 
 \begin{code}
 {-# INLINE newHandle   #-}
 
 \begin{code}
 {-# INLINE newHandle   #-}
-{-# INLINE readHandle  #-}
-{-# INLINE writeHandle #-}
-newHandle   :: Handle__ -> IO Handle
-readHandle  :: Handle   -> IO Handle__
-writeHandle :: Handle -> Handle__ -> IO ()
-
-#if defined(__CONCURRENT_HASKELL__)
+newHandle     :: Handle__ -> IO Handle
 
 -- Use MVars for concurrent Haskell
 newHandle hc  = newMVar        hc      >>= \ h ->
                return (Handle h)
 
 -- Use MVars for concurrent Haskell
 newHandle hc  = newMVar        hc      >>= \ h ->
                return (Handle h)
+\end{code}
 
 
-readHandle  (Handle h)    = takeMVar h
-writeHandle (Handle h) hc = putMVar h hc
+%*********************************************************
+%*                                                     *
+\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.
+
+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
 
 
-#else 
+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 ].
 
 
--- Use ordinary MutableVars for non-concurrent Haskell
-newHandle hc  = stToIO (newVar hc      >>= \ h ->
-                       return (Handle h))
+\begin{code}
+withHandle :: Handle -> (Handle__ -> IO (Handle__,a)) -> IO a
+{-# INLINE withHandle #-}
+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
+{-# INLINE withHandle_ #-}
+withHandle_ (Handle h) act = do
+   h_ <- takeMVar h
+   v  <- catchException (act h_) (\ ex -> putMVar h h_ >> throw ex)
+   putMVar h h_
+   return v
+   
+withHandle__ :: Handle -> (Handle__ -> IO Handle__) -> IO ()
+{-# INLINE withHandle__ #-}
+withHandle__ (Handle h) act = do
+   h_ <- takeMVar h
+   h'  <- catchException (act h_) (\ ex -> putMVar h h_ >> throw ex)
+   putMVar h h'
+   return ()
+\end{code}
 
 
-readHandle  (Handle h)    = stToIO (readVar h)
-writeHandle (Handle h) hc = stToIO (writeVar h hc)
+nullFile__ is only used for closed handles, plugging it in as a null
+file object reference.
 
 
+\begin{code}
+nullFile__ :: FILE_OBJECT
+nullFile__ = 
+#ifndef __PARALLEL_HASKELL__
+    unsafePerformIO (makeForeignObj nullAddr)
+#else
+    nullAddr
 #endif
 
 #endif
 
+
+mkClosedHandle__ :: Handle__
+mkClosedHandle__ = 
+  Handle__ 
+          nullFile__
+          ClosedHandle 
+          NoBuffering
+          "closed file"
+
+mkErrorHandle__ :: IOError -> Handle__
+mkErrorHandle__ ioe =
+  Handle__
+           nullFile__ 
+          (ErrorHandle ioe)
+          NoBuffering
+          "error handle"
+\end{code}
+
+%*********************************************************
+%*                                                     *
+\subsection{Handle Finalizers}
+%*                                                     *
+%*********************************************************
+
+\begin{code}
+foreign import "libHS_cbits" "freeStdFileObject" unsafe
+        freeStdFileObject :: FILE_OBJECT -> IO ()
+foreign import "libHS_cbits" "freeFileObject" unsafe
+        freeFileObject :: FILE_OBJECT -> IO ()
+
 \end{code}
 
 %*********************************************************
 \end{code}
 
 %*********************************************************
@@ -82,45 +177,48 @@ 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 <- getLock (1::Int) (1::Int)   -- ConcHask: SAFE, won't block
+    case (rc::Int) of
        0 -> newHandle (mkClosedHandle__)
        1 -> do
        0 -> newHandle (mkClosedHandle__)
        1 -> do
-#ifndef __CONCURRENT_HASKELL__
-           fo <- _ccall_ openStdFile 1 1{-flush on close-} 0{-writeable-}  -- ConcHask: SAFE, won't block
-#else
-           fo <- _ccall_ openStdFile 1 (1{-flush on close-} + 128{-don't block on I/O-})
-                                       0{-writeable-}  -- ConcHask: SAFE, won't block
-#endif
+           fo <- openStdFile (1::Int) 
+                             (0::Int){-writeable-}  -- ConcHask: SAFE, won't block
 
 #ifndef __PARALLEL_HASKELL__
 
 #ifndef __PARALLEL_HASKELL__
-            fo <- makeForeignObj fo (``&freeStdFileObject''::Addr)
+            fo <- makeForeignObj fo
+           addForeignFinalizer fo (freeStdFileObject fo)
 #endif
 #endif
+
+#ifdef __HUGS__
+/* I dont care what the Haskell report says, in an interactive system,
+ * stdout should be unbuffered by default.
+ */
+            let bm = NoBuffering
+#else
            (bm, bf_size)  <- getBMode__ fo
            mkBuffer__ fo bf_size
            (bm, bf_size)  <- getBMode__ fo
            mkBuffer__ fo bf_size
+#endif
            newHandle (Handle__ fo WriteHandle bm "stdout")
        _ -> do ioError <- constructError "stdout"
                newHandle (mkErrorHandle__ ioError)
   )
 
 stdin = unsafePerformIO (do
            newHandle (Handle__ fo WriteHandle bm "stdout")
        _ -> do ioError <- constructError "stdout"
                newHandle (mkErrorHandle__ ioError)
   )
 
 stdin = unsafePerformIO (do
-    rc <- _ccall_ getLock 0 0   -- ConcHask: SAFE, won't block
-    case rc of
+    rc <- getLock (0::Int) (0::Int)   -- ConcHask: SAFE, won't block
+    case (rc::Int) of
        0 -> newHandle (mkClosedHandle__)
        1 -> do
        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
-#else
-           fo <- _ccall_ openStdFile 0 (0{-flush on close-} + 128{-don't block on I/O-})
-                                       1{-readable-}  -- ConcHask: SAFE, won't block
-#endif
+           fo <- openStdFile (0::Int)
+                             (1::Int){-readable-}  -- ConcHask: SAFE, won't block
 
 #ifndef __PARALLEL_HASKELL__
 
 #ifndef __PARALLEL_HASKELL__
-            fo <- makeForeignObj fo (``&freeStdFileObject''::Addr)
+            fo <- makeForeignObj 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
@@ -136,26 +234,24 @@ stdin = unsafePerformIO (do
 
 
 stderr = unsafePerformIO (do
 
 
 stderr = unsafePerformIO (do
-    rc <- _ccall_ getLock 2 1  -- ConcHask: SAFE, won't block
-    case rc of
+    rc <- getLock (2::Int) (1::Int){-writeable-}  -- ConcHask: SAFE, won't block
+    case (rc::Int) of
        0 -> newHandle (mkClosedHandle__)
        1 -> do
        0 -> newHandle (mkClosedHandle__)
        1 -> do
-#ifndef __CONCURRENT_HASKELL__
-           fo <- _ccall_ openStdFile 2 1{-flush on close-} 0{-writeable-} -- ConcHask: SAFE, won't block
-#else
-           fo <- _ccall_ openStdFile 2 (1{-flush on close-} + 128{-don't block on I/O-})
-                                       0{-writeable-} -- ConcHask: SAFE, won't block
-#endif
+           fo <- openStdFile (2::Int)
+                             (0::Int){-writeable-} -- ConcHask: SAFE, won't block
 
 #ifndef __PARALLEL_HASKELL__
 
 #ifndef __PARALLEL_HASKELL__
-            fo <- makeForeignObj fo (``&freeStdFileObject''::Addr)
+            fo <- makeForeignObj fo
+           addForeignFinalizer fo (freeStdFileObject fo)
 #endif
             hdl <- newHandle (Handle__ fo WriteHandle NoBuffering "stderr")
 #endif
             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 on 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
            hConnectTo stdout hdl
            return hdl
+
        _ -> do ioError <- constructError "stderr"
                newHandle (mkErrorHandle__ ioError)
   )
        _ -> do ioError <- constructError "stderr"
                newHandle (mkErrorHandle__ ioError)
   )
@@ -182,10 +278,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 f file_mode binary flush_on_close  -- ConcHask: SAFE, won't block
+    fo <- primOpenFile (packString f)
+                       (file_mode::Int) 
+                      (binary::Int)     -- ConcHask: SAFE, won't block
     if fo /= nullAddr then do
 #ifndef __PARALLEL_HASKELL__
     if fo /= nullAddr then do
 #ifndef __PARALLEL_HASKELL__
-       fo  <- makeForeignObj fo ((``&freeFileObject'')::Addr)
+       fo  <- makeForeignObj 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
@@ -195,21 +294,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)
-
-#ifndef __CONCURRENT_HASKELL__
-    file_mode = file_mode'
-#else
-    file_mode = file_mode' + 128{-Don't block on I/O-}
-#endif
+        BinaryMode bmo -> (bmo, 1)
+       TextMode tmo   -> (tmo, 0)
 
 
-    (flush_on_close, file_mode') =
+    file_mode =
       case imo of
       case imo of
-           AppendMode    -> (1, 0)
-           WriteMode     -> (1, 1)
-           ReadMode      -> (0, 2)
-           ReadWriteMode -> (1, 3)
+           AppendMode    -> 0
+           WriteMode     -> 1
+           ReadMode      -> 2
+           ReadWriteMode -> 3
 
     htype = case imo of 
               ReadMode      -> ReadHandle
 
     htype = case imo of 
               ReadMode      -> ReadHandle
@@ -245,32 +338,26 @@ implementation is free to impose stricter conditions.
 \begin{code}
 hClose :: Handle -> IO ()
 
 \begin{code}
 hClose :: Handle -> IO ()
 
-hClose handle = do
-    handle_ <- readHandle handle
+hClose 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 "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      <- 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}
 
@@ -280,7 +367,7 @@ sent to the operating system are flushed as for $flush$.
 
 %*********************************************************
 %*                                                     *
 
 %*********************************************************
 %*                                                     *
-\subsection[EOF]{Detecting the End of Input}
+\subsection[FileSize]{Detecting the size of a file}
 %*                                                     *
 %*********************************************************
 
 %*                                                     *
 %*********************************************************
 
@@ -291,36 +378,44 @@ which can be read from {\em hdl}.
 
 \begin{code}
 hFileSize :: Handle -> IO Integer
 
 \begin{code}
 hFileSize :: Handle -> IO Integer
-hFileSize handle = do
-    handle_ <- readHandle handle
+hFileSize 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 "hFileSize" handle
-      SemiClosedHandle -> do
-         writeHandle handle handle_
-         ioe_closedHandle "hFileSize" handle
-      other ->
+      ErrorHandle theError     -> ioError theError
+      ClosedHandle             -> ioe_closedHandle "hFileSize" handle
+      SemiClosedHandle                 -> ioe_closedHandle "hFileSize" handle
+#ifdef __HUGS__
+      _ -> do
+          mem <- primNewByteArray 8{-sizeof_int64-}
+          rc <- fileSize_int64 (haFO__ handle_) mem  -- ConcHask: SAFE, won't block
+          if rc == 0 then do
+            result <- primReadInt64Array mem 0
+             return (primInt64ToInteger result)
+           else 
+             constructErrorAndFail "hFileSize"
+#else
+      _ ->
           -- 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
          --
-         -- 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# 1# of
+              (# s, d #) -> do
+                rc <- fileSize (haFO__ handle_) d  -- ConcHask: SAFE, won't block
+                if rc == (0::Int) then
+                  return (J# s d)
                  else
                   constructErrorAndFail "hFileSize"
                  else
                   constructErrorAndFail "hFileSize"
+#endif
 \end{code}
 
 \end{code}
 
+%*********************************************************
+%*                                                     *
+\subsection[EOF]{Detecting the End of Input}
+%*                                                     *
+%*********************************************************
+
+
 For a readable handle {\em hdl}, @hIsEOF hdl@ returns
 @True@ if no further input can be taken from @hdl@ or for a
 physical file, if the current I/O position is equal to the length of
 For a readable handle {\em hdl}, @hIsEOF hdl@ returns
 @True@ if no further input can be taken from @hdl@ or for a
 physical file, if the current I/O position is equal to the length of
@@ -329,10 +424,7 @@ the file.  Otherwise, it returns @False@.
 \begin{code}
 hIsEOF :: Handle -> IO Bool
 hIsEOF handle = do
 \begin{code}
 hIsEOF :: Handle -> IO Bool
 hIsEOF handle = do
-    handle_ <- wantReadableHandle "hIsEOF" handle
-    let fo = haFO__ handle_
-    rc      <- mayBlock fo (_ccall_ fileEOF fo)  -- ConcHask: UNSAFE, may block
-    writeHandle handle handle_
+    rc <- mayBlockRead "hIsEOF" handle fileEOF
     case rc of
       0 -> return False
       1 -> return True
     case rc of
       0 -> return False
       1 -> return True
@@ -380,19 +472,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.
-      _ -> do
-         handle_ <- readHandle 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 "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
@@ -405,13 +494,12 @@ hSetBuffering handle mode =
                      of semi-closed handles to change [sof 6/98]
                -}
                let fo = haFO__ handle_
                      of semi-closed handles to change [sof 6/98]
                -}
                let fo = haFO__ handle_
-                rc <- mayBlock fo (_ccall_ setBuffering fo bsize) -- ConcHask: UNSAFE, may block
+                rc <- mayBlock fo (setBuffering fo bsize) -- ConcHask: UNSAFE, may block
                 if rc == 0 
                 then do
                 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
@@ -428,11 +516,10 @@ system.
 
 \begin{code}
 hFlush :: Handle -> IO () 
 
 \begin{code}
 hFlush :: Handle -> IO () 
-hFlush handle = do
-    handle_ <- wantWriteableHandle "hFlush" handle
+hFlush handle =
+    wantWriteableHandle "hFlush" handle $ \ handle_ -> do
     let fo = haFO__ handle_
     let fo = haFO__ handle_
-    rc     <- mayBlock fo (_ccall_ flushFile fo)   -- ConcHask: UNSAFE, may block
-    writeHandle handle handle_
+    rc     <- mayBlock fo (flushFile fo)   -- ConcHask: UNSAFE, may block
     if rc == 0 then 
        return ()
      else
     if rc == 0 then 
        return ()
      else
@@ -451,7 +538,20 @@ hFlush handle = do
 data HandlePosn
  = HandlePosn 
        Handle   -- Q: should this be a weak or strong ref. to the handle?
 data HandlePosn
  = HandlePosn 
        Handle   -- Q: should this be a weak or strong ref. to the handle?
-       Int
+                --    [what's the winning argument for it not being strong? --sof]
+       HandlePosition
+
+instance Eq HandlePosn where
+    (HandlePosn h1 p1) == (HandlePosn h2 p2) = p1==p2 && h1==h2
+
+  -- HandlePosition is the Haskell equivalent of POSIX' off_t.
+  -- We represent it as an Integer on the Haskell side, but
+  -- cheat slightly in that hGetPosn calls upon a C helper
+  -- that reports the position back via (merely) an Int.
+type HandlePosition = Integer
+
+mkHandlePosn :: Handle -> HandlePosition -> HandlePosn
+mkHandlePosn h p = HandlePosn h p
 
 data SeekMode    =  AbsoluteSeek | RelativeSeek | SeekFromEnd
                     deriving (Eq, Ord, Ix, Enum, Read, Show)
 
 data SeekMode    =  AbsoluteSeek | RelativeSeek | SeekFromEnd
                     deriving (Eq, Ord, Ix, Enum, Read, Show)
@@ -464,22 +564,22 @@ to a previously obtained position {\em p}.
 
 \begin{code}
 hGetPosn :: Handle -> IO HandlePosn
 
 \begin{code}
 hGetPosn :: Handle -> IO HandlePosn
-hGetPosn handle = do
-    handle_ <- wantSeekableHandle "hGetPosn" handle
-    posn    <- _ccall_ getFilePosn (haFO__ handle_)   -- ConcHask: SAFE, won't block
-    writeHandle handle handle_
-    if posn /= -1 then
-      return (HandlePosn handle posn)
+hGetPosn handle =
+    wantSeekableHandle "hGetPosn" handle $ \ handle_ -> do
+    posn    <- getFilePosn (haFO__ handle_)   -- ConcHask: SAFE, won't block
+    if posn /= -1 then do
+      return (mkHandlePosn handle (fromInt posn))
      else
       constructErrorAndFail "hGetPosn"
 
 hSetPosn :: HandlePosn -> IO () 
      else
       constructErrorAndFail "hGetPosn"
 
 hSetPosn :: HandlePosn -> IO () 
-hSetPosn (HandlePosn handle posn) = do
-    handle_ <- wantSeekableHandle "hSetPosn" handle -- not as silly as it looks: the handle may have been closed in the meantime.
+hSetPosn (HandlePosn handle i@(S# _))   = hSetPosn (HandlePosn handle (toBig i))
+hSetPosn (HandlePosn handle (J# s# d#)) = 
+    wantSeekableHandle "hSetPosn" handle $ \ handle_ -> do 
+           -- not as silly as it looks: the handle may have been closed in the meantime.
     let fo = haFO__ handle_
     let fo = haFO__ handle_
-    rc     <- mayBlock fo (_ccall_ setFilePosn fo posn)    -- ConcHask: UNSAFE, may block
-    writeHandle handle handle_
-    if rc == 0 then 
+    rc     <- mayBlock fo (setFilePosn fo (I# s#) d#)    -- ConcHask: UNSAFE, may block
+    if rc == 0 then do
        return ()
      else
        constructErrorAndFail "hSetPosn"
        return ()
      else
        constructErrorAndFail "hSetPosn"
@@ -487,35 +587,41 @@ hSetPosn (HandlePosn handle posn) = do
 
 The action @hSeek hdl mode i@ sets the position of handle
 @hdl@ depending on @mode@.  If @mode@ is
 
 The action @hSeek hdl mode i@ sets the position of handle
 @hdl@ depending on @mode@.  If @mode@ is
-\begin{itemize}
-\item[{\bf AbsoluteSeek}] The position of @hdl@ is set to @i@.
-\item[{\bf RelativeSeek}] The position of @hdl@ is set to offset @i@ from
-the current position.
-\item[{\bf SeekFromEnd}] The position of @hdl@ is set to offset @i@ from
-the end of the file.
-\end{itemize}
 
 
-Some handles may not be seekable (see @hIsSeekable@), or only support a
-subset of the possible positioning operations (e.g. it may only be
-possible to seek to the end of a tape, or to a positive offset from
-the beginning or current position).
+ * AbsoluteSeek - The position of @hdl@ is set to @i@.
+ * RelativeSeek - The position of @hdl@ is set to offset @i@ from
+                  the current position.
+ * SeekFromEnd  - The position of @hdl@ is set to offset @i@ from
+                  the end of the file.
+
+Some handles may not be seekable (see @hIsSeekable@), or only
+support a subset of the possible positioning operations (e.g. it may
+only be possible to seek to the end of a tape, or to a positive
+offset from the beginning or current position).
 
 It is not possible to set a negative I/O position, or for a physical
 file, an I/O position beyond the current end-of-file. 
 
 Note: 
 
 It is not possible to set a negative I/O position, or for a physical
 file, an I/O position beyond the current end-of-file. 
 
 Note: 
- - when seeking using @SeekFromEnd@, positive offsets (>=0) means seeking
-   at or past EOF.
+ - when seeking using @SeekFromEnd@, positive offsets (>=0) means
+   seeking at or past EOF.
  - relative seeking on buffered handles can lead to non-obvious results.
 
 \begin{code}
 hSeek :: Handle -> SeekMode -> Integer -> IO () 
  - relative seeking on buffered handles can lead to non-obvious results.
 
 \begin{code}
 hSeek :: Handle -> SeekMode -> Integer -> IO () 
-hSeek handle mode offset@(J# _ s# d#) =  do
-    handle_ <- wantSeekableHandle "hSeek" handle
+#ifdef __HUGS__
+hSeek handle mode offset = 
+    wantSeekableHandle "hSeek" handle $ \ handle_ -> do
     let fo = haFO__ handle_
     let fo = haFO__ handle_
-    rc      <- mayBlock fo (_ccall_ seekFile  fo whence (I# s#) d#)  -- ConcHask: UNSAFE, may block
-    writeHandle handle handle_
-    if rc == 0 then 
+    rc      <- mayBlock fo (seekFile fo whence (primIntegerToInt64 offset))  -- ConcHask: UNSAFE, may block
+#else
+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 (seekFile fo whence (I# s#) d#)  -- ConcHask: UNSAFE, may block
+#endif
+    if rc == 0 then do
        return ()
      else
        constructErrorAndFail "hSeek"
        return ()
      else
        constructErrorAndFail "hSeek"
@@ -545,35 +651,21 @@ $( Just n )$ for block-buffering of {\em n} bytes.
 
 \begin{code}
 hIsOpen :: Handle -> IO Bool
 
 \begin{code}
 hIsOpen :: Handle -> IO Bool
-hIsOpen handle = do
-    handle_ <- readHandle handle
+hIsOpen 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_
-         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 -> IO Bool
-hIsClosed handle = do
-    handle_ <- readHandle handle
+hIsClosed 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_
-         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:
@@ -586,42 +678,26 @@ hIsClosed handle = do
 -}
 
 hIsReadable :: Handle -> IO Bool
 -}
 
 hIsReadable :: Handle -> IO Bool
-hIsReadable handle = do
-    handle_ <- readHandle handle
+hIsReadable 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 "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
     isReadable _              = False
 
 hIsWritable :: Handle -> IO Bool
   where
     isReadable ReadHandle      = True
     isReadable ReadWriteHandle = True
     isReadable _              = False
 
 hIsWritable :: Handle -> IO Bool
-hIsWritable handle = do
-    handle_ <- readHandle handle
+hIsWritable 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 "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
@@ -635,7 +711,7 @@ getBMode__ :: ForeignObj -> IO (BufferMode, Int)
 getBMode__ :: Addr -> IO (BufferMode, Int)
 #endif
 getBMode__ fo = do
 getBMode__ :: Addr -> IO (BufferMode, Int)
 #endif
 getBMode__ fo = do
-  rc <- _ccall_ getBufferMode fo    -- ConcHask: SAFE, won't block
+  rc <- getBufferMode fo    -- ConcHask: SAFE, won't block
   case (rc::Int) of
     0  -> return (NoBuffering, 0)
     -1 -> return (LineBuffering, default_buffer_size)
   case (rc::Int) of
     0  -> return (NoBuffering, 0)
     -1 -> return (LineBuffering, default_buffer_size)
@@ -644,54 +720,38 @@ getBMode__ fo = do
     n  -> return (BlockBuffering (Just n), n)
  where
    default_buffer_size :: Int
     n  -> return (BlockBuffering (Just n), n)
  where
    default_buffer_size :: Int
-   default_buffer_size = (``BUFSIZ'' - 1)
+   default_buffer_size = (const_BUFSIZ - 1)
 \end{code}
 
 Querying how a handle buffers its data:
 
 \begin{code}
 hGetBuffering :: Handle -> IO BufferMode
 \end{code}
 
 Querying how a handle buffers its data:
 
 \begin{code}
 hGetBuffering :: Handle -> IO BufferMode
-hGetBuffering handle = do
-    handle_ <- readHandle handle
+hGetBuffering 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 "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
 \end{code}
 
 \begin{code}
 hIsSeekable :: Handle -> IO Bool
-hIsSeekable handle = do
-    handle_ <- readHandle handle
+hIsSeekable 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 "hIsSeekable" handle
-      SemiClosedHandle -> do
-         writeHandle handle handle_
-          ioe_closedHandle "hIsSeekable" handle
-      AppendHandle -> do
-         writeHandle handle handle_
-         return False
-      other -> do
-         rc <- _ccall_ seekFileP (haFO__ handle_)   -- ConcHask: SAFE, won't block
-         writeHandle handle handle_
-         case rc of
+      ErrorHandle theError -> ioError theError
+      ClosedHandle        -> ioe_closedHandle "hIsSeekable" handle
+      SemiClosedHandle            -> ioe_closedHandle "hIsSeekable" handle
+      AppendHandle        -> return False
+      _ -> do
+         rc <- seekFileP (haFO__ handle_)   -- ConcHask: SAFE, won't block
+         case (rc::Int) of
             0 -> return False
             1 -> return True
             _ -> constructErrorAndFail "hIsSeekable"
             0 -> return False
             1 -> return True
             _ -> constructErrorAndFail "hIsSeekable"
@@ -709,62 +769,47 @@ of a handles connected to terminals to be reconfigured:
 
 \begin{code}
 hSetEcho :: Handle -> Bool -> IO ()
 
 \begin{code}
 hSetEcho :: Handle -> Bool -> IO ()
-hSetEcho hdl on = do
-    isT   <- hIsTerminalDevice hdl
+hSetEcho handle on = do
+    isT   <- hIsTerminalDevice handle
     if not isT
      then return ()
     if not isT
      then return ()
-     else do
-      handle_ <- readHandle hdl
+     else
+      withHandle_ handle $ \ handle_ -> do
       case haType__ handle_ of 
       case haType__ handle_ of 
-         ErrorHandle ioError ->  do 
-            writeHandle hdl handle_
-           fail ioError
-         ClosedHandle     ->  do
-            writeHandle hdl handle_
-           ioe_closedHandle "hSetEcho" hdl
-         other -> do
-            rc <- _ccall_ setTerminalEcho (haFO__ handle_) (if on then 1 else 0)  -- ConcHask: SAFE, won't block
-           writeHandle hdl handle_
-           if rc /= -1
+         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
+           if rc /= ((-1)::Int)
             then return ()
             else constructErrorAndFail "hSetEcho"
 
 hGetEcho :: Handle -> IO Bool
             then return ()
             else constructErrorAndFail "hSetEcho"
 
 hGetEcho :: Handle -> IO Bool
-hGetEcho hdl = do
-    isT   <- hIsTerminalDevice hdl
+hGetEcho handle = do
+    isT   <- hIsTerminalDevice handle
     if not isT
      then return False
     if not isT
      then return False
-     else do
-       handle_ <- readHandle hdl
+     else
+       withHandle_ handle $ \ handle_ -> do
        case haType__ handle_ of 
        case haType__ handle_ of 
-         ErrorHandle ioError ->  do 
-            writeHandle hdl handle_
-           fail ioError
-         ClosedHandle     ->  do
-            writeHandle hdl handle_
-           ioe_closedHandle "hGetEcho" hdl
-         other -> do
-            rc <- _ccall_ getTerminalEcho (haFO__ handle_)  -- ConcHask: SAFE, won't block
-           writeHandle hdl handle_
-           case rc of
+         ErrorHandle theError -> ioError theError
+         ClosedHandle        -> ioe_closedHandle "hGetEcho" handle
+         _ -> do
+            rc <- getTerminalEcho (haFO__ handle_)  -- ConcHask: SAFE, won't block
+           case (rc::Int) of
              1 -> return True
              0 -> return False
              _ -> constructErrorAndFail "hSetEcho"
 
 hIsTerminalDevice :: Handle -> IO Bool
              1 -> return True
              0 -> return False
              _ -> constructErrorAndFail "hSetEcho"
 
 hIsTerminalDevice :: Handle -> IO Bool
-hIsTerminalDevice hdl = do
-    handle_ <- readHandle hdl
-    case haType__ handle_ of 
-       ErrorHandle ioError ->  do 
-            writeHandle hdl handle_
-           fail ioError
-       ClosedHandle       ->  do
-            writeHandle hdl handle_
-           ioe_closedHandle "hIsTerminalDevice" hdl
-       other -> do
-          rc <- _ccall_ isTerminalDevice (haFO__ handle_)   -- ConcHask: SAFE, won't block
-         writeHandle hdl handle_
-         case rc of
+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
+         case (rc::Int) of
            1 -> return True
            0 -> return False
            _ -> constructErrorAndFail "hIsTerminalDevice"
            1 -> return True
            0 -> return False
            _ -> constructErrorAndFail "hIsTerminalDevice"
@@ -778,21 +823,17 @@ 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 = do
-  hW_ <- wantRWHandle "hConnectTo" hW
-  hR_ <- wantRWHandle "hConnectTo" hR
-  _ccall_ setConnectedTo (haFO__ hR_) (haFO__ hW_) is_tty  -- ConcHask: SAFE, won't block
-  writeHandle hR hR_
-  writeHandle hW hW_
+hConnectHdl_ hW hR is_tty =
+  wantRWHandle "hConnectTo" hW $ \ hW_ ->
+  wantRWHandle "hConnectTo" hR $ \ hR_ -> do
+  setConnectedTo (haFO__ hR_) (haFO__ hW_) is_tty  -- ConcHask: SAFE, won't block
 
 #ifndef __PARALLEL_HASKELL__
 
 #ifndef __PARALLEL_HASKELL__
-#define FILE_OBJECT        ForeignObj
+#define FILE_OBJECT     ForeignObj
 #else
 #else
-#define FILE_OBJECT        Addr
+#define FILE_OBJECT     Addr
 #endif
 
 #endif
 
-flushConnectedHandle :: FILE_OBJECT -> IO ()
-flushConnectedHandle fo = _ccall_ flushConnectedHandle 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.
@@ -802,11 +843,10 @@ pushback. (For unbuffered channels, the (default) push-back limit is
 
 \begin{code}
 hUngetChar :: Handle -> Char -> IO ()
 
 \begin{code}
 hUngetChar :: Handle -> Char -> IO ()
-hUngetChar handle c = do
-    handle_ <- wantReadableHandle "hLookAhead" handle
-    rc      <- _ccall_ ungetChar (haFO__ handle_) c  -- ConcHask: SAFE, won't block
-    writeHandle handle handle_
-    if rc == (-1)
+hUngetChar handle c = 
+    wantReadableHandle "hLookAhead" handle $ \ handle_ -> do
+    rc      <- ungetChar (haFO__ handle_) c  -- ConcHask: SAFE, won't block
+    if rc == ((-1)::Int)
      then constructErrorAndFail "hUngetChar"
      else return ()
 
      then constructErrorAndFail "hUngetChar"
      else return ()
 
@@ -820,57 +860,57 @@ this as an extension:
 -- in one go, read file into an externally allocated buffer.
 slurpFile :: FilePath -> IO (Addr, Int)
 slurpFile fname = do
 -- in one go, read file into an externally allocated buffer.
 slurpFile :: FilePath -> IO (Addr, Int)
 slurpFile fname = do
-  hdl <- openFile fname ReadMode
-  sz  <- hFileSize hdl
+  handle <- openFile fname ReadMode
+  sz     <- hFileSize handle
   if sz > toInteger (maxBound::Int) then 
   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
    else do
      let sz_i = fromInteger sz
-     chunk <- _ccall_ allocMemory__ (sz_i::Int)
+     chunk <- allocMemory__ sz_i
      if chunk == nullAddr 
       then do
      if chunk == nullAddr 
       then do
-        hClose hdl
+        hClose handle
         constructErrorAndFail "slurpFile"
       else do
         constructErrorAndFail "slurpFile"
       else do
-        handle_ <- readHandle hdl
-        let fo = haFO__ handle_
-       rc      <- mayBlock fo (_ccall_ readChunk fo chunk sz_i)    -- ConcHask: UNSAFE, may block.
-        writeHandle hdl handle_
-       hClose hdl
-        if rc < 0
+        rc <- withHandle_ handle ( \ handle_ -> do
+          let fo = haFO__ handle_
+         mayBlock fo (readChunk fo chunk 0 sz_i)    -- ConcHask: UNSAFE, may block.
+        )
+       hClose handle
+        if rc < (0::Int)
         then constructErrorAndFail "slurpFile"
         else return (chunk, rc)
 
         then constructErrorAndFail "slurpFile"
         else return (chunk, rc)
 
-hFillBufBA :: Handle -> ByteArray Int -> Int -> IO Int
+#ifndef __HUGS__ /* Hugs' Prelude doesn't need this */
+hFillBufBA :: Handle -> MutableByteArray RealWorld a -> Int -> IO Int
 hFillBufBA handle buf sz
 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.
-  | otherwise = do
-    handle_ <- wantReadableHandle "hFillBufBA" handle
-    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 "hFillBufBA"
+  | 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
 
 hFillBuf :: Handle -> Addr -> Int -> IO Int
 hFillBuf handle buf sz
-  | sz <= 0 = fail (IOError (Just handle)
+  | sz <= 0 = ioError (IOError (Just handle)
                            InvalidArgument
                            "hFillBuf"
                            InvalidArgument
                            "hFillBuf"
-                           ("illegal buffer size " ++ showsPrec 9 sz []))  -- 9 => should be parens'ified.
-  | otherwise = do
-    handle_ <- wantReadableHandle "hFillBuf" handle
-    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"
-
+                           ("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
 \end{code}
 
 The @hPutBuf hdl buf len@ action writes an already packed sequence of
@@ -878,24 +918,36 @@ bytes to the file/channel managed by @hdl@ - non-standard.
 
 \begin{code}
 hPutBuf :: Handle -> Addr -> Int -> IO ()
 
 \begin{code}
 hPutBuf :: Handle -> Addr -> Int -> IO ()
-hPutBuf handle buf len = do
-    handle_ <- wantWriteableHandle "hPutBuf" handle
-    let fo  = haFO__ handle_
-    rc      <- mayBlock fo (_ccall_ writeBuf fo buf len)  -- ConcHask: UNSAFE, may block.
-    writeHandle handle handle_
-    if rc == 0
-     then return ()
-     else constructErrorAndFail "hPutBuf"
-
-hPutBufBA :: Handle -> ByteArray Int -> Int -> IO ()
-hPutBufBA handle buf len = do
-    handle_ <- wantWriteableHandle "hPutBufBA" handle
-    let fo = haFO__ handle_
-    rc      <- mayBlock fo (_ccall_ writeBufBA fo buf len)  -- ConcHask: UNSAFE, may block.
-    writeHandle handle handle_
-    if rc == 0
-     then return ()
-     else constructErrorAndFail "hPutBuf"
+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
 \end{code}
 
 Sometimes it's useful to get at the file descriptor that
@@ -903,18 +955,13 @@ the Handle contains..
 
 \begin{code}
 getHandleFd :: Handle -> IO Int
 
 \begin{code}
 getHandleFd :: Handle -> IO Int
-getHandleFd handle = do
-    handle_ <- readHandle handle
+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
       _ -> do
-          fd <- _ccall_ getFileFd (haFO__ handle_)
-         writeHandle handle handle_
+          fd <- getFileFd (haFO__ handle_)
          return fd
 \end{code}
 
          return fd
 \end{code}
 
@@ -942,99 +989,112 @@ 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__" unsafe
+       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}
 A number of operations want to get at a readable or writeable handle, and fail
 if it isn't:
 
 \begin{code}
-wantReadableHandle :: String -> Handle -> IO Handle__
-wantReadableHandle fun handle = do
-    handle_ <- readHandle handle
+wantReadableHandle :: String -> Handle -> (Handle__ -> IO a) -> IO a
+wantReadableHandle fun handle act = 
+    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 -> return 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   
                   ("handle is not open for reading")
 
   where
    not_readable_error = 
           IOError (Just handle) IllegalOperation fun   
                   ("handle is not open for reading")
 
-wantWriteableHandle :: String -> Handle -> IO Handle__
-wantWriteableHandle fun handle = do
-    handle_ <- readHandle handle
+wantWriteableHandle :: String -> Handle -> (Handle__ -> IO a) -> IO a
+wantWriteableHandle fun handle act = 
+    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 -> return 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")
 
--- either R or W.
-wantRWHandle :: String -> Handle -> IO Handle__
-wantRWHandle fun handle = do
-    handle_ <- readHandle handle
+wantRWHandle :: String -> Handle -> (Handle__ -> IO a) -> IO a
+wantRWHandle fun handle act = 
+    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
-      other -> return handle_
-  where
-   not_readable_error = 
-          IOError (Just handle) IllegalOperation fun   
-                  ("handle is not open for reading or writing")
-
-wantSeekableHandle :: String -> Handle -> IO Handle__
-wantSeekableHandle fun handle = do
-    handle_ <- readHandle handle
+      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 =
+    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
-      _ -> return handle_
+      ErrorHandle theError -> ioError theError
+      ClosedHandle        -> ioe_closedHandle fun handle
+      SemiClosedHandle    -> ioe_closedHandle fun handle
+      _                   -> act handle_
   where
    not_seekable_error = 
           IOError (Just handle) 
   where
    not_seekable_error = 
           IOError (Just handle) 
@@ -1048,7 +1108,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
@@ -1061,33 +1121,192 @@ mayBlock :: ForeignObj -> IO Int -> IO Int
 mayBlock :: Addr  -> IO Int -> IO Int
 #endif
 
 mayBlock :: Addr  -> IO Int -> IO Int
 #endif
 
-#ifndef __CONCURRENT_HASKELL__
-mayBlock  _ act = act
-#else
 mayBlock fo act = do
    rc <- act
    case rc of
      -5 -> do  -- (possibly blocking) read
 mayBlock fo act = do
    rc <- act
    case rc of
      -5 -> do  -- (possibly blocking) read
-        fd <- _ccall_ getFileFd fo
+        fd <- getFileFd fo
         threadWaitRead fd
         threadWaitRead fd
-        _ccall_ clearNonBlockingIOFlag__ fo  -- force read to happen this time.
        mayBlock fo act  -- input available, re-try
      -6 -> do  -- (possibly blocking) write
        mayBlock fo act  -- input available, re-try
      -6 -> do  -- (possibly blocking) write
-        fd <- _ccall_ getFileFd fo
+        fd <- getFileFd fo
         threadWaitWrite fd
         threadWaitWrite fd
-        _ccall_ clearNonBlockingIOFlag__ fo  -- force write to happen this time.
        mayBlock fo act  -- output possible
      -7 -> do  -- (possibly blocking) write on connected handle
        mayBlock fo act  -- output possible
      -7 -> do  -- (possibly blocking) write on connected handle
-        fd <- _ccall_ getConnFileFd fo
+        fd <- getConnFileFd fo
         threadWaitWrite fd
         threadWaitWrite fd
-        _ccall_ clearConnNonBlockingIOFlag__ fo  -- force write to happen this time.
        mayBlock fo act  -- output possible
      _ -> do
        mayBlock fo act  -- output possible
      _ -> do
-       _ccall_ setNonBlockingIOFlag__ fo      -- reset file object.
-       _ccall_ setConnNonBlockingIOFlag__ fo  -- reset (connected) file object.
         return rc
 
         return rc
 
+data MayBlock
+  = BlockRead Int
+  | BlockWrite Int
+  | NoBlock Int
+
+mayBlockRead :: String -> Handle -> (ForeignObj -> IO Int) -> IO Int
+mayBlockRead fname handle fn = do
+    r <- wantReadableHandle fname handle $ \ handle_ -> do
+        let fo = haFO__ handle_
+         rc <- fn fo
+         case rc of
+           -5 -> do  -- (possibly blocking) read
+             fd <- getFileFd fo
+             return (BlockRead fd)
+          -6 -> do  -- (possibly blocking) write
+            fd <- getFileFd fo
+             return (BlockWrite fd)
+          -7 -> do  -- (possibly blocking) write on connected handle
+            fd <- getConnFileFd fo
+            return (BlockWrite fd)
+           _ ->
+             if rc >= 0
+                 then return (NoBlock rc)
+                 else constructErrorAndFail fname
+    case r of
+       BlockRead fd -> do
+          threadWaitRead fd
+          mayBlockRead fname handle fn
+       BlockWrite fd -> do
+          threadWaitWrite fd
+          mayBlockRead fname handle fn
+       NoBlock c -> return c
+
+mayBlockWrite :: String -> Handle -> (ForeignObj -> IO Int) -> IO Int
+mayBlockWrite fname handle fn = do
+    r <- wantWriteableHandle fname handle $ \ handle_ -> do
+        let fo = haFO__ handle_
+         rc <- fn fo
+         case rc of
+           -5 -> do  -- (possibly blocking) read
+             fd <- getFileFd fo
+             return (BlockRead fd)
+          -6 -> do  -- (possibly blocking) write
+            fd <- getFileFd fo
+             return (BlockWrite fd)
+          -7 -> do  -- (possibly blocking) write on connected handle
+            fd <- getConnFileFd fo
+            return (BlockWrite fd)
+           _ ->
+             if rc >= 0
+                 then return (NoBlock rc)
+                 else constructErrorAndFail fname
+    case r of
+       BlockRead fd -> do
+          threadWaitRead fd
+          mayBlockWrite fname handle fn
+       BlockWrite fd -> do
+          threadWaitWrite fd
+          mayBlockWrite fname handle fn
+       NoBlock c -> return c
+\end{code}
+
+Foreign import declarations of helper functions:
+
+\begin{code}
+
+#ifdef __HUGS__
+type Bytes = PrimByteArray RealWorld
+#else
+type Bytes = ByteArray#
+#endif
+
+foreign import "libHS_cbits" "inputReady"  unsafe
+           inputReady       :: FILE_OBJECT -> Int -> IO Int{-ret code-}
+foreign import "libHS_cbits" "fileGetc"    unsafe
+           fileGetc         :: FILE_OBJECT -> IO Int
+foreign import "libHS_cbits" "fileLookAhead" unsafe
+           fileLookAhead    :: FILE_OBJECT -> IO Int
+foreign import "libHS_cbits" "readBlock" unsafe
+           readBlock        :: FILE_OBJECT -> IO Int
+foreign import "libHS_cbits" "readLine" unsafe
+           readLine         :: FILE_OBJECT -> IO Int
+foreign import "libHS_cbits" "readChar" unsafe
+           readChar         :: FILE_OBJECT -> IO Int
+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" "getBufStart" unsafe
+           getBufStart      :: FILE_OBJECT -> Int -> IO Addr
+foreign import "libHS_cbits" "getWriteableBuf" unsafe
+           getWriteableBuf  :: FILE_OBJECT -> IO Addr
+foreign import "libHS_cbits" "getBufWPtr" unsafe
+           getBufWPtr       :: FILE_OBJECT -> IO Int
+foreign import "libHS_cbits" "setBufWPtr" unsafe
+           setBufWPtr       :: FILE_OBJECT -> Int -> IO ()
+foreign import "libHS_cbits" "closeFile" unsafe
+           closeFile        :: FILE_OBJECT -> Int{-Flush-} -> IO Int{-ret code-}
+foreign import "libHS_cbits" "fileEOF" unsafe
+           fileEOF           :: FILE_OBJECT -> IO Int{-ret code-}
+foreign import "libHS_cbits" "setBuffering" unsafe
+           setBuffering      :: FILE_OBJECT -> Int -> IO Int{-ret code-}
+foreign import "libHS_cbits" "flushFile" unsafe
+           flushFile         :: FILE_OBJECT -> IO Int{-ret code-}
+foreign import "libHS_cbits" "flushConnectedBuf" unsafe
+           flushConnectedBuf :: FILE_OBJECT -> IO ()
+foreign import "libHS_cbits" "getBufferMode" unsafe
+           getBufferMode     :: FILE_OBJECT -> IO Int{-ret code-}
+#ifdef __HUGS__
+foreign import "libHS_cbits" "seekFile_int64" unsafe
+           seekFile    :: FILE_OBJECT -> Int -> Int64 -> IO Int
+#else
+foreign import "libHS_cbits" "seekFile" unsafe
+           seekFile    :: FILE_OBJECT -> Int -> Int -> Bytes -> IO Int
+#endif 
+
+foreign import "libHS_cbits" "seekFileP" unsafe
+           seekFileP        :: FILE_OBJECT -> IO Int{-ret code-}
+foreign import "libHS_cbits" "setTerminalEcho" unsafe
+           setTerminalEcho  :: FILE_OBJECT -> Int -> IO Int{-ret code-}
+foreign import "libHS_cbits" "getTerminalEcho" unsafe
+           getTerminalEcho  :: FILE_OBJECT -> IO Int{-ret code-}
+foreign import "libHS_cbits" "isTerminalDevice" unsafe
+           isTerminalDevice :: FILE_OBJECT -> IO Int{-ret code-}
+foreign import "libHS_cbits" "setConnectedTo" unsafe
+           setConnectedTo   :: FILE_OBJECT -> FILE_OBJECT -> Int -> IO ()
+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
 #endif
+foreign import "libHS_cbits" "getFileFd" unsafe
+           getFileFd        :: FILE_OBJECT -> IO Int{-fd-}
+#ifdef __HUGS__
+foreign import "libHS_cbits" "fileSize_int64" unsafe
+           fileSize_int64   :: FILE_OBJECT -> Bytes -> IO Int{-ret code-}
+#else
+foreign import "libHS_cbits" "fileSize" unsafe
+           fileSize  :: FILE_OBJECT -> Bytes -> IO Int{-ret code-}
+#endif
+
+foreign import "libHS_cbits" "getFilePosn" unsafe
+           getFilePosn      :: FILE_OBJECT -> IO Int
+foreign import "libHS_cbits" "setFilePosn" unsafe
+           setFilePosn      :: FILE_OBJECT -> Int -> ByteArray# -> IO Int
+foreign import "libHS_cbits" "getConnFileFd" unsafe
+           getConnFileFd    :: FILE_OBJECT -> IO Int{-fd-}
+foreign import "libHS_cbits" "getLock" unsafe
+           getLock  :: Int{-Fd-} -> Int{-exclusive-} -> IO Int{-return code-}
+foreign import "libHS_cbits" "openStdFile" unsafe
+           openStdFile      :: Int{-fd-} -> Int{-Readable?-} -> IO Addr{-file obj-}
+foreign import "libHS_cbits" "openFile" unsafe
+           primOpenFile         :: ByteArray Int{-CString-}
+                               -> Int{-How-}
+                               -> Int{-Binary-}
+                               -> IO Addr {-file obj-}
+foreign import "libHS_cbits" "const_BUFSIZ" unsafe
+           const_BUFSIZ          :: Int
+
+foreign import "libHS_cbits" "setBinaryMode__" 
+          setBinaryMode :: FILE_OBJECT -> Int -> IO Int
 \end{code}
 
 
 \end{code}
 
 
Glasgow Haskell Compiler with heterogeneous metaprogramming (generalized arrows and modal types)