GHC/Handle.hs

   1 {-# OPTIONS_GHC -fno-implicit-prelude -#include "HsBase.h" #-}
   2
   3 #undef DEBUG_DUMP
   4 #undef DEBUG
   5
   6 -----------------------------------------------------------------------------
   7 -- |
   8 -- Module      :  GHC.Handle
   9 -- Copyright   :  (c) The University of Glasgow, 1994-2001
  10 -- License     :  see libraries/base/LICENSE
  11 --
  12 -- Maintainer  :  libraries@haskell.org
  13 -- Stability   :  internal
  14 -- Portability :  non-portable
  15 --
  16 -- This module defines the basic operations on I\/O \"handles\".
  17 --
  18 -----------------------------------------------------------------------------
  19
  20 -- #hide
  21 module GHC.Handle (
  22   withHandle, withHandle', withHandle_,
  23   wantWritableHandle, wantReadableHandle, wantSeekableHandle,
  24
  25   newEmptyBuffer, allocateBuffer, readCharFromBuffer, writeCharIntoBuffer,
  26   flushWriteBufferOnly, flushWriteBuffer, flushReadBuffer,
  27   fillReadBuffer, fillReadBufferWithoutBlocking,
  28   readRawBuffer, readRawBufferPtr,
  29   writeRawBuffer, writeRawBufferPtr,
  30
  31 #ifndef mingw32_HOST_OS
  32   unlockFile,
  33 #endif
  34
  35   ioe_closedHandle, ioe_EOF, ioe_notReadable, ioe_notWritable,
  36
  37   stdin, stdout, stderr,
  38   IOMode(..), openFile, openBinaryFile, openTempFile, openBinaryTempFile, openFd, fdToHandle,
  39   hFileSize, hSetFileSize, hIsEOF, isEOF, hLookAhead, hSetBuffering, hSetBinaryMode,
  40   hFlush, hDuplicate, hDuplicateTo,
  41
  42   hClose, hClose_help,
  43
  44   HandlePosition, HandlePosn(..), hGetPosn, hSetPosn,
  45   SeekMode(..), hSeek, hTell,
  46
  47   hIsOpen, hIsClosed, hIsReadable, hIsWritable, hGetBuffering, hIsSeekable,
  48   hSetEcho, hGetEcho, hIsTerminalDevice,
  49
  50   hShow,
  51
  52 #ifdef DEBUG_DUMP
  53   puts,
  54 #endif
  55
  56  ) where
  57
  58 import System.Directory.Internals
  59 import Control.Monad
  60 import Data.Bits
  61 import Data.Maybe
  62 import Foreign
  63 import Foreign.C
  64 import System.IO.Error
  65 import System.Posix.Internals
  66
  67 import GHC.Real
  68
  69 import GHC.Arr
  70 import GHC.Base
  71 import GHC.Read         ( Read )
  72 import GHC.List
  73 import GHC.IOBase
  74 import GHC.Exception
  75 import GHC.Enum
  76 import GHC.Num          ( Integer(..), Num(..) )
  77 import GHC.Show
  78 import GHC.Real         ( toInteger )
  79
  80 import GHC.Conc
  81
  82 -- -----------------------------------------------------------------------------
  83 -- TODO:
  84
  85 -- hWaitForInput blocks (should use a timeout)
  86
  87 -- unbuffered hGetLine is a bit dodgy
  88
  89 -- hSetBuffering: can't change buffering on a stream,
  90 --      when the read buffer is non-empty? (no way to flush the buffer)
  91
  92 -- ---------------------------------------------------------------------------
  93 -- Are files opened by default in text or binary mode, if the user doesn't
  94 -- specify?
  95
  96 dEFAULT_OPEN_IN_BINARY_MODE = False :: Bool
  97
  98 -- ---------------------------------------------------------------------------
  99 -- Creating a new handle
 100
 101 newFileHandle :: FilePath -> (MVar Handle__ -> IO ()) -> Handle__ -> IO Handle
 102 newFileHandle filepath finalizer hc = do
 103   m <- newMVar hc
 104   addMVarFinalizer m (finalizer m)
 105   return (FileHandle filepath m)
 106
 107 -- ---------------------------------------------------------------------------
 108 -- Working with Handles
 109
 110 {-
 111 In the concurrent world, handles are locked during use.  This is done
 112 by wrapping an MVar around the handle which acts as a mutex over
 113 operations on the handle.
 114
 115 To avoid races, we use the following bracketing operations.  The idea
 116 is to obtain the lock, do some operation and replace the lock again,
 117 whether the operation succeeded or failed.  We also want to handle the
 118 case where the thread receives an exception while processing the IO
 119 operation: in these cases we also want to relinquish the lock.
 120
 121 There are three versions of @withHandle@: corresponding to the three
 122 possible combinations of:
 123
 124         - the operation may side-effect the handle
 125         - the operation may return a result
 126
 127 If the operation generates an error or an exception is raised, the
 128 original handle is always replaced [ this is the case at the moment,
 129 but we might want to revisit this in the future --SDM ].
 130 -}
 131
 132 {-# INLINE withHandle #-}
 133 withHandle :: String -> Handle -> (Handle__ -> IO (Handle__,a)) -> IO a
 134 withHandle fun h@(FileHandle _ m)     act = withHandle' fun h m act
 135 withHandle fun h@(DuplexHandle _ m _) act = withHandle' fun h m act
 136
 137 withHandle' :: String -> Handle -> MVar Handle__
 138    -> (Handle__ -> IO (Handle__,a)) -> IO a
 139 withHandle' fun h m act =
 140    block $ do
 141    h_ <- takeMVar m
 142    checkBufferInvariants h_
 143    (h',v)  <- catchException (act h_)
 144                 (\ err -> putMVar m h_ >>
 145                           case err of
 146                              IOException ex -> ioError (augmentIOError ex fun h)
 147                              _ -> throw err)
 148    checkBufferInvariants h'
 149    putMVar m h'
 150    return v
 151
 152 {-# INLINE withHandle_ #-}
 153 withHandle_ :: String -> Handle -> (Handle__ -> IO a) -> IO a
 154 withHandle_ fun h@(FileHandle _ m)     act = withHandle_' fun h m act
 155 withHandle_ fun h@(DuplexHandle _ m _) act = withHandle_' fun h m act
 156
 157 withHandle_' fun h m act =
 158    block $ do
 159    h_ <- takeMVar m
 160    checkBufferInvariants h_
 161    v  <- catchException (act h_)
 162                 (\ err -> putMVar m h_ >>
 163                           case err of
 164                              IOException ex -> ioError (augmentIOError ex fun h)
 165                              _ -> throw err)
 166    checkBufferInvariants h_
 167    putMVar m h_
 168    return v
 169
 170 withAllHandles__ :: String -> Handle -> (Handle__ -> IO Handle__) -> IO ()
 171 withAllHandles__ fun h@(FileHandle _ m)     act = withHandle__' fun h m act
 172 withAllHandles__ fun h@(DuplexHandle _ r w) act = do
 173   withHandle__' fun h r act
 174   withHandle__' fun h w act
 175
 176 withHandle__' fun h m act =
 177    block $ do
 178    h_ <- takeMVar m
 179    checkBufferInvariants h_
 180    h'  <- catchException (act h_)
 181                 (\ err -> putMVar m h_ >>
 182                           case err of
 183                              IOException ex -> ioError (augmentIOError ex fun h)
 184                              _ -> throw err)
 185    checkBufferInvariants h'
 186    putMVar m h'
 187    return ()
 188
 189 augmentIOError (IOError _ iot _ str fp) fun h
 190   = IOError (Just h) iot fun str filepath
 191   where filepath
 192           | Just _ <- fp = fp
 193           | otherwise = case h of
 194                           FileHandle fp _     -> Just fp
 195                           DuplexHandle fp _ _ -> Just fp
 196
 197 -- ---------------------------------------------------------------------------
 198 -- Wrapper for write operations.
 199
 200 wantWritableHandle :: String -> Handle -> (Handle__ -> IO a) -> IO a
 201 wantWritableHandle fun h@(FileHandle _ m) act
 202   = wantWritableHandle' fun h m act
 203 wantWritableHandle fun h@(DuplexHandle _ _ m) act
 204   = wantWritableHandle' fun h m act
 205   -- ToDo: in the Duplex case, we don't need to checkWritableHandle
 206
 207 wantWritableHandle'
 208         :: String -> Handle -> MVar Handle__
 209         -> (Handle__ -> IO a) -> IO a
 210 wantWritableHandle' fun h m act
 211    = withHandle_' fun h m (checkWritableHandle act)
 212
 213 checkWritableHandle act handle_
 214   = case haType handle_ of
 215       ClosedHandle         -> ioe_closedHandle
 216       SemiClosedHandle     -> ioe_closedHandle
 217       ReadHandle           -> ioe_notWritable
 218       ReadWriteHandle      -> do
 219                 let ref = haBuffer handle_
 220                 buf <- readIORef ref
 221                 new_buf <-
 222                   if not (bufferIsWritable buf)
 223                      then do b <- flushReadBuffer (haFD handle_) buf
 224                              return b{ bufState=WriteBuffer }
 225                      else return buf
 226                 writeIORef ref new_buf
 227                 act handle_
 228       _other               -> act handle_
 229
 230 -- ---------------------------------------------------------------------------
 231 -- Wrapper for read operations.
 232
 233 wantReadableHandle :: String -> Handle -> (Handle__ -> IO a) -> IO a
 234 wantReadableHandle fun h@(FileHandle  _ m)   act
 235   = wantReadableHandle' fun h m act
 236 wantReadableHandle fun h@(DuplexHandle _ m _) act
 237   = wantReadableHandle' fun h m act
 238   -- ToDo: in the Duplex case, we don't need to checkReadableHandle
 239
 240 wantReadableHandle'
 241         :: String -> Handle -> MVar Handle__
 242         -> (Handle__ -> IO a) -> IO a
 243 wantReadableHandle' fun h m act
 244   = withHandle_' fun h m (checkReadableHandle act)
 245
 246 checkReadableHandle act handle_ =
 247     case haType handle_ of
 248       ClosedHandle         -> ioe_closedHandle
 249       SemiClosedHandle     -> ioe_closedHandle
 250       AppendHandle         -> ioe_notReadable
 251       WriteHandle          -> ioe_notReadable
 252       ReadWriteHandle      -> do
 253         let ref = haBuffer handle_
 254         buf <- readIORef ref
 255         when (bufferIsWritable buf) $ do
 256            new_buf <- flushWriteBuffer (haFD handle_) (haIsStream handle_) buf
 257            writeIORef ref new_buf{ bufState=ReadBuffer }
 258         act handle_
 259       _other               -> act handle_
 260
 261 -- ---------------------------------------------------------------------------
 262 -- Wrapper for seek operations.
 263
 264 wantSeekableHandle :: String -> Handle -> (Handle__ -> IO a) -> IO a
 265 wantSeekableHandle fun h@(DuplexHandle _ _ _) _act =
 266   ioException (IOError (Just h) IllegalOperation fun
 267                    "handle is not seekable" Nothing)
 268 wantSeekableHandle fun h@(FileHandle _ m) act =
 269   withHandle_' fun h m (checkSeekableHandle act)
 270
 271 checkSeekableHandle act handle_ =
 272     case haType handle_ of
 273       ClosedHandle      -> ioe_closedHandle
 274       SemiClosedHandle  -> ioe_closedHandle
 275       AppendHandle      -> ioe_notSeekable
 276       _  | haIsBin handle_ || tEXT_MODE_SEEK_ALLOWED -> act handle_
 277          | otherwise                                 -> ioe_notSeekable_notBin
 278
 279 -- -----------------------------------------------------------------------------
 280 -- Handy IOErrors
 281
 282 ioe_closedHandle, ioe_EOF,
 283   ioe_notReadable, ioe_notWritable,
 284   ioe_notSeekable, ioe_notSeekable_notBin :: IO a
 285
 286 ioe_closedHandle = ioException
 287    (IOError Nothing IllegalOperation ""
 288         "handle is closed" Nothing)
 289 ioe_EOF = ioException
 290    (IOError Nothing EOF "" "" Nothing)
 291 ioe_notReadable = ioException
 292    (IOError Nothing IllegalOperation ""
 293         "handle is not open for reading" Nothing)
 294 ioe_notWritable = ioException
 295    (IOError Nothing IllegalOperation ""
 296         "handle is not open for writing" Nothing)
 297 ioe_notSeekable = ioException
 298    (IOError Nothing IllegalOperation ""
 299         "handle is not seekable" Nothing)
 300 ioe_notSeekable_notBin = ioException
 301    (IOError Nothing IllegalOperation ""
 302       "seek operations on text-mode handles are not allowed on this platform"
 303         Nothing)
 304
 305 ioe_finalizedHandle fp = throw (IOException
 306    (IOError Nothing IllegalOperation ""
 307         "handle is finalized" (Just fp)))
 308
 309 ioe_bufsiz :: Int -> IO a
 310 ioe_bufsiz n = ioException
 311    (IOError Nothing InvalidArgument "hSetBuffering"
 312         ("illegal buffer size " ++ showsPrec 9 n []) Nothing)
 313                                 -- 9 => should be parens'ified.
 314
 315 -- -----------------------------------------------------------------------------
 316 -- Handle Finalizers
 317
 318 -- For a duplex handle, we arrange that the read side points to the write side
 319 -- (and hence keeps it alive if the read side is alive).  This is done by
 320 -- having the haOtherSide field of the read side point to the read side.
 321 -- The finalizer is then placed on the write side, and the handle only gets
 322 -- finalized once, when both sides are no longer required.
 323
 324 -- NOTE about finalized handles: It's possible that a handle can be
 325 -- finalized and then we try to use it later, for example if the
 326 -- handle is referenced from another finalizer, or from a thread that
 327 -- has become unreferenced and then resurrected (arguably in the
 328 -- latter case we shouldn't finalize the Handle...).  Anyway,
 329 -- we try to emit a helpful message which is better than nothing.
 330
 331 stdHandleFinalizer :: FilePath -> MVar Handle__ -> IO ()
 332 stdHandleFinalizer fp m = do
 333   h_ <- takeMVar m
 334   flushWriteBufferOnly h_
 335   putMVar m (ioe_finalizedHandle fp)
 336
 337 handleFinalizer :: FilePath -> MVar Handle__ -> IO ()
 338 handleFinalizer fp m = do
 339   handle_ <- takeMVar m
 340   case haType handle_ of
 341       ClosedHandle -> return ()
 342       _ -> do flushWriteBufferOnly handle_ `catchException` \_ -> return ()
 343                 -- ignore errors and async exceptions, and close the
 344                 -- descriptor anyway...
 345               hClose_handle_ handle_
 346               return ()
 347   putMVar m (ioe_finalizedHandle fp)
 348
 349 -- ---------------------------------------------------------------------------
 350 -- Grimy buffer operations
 351
 352 #ifdef DEBUG
 353 checkBufferInvariants h_ = do
 354  let ref = haBuffer h_
 355  Buffer{ bufWPtr=w, bufRPtr=r, bufSize=size, bufState=state } <- readIORef ref
 356  if not (
 357         size > 0
 358         && r <= w
 359         && w <= size
 360         && ( r /= w || (r == 0 && w == 0) )
 361         && ( state /= WriteBuffer || r == 0 )
 362         && ( state /= WriteBuffer || w < size ) -- write buffer is never full
 363      )
 364    then error "buffer invariant violation"
 365    else return ()
 366 #else
 367 checkBufferInvariants h_ = return ()
 368 #endif
 369
 370 newEmptyBuffer :: RawBuffer -> BufferState -> Int -> Buffer
 371 newEmptyBuffer b state size
 372   = Buffer{ bufBuf=b, bufRPtr=0, bufWPtr=0, bufSize=size, bufState=state }
 373
 374 allocateBuffer :: Int -> BufferState -> IO Buffer
 375 allocateBuffer sz@(I# size) state = IO $ \s ->
 376 #ifdef mingw32_HOST_OS
 377    -- To implement asynchronous I/O under Win32, we have to pass
 378    -- buffer references to external threads that handles the
 379    -- filling/emptying of their contents. Hence, the buffer cannot
 380    -- be moved around by the GC.
 381   case newPinnedByteArray# size s of { (# s, b #) ->
 382 #else
 383   case newByteArray# size s of { (# s, b #) ->
 384 #endif
 385   (# s, newEmptyBuffer b state sz #) }
 386
 387 writeCharIntoBuffer :: RawBuffer -> Int -> Char -> IO Int
 388 writeCharIntoBuffer slab (I# off) (C# c)
 389   = IO $ \s -> case writeCharArray# slab off c s of
 390                  s -> (# s, I# (off +# 1#) #)
 391
 392 readCharFromBuffer :: RawBuffer -> Int -> IO (Char, Int)
 393 readCharFromBuffer slab (I# off)
 394   = IO $ \s -> case readCharArray# slab off s of
 395                  (# s, c #) -> (# s, (C# c, I# (off +# 1#)) #)
 396
 397 getBuffer :: FD -> BufferState -> IO (IORef Buffer, BufferMode)
 398 getBuffer fd state = do
 399   buffer <- allocateBuffer dEFAULT_BUFFER_SIZE state
 400   ioref  <- newIORef buffer
 401   is_tty <- fdIsTTY fd
 402
 403   let buffer_mode
 404          | is_tty    = LineBuffering
 405          | otherwise = BlockBuffering Nothing
 406
 407   return (ioref, buffer_mode)
 408
 409 mkUnBuffer :: IO (IORef Buffer)
 410 mkUnBuffer = do
 411   buffer <- allocateBuffer 1 ReadBuffer
 412   newIORef buffer
 413
 414 -- flushWriteBufferOnly flushes the buffer iff it contains pending write data.
 415 flushWriteBufferOnly :: Handle__ -> IO ()
 416 flushWriteBufferOnly h_ = do
 417   let fd = haFD h_
 418       ref = haBuffer h_
 419   buf <- readIORef ref
 420   new_buf <- if bufferIsWritable buf
 421                 then flushWriteBuffer fd (haIsStream h_) buf
 422                 else return buf
 423   writeIORef ref new_buf
 424
 425 -- flushBuffer syncs the file with the buffer, including moving the
 426 -- file pointer backwards in the case of a read buffer.
 427 flushBuffer :: Handle__ -> IO ()
 428 flushBuffer h_ = do
 429   let ref = haBuffer h_
 430   buf <- readIORef ref
 431
 432   flushed_buf <-
 433     case bufState buf of
 434       ReadBuffer  -> flushReadBuffer  (haFD h_) buf
 435       WriteBuffer -> flushWriteBuffer (haFD h_) (haIsStream h_) buf
 436
 437   writeIORef ref flushed_buf
 438
 439 -- When flushing a read buffer, we seek backwards by the number of
 440 -- characters in the buffer.  The file descriptor must therefore be
 441 -- seekable: attempting to flush the read buffer on an unseekable
 442 -- handle is not allowed.
 443
 444 flushReadBuffer :: FD -> Buffer -> IO Buffer
 445 flushReadBuffer fd buf
 446   | bufferEmpty buf = return buf
 447   | otherwise = do
 448      let off = negate (bufWPtr buf - bufRPtr buf)
 449 #    ifdef DEBUG_DUMP
 450      puts ("flushReadBuffer: new file offset = " ++ show off ++ "\n")
 451 #    endif
 452      throwErrnoIfMinus1Retry "flushReadBuffer"
 453          (c_lseek (fromIntegral fd) (fromIntegral off) sEEK_CUR)
 454      return buf{ bufWPtr=0, bufRPtr=0 }
 455
 456 flushWriteBuffer :: FD -> Bool -> Buffer -> IO Buffer
 457 flushWriteBuffer fd is_stream buf@Buffer{ bufBuf=b, bufRPtr=r, bufWPtr=w }  =
 458   seq fd $ do -- strictness hack
 459   let bytes = w - r
 460 #ifdef DEBUG_DUMP
 461   puts ("flushWriteBuffer, fd=" ++ show fd ++ ", bytes=" ++ show bytes ++ "\n")
 462 #endif
 463   if bytes == 0
 464      then return (buf{ bufRPtr=0, bufWPtr=0 })
 465      else do
 466   res <- writeRawBuffer "flushWriteBuffer" (fromIntegral fd) is_stream b
 467                         (fromIntegral r) (fromIntegral bytes)
 468   let res' = fromIntegral res
 469   if res' < bytes
 470      then flushWriteBuffer fd is_stream (buf{ bufRPtr = r + res' })
 471      else return buf{ bufRPtr=0, bufWPtr=0 }
 472
 473 fillReadBuffer :: FD -> Bool -> Bool -> Buffer -> IO Buffer
 474 fillReadBuffer fd is_line is_stream
 475       buf@Buffer{ bufBuf=b, bufRPtr=r, bufWPtr=w, bufSize=size } =
 476   -- buffer better be empty:
 477   assert (r == 0 && w == 0) $ do
 478   fillReadBufferLoop fd is_line is_stream buf b w size
 479
 480 -- For a line buffer, we just get the first chunk of data to arrive,
 481 -- and don't wait for the whole buffer to be full (but we *do* wait
 482 -- until some data arrives).  This isn't really line buffering, but it
 483 -- appears to be what GHC has done for a long time, and I suspect it
 484 -- is more useful than line buffering in most cases.
 485
 486 fillReadBufferLoop fd is_line is_stream buf b w size = do
 487   let bytes = size - w
 488   if bytes == 0  -- buffer full?
 489      then return buf{ bufRPtr=0, bufWPtr=w }
 490      else do
 491 #ifdef DEBUG_DUMP
 492   puts ("fillReadBufferLoop: bytes = " ++ show bytes ++ "\n")
 493 #endif
 494   res <- readRawBuffer "fillReadBuffer" fd is_stream b
 495                        (fromIntegral w) (fromIntegral bytes)
 496   let res' = fromIntegral res
 497 #ifdef DEBUG_DUMP
 498   puts ("fillReadBufferLoop:  res' = " ++ show res' ++ "\n")
 499 #endif
 500   if res' == 0
 501      then if w == 0
 502              then ioe_EOF
 503              else return buf{ bufRPtr=0, bufWPtr=w }
 504      else if res' < bytes && not is_line
 505              then fillReadBufferLoop fd is_line is_stream buf b (w+res') size
 506              else return buf{ bufRPtr=0, bufWPtr=w+res' }
 507
 508
 509 fillReadBufferWithoutBlocking :: FD -> Bool -> Buffer -> IO Buffer
 510 fillReadBufferWithoutBlocking fd is_stream
 511       buf@Buffer{ bufBuf=b, bufRPtr=r, bufWPtr=w, bufSize=size } =
 512   -- buffer better be empty:
 513   assert (r == 0 && w == 0) $ do
 514 #ifdef DEBUG_DUMP
 515   puts ("fillReadBufferLoopNoBlock: bytes = " ++ show bytes ++ "\n")
 516 #endif
 517   res <- readRawBufferNoBlock "fillReadBuffer" fd is_stream b
 518                        0 (fromIntegral size)
 519   let res' = fromIntegral res
 520 #ifdef DEBUG_DUMP
 521   puts ("fillReadBufferLoopNoBlock:  res' = " ++ show res' ++ "\n")
 522 #endif
 523   return buf{ bufRPtr=0, bufWPtr=res' }
 524
 525 -- Low level routines for reading/writing to (raw)buffers:
 526
 527 #ifndef mingw32_HOST_OS
 528 readRawBuffer :: String -> FD -> Bool -> RawBuffer -> Int -> CInt -> IO CInt
 529 readRawBuffer loc fd is_stream buf off len =
 530   throwErrnoIfMinus1RetryMayBlock loc
 531             (read_rawBuffer fd buf off len)
 532             (threadWaitRead (fromIntegral fd))
 533
 534 readRawBufferNoBlock :: String -> FD -> Bool -> RawBuffer -> Int -> CInt -> IO CInt
 535 readRawBufferNoBlock loc fd is_stream buf off len =
 536   throwErrnoIfMinus1RetryOnBlock loc
 537             (read_rawBuffer fd buf off len)
 538             (return 0)
 539
 540 readRawBufferPtr :: String -> FD -> Bool -> Ptr CChar -> Int -> CInt -> IO CInt
 541 readRawBufferPtr loc fd is_stream buf off len =
 542   throwErrnoIfMinus1RetryMayBlock loc
 543             (read_off fd buf off len)
 544             (threadWaitRead (fromIntegral fd))
 545
 546 writeRawBuffer :: String -> FD -> Bool -> RawBuffer -> Int -> CInt -> IO CInt
 547 writeRawBuffer loc fd is_stream buf off len =
 548   throwErrnoIfMinus1RetryMayBlock loc
 549                 (write_rawBuffer (fromIntegral fd) buf off len)
 550                 (threadWaitWrite (fromIntegral fd))
 551
 552 writeRawBufferPtr :: String -> FD -> Bool -> Ptr CChar -> Int -> CInt -> IO CInt
 553 writeRawBufferPtr loc fd is_stream buf off len =
 554   throwErrnoIfMinus1RetryMayBlock loc
 555                 (write_off (fromIntegral fd) buf off len)
 556                 (threadWaitWrite (fromIntegral fd))
 557
 558 foreign import ccall unsafe "__hscore_PrelHandle_read"
 559    read_rawBuffer :: FD -> RawBuffer -> Int -> CInt -> IO CInt
 560
 561 foreign import ccall unsafe "__hscore_PrelHandle_read"
 562    read_off :: FD -> Ptr CChar -> Int -> CInt -> IO CInt
 563
 564 foreign import ccall unsafe "__hscore_PrelHandle_write"
 565    write_rawBuffer :: CInt -> RawBuffer -> Int -> CInt -> IO CInt
 566
 567 foreign import ccall unsafe "__hscore_PrelHandle_write"
 568    write_off :: CInt -> Ptr CChar -> Int -> CInt -> IO CInt
 569
 570 #else /* mingw32_HOST_OS.... */
 571
 572 readRawBuffer :: String -> FD -> Bool -> RawBuffer -> Int -> CInt -> IO CInt
 573 readRawBuffer loc fd is_stream buf off len
 574   | threaded  = blockingReadRawBuffer loc fd is_stream buf off len
 575   | otherwise = asyncReadRawBuffer loc fd is_stream buf off len
 576
 577 readRawBufferPtr :: String -> FD -> Bool -> Ptr CChar -> Int -> CInt -> IO CInt
 578 readRawBufferPtr loc fd is_stream buf off len
 579   | threaded  = blockingReadRawBufferPtr loc fd is_stream buf off len
 580   | otherwise = asyncReadRawBufferPtr loc fd is_stream buf off len
 581
 582 writeRawBuffer :: String -> FD -> Bool -> RawBuffer -> Int -> CInt -> IO CInt
 583 writeRawBuffer loc fd is_stream buf off len
 584   | threaded =  blockingWriteRawBuffer loc fd is_stream buf off len
 585   | otherwise = asyncWriteRawBuffer    loc fd is_stream buf off len
 586
 587 writeRawBufferPtr :: String -> FD -> Bool -> Ptr CChar -> Int -> CInt -> IO CInt
 588 writeRawBufferPtr loc fd is_stream buf off len
 589   | threaded  = blockingWriteRawBufferPtr loc fd is_stream buf off len
 590   | otherwise = asyncWriteRawBufferPtr    loc fd is_stream buf off len
 591
 592 -- ToDo: we don't have a non-blocking primitve read on Win32
 593 readRawBufferNoBlock :: String -> FD -> Bool -> RawBuffer -> Int -> CInt -> IO CInt
 594 readRawBufferNoBlock = readRawBufferNoBlock
 595
 596 -- Async versions of the read/write primitives, for the non-threaded RTS
 597
 598 asyncReadRawBuffer loc fd is_stream buf off len = do
 599     (l, rc) <- asyncReadBA fd (if is_stream then 1 else 0)
 600                  (fromIntegral len) off buf
 601     if l == (-1)
 602       then
 603         ioError (errnoToIOError loc (Errno (fromIntegral rc)) Nothing Nothing)
 604       else return (fromIntegral l)
 605
 606 asyncReadRawBufferPtr loc fd is_stream buf off len = do
 607     (l, rc) <- asyncRead fd (if is_stream then 1 else 0)
 608                         (fromIntegral len) (buf `plusPtr` off)
 609     if l == (-1)
 610       then
 611         ioError (errnoToIOError loc (Errno (fromIntegral rc)) Nothing Nothing)
 612       else return (fromIntegral l)
 613
 614 asyncWriteRawBuffer loc fd is_stream buf off len = do
 615     (l, rc) <- asyncWriteBA fd (if is_stream then 1 else 0)
 616                         (fromIntegral len) off buf
 617     if l == (-1)
 618       then
 619         ioError (errnoToIOError loc (Errno (fromIntegral rc)) Nothing Nothing)
 620       else return (fromIntegral l)
 621
 622 asyncWriteRawBufferPtr loc fd is_stream buf off len = do
 623     (l, rc) <- asyncWrite fd (if is_stream then 1 else 0)
 624                   (fromIntegral len) (buf `plusPtr` off)
 625     if l == (-1)
 626       then
 627         ioError (errnoToIOError loc (Errno (fromIntegral rc)) Nothing Nothing)
 628       else return (fromIntegral l)
 629
 630 -- Blocking versions of the read/write primitives, for the threaded RTS
 631
 632 blockingReadRawBuffer loc fd True buf off len =
 633   throwErrnoIfMinus1Retry loc $
 634     recv_rawBuffer fd buf off len
 635 blockingReadRawBuffer loc fd False buf off len =
 636   throwErrnoIfMinus1Retry loc $
 637     read_rawBuffer fd buf off len
 638
 639 blockingReadRawBufferPtr loc fd True buf off len =
 640   throwErrnoIfMinus1Retry loc $
 641     recv_off fd buf off len
 642 blockingReadRawBufferPtr loc fd False buf off len =
 643   throwErrnoIfMinus1Retry loc $
 644     read_off fd buf off len
 645
 646 blockingWriteRawBuffer loc fd True buf off len =
 647   throwErrnoIfMinus1Retry loc $
 648     send_rawBuffer (fromIntegral fd) buf off len
 649 blockingWriteRawBuffer loc fd False buf off len =
 650   throwErrnoIfMinus1Retry loc $
 651     write_rawBuffer (fromIntegral fd) buf off len
 652
 653 blockingWriteRawBufferPtr loc fd True buf off len =
 654   throwErrnoIfMinus1Retry loc $
 655     send_off (fromIntegral fd) buf off len
 656 blockingWriteRawBufferPtr loc fd False buf off len =
 657   throwErrnoIfMinus1Retry loc $
 658     write_off (fromIntegral fd) buf off len
 659
 660 -- NOTE: "safe" versions of the read/write calls for use by the threaded RTS.
 661 -- These calls may block, but that's ok.
 662
 663 foreign import ccall safe "__hscore_PrelHandle_read"
 664    read_rawBuffer :: FD -> RawBuffer -> Int -> CInt -> IO CInt
 665
 666 foreign import ccall safe "__hscore_PrelHandle_read"
 667    read_off :: FD -> Ptr CChar -> Int -> CInt -> IO CInt
 668
 669 foreign import ccall safe "__hscore_PrelHandle_write"
 670    write_rawBuffer :: CInt -> RawBuffer -> Int -> CInt -> IO CInt
 671
 672 foreign import ccall safe "__hscore_PrelHandle_write"
 673    write_off :: CInt -> Ptr CChar -> Int -> CInt -> IO CInt
 674
 675 foreign import ccall safe "__hscore_PrelHandle_recv"
 676    recv_rawBuffer :: FD -> RawBuffer -> Int -> CInt -> IO CInt
 677
 678 foreign import ccall safe "__hscore_PrelHandle_recv"
 679    recv_off :: FD -> Ptr CChar -> Int -> CInt -> IO CInt
 680
 681 foreign import ccall safe "__hscore_PrelHandle_send"
 682    send_rawBuffer :: CInt -> RawBuffer -> Int -> CInt -> IO CInt
 683
 684 foreign import ccall safe "__hscore_PrelHandle_send"
 685    send_off :: CInt -> Ptr CChar -> Int -> CInt -> IO CInt
 686
 687 foreign import ccall "rtsSupportsBoundThreads" threaded :: Bool
 688 #endif
 689
 690 -- ---------------------------------------------------------------------------
 691 -- Standard Handles
 692
 693 -- Three handles are allocated during program initialisation.  The first
 694 -- two manage input or output from the Haskell program's standard input
 695 -- or output channel respectively.  The third manages output to the
 696 -- standard error channel. These handles are initially open.
 697
 698 fd_stdin  = 0 :: FD
 699 fd_stdout = 1 :: FD
 700 fd_stderr = 2 :: FD
 701
 702 -- | A handle managing input from the Haskell program's standard input channel.
 703 stdin :: Handle
 704 stdin = unsafePerformIO $ do
 705    -- ToDo: acquire lock
 706    setNonBlockingFD fd_stdin
 707    (buf, bmode) <- getBuffer fd_stdin ReadBuffer
 708    mkStdHandle fd_stdin "<stdin>" ReadHandle buf bmode
 709
 710 -- | A handle managing output to the Haskell program's standard output channel.
 711 stdout :: Handle
 712 stdout = unsafePerformIO $ do
 713    -- ToDo: acquire lock
 714    -- We don't set non-blocking mode on stdout or sterr, because
 715    -- some shells don't recover properly.
 716    -- setNonBlockingFD fd_stdout
 717    (buf, bmode) <- getBuffer fd_stdout WriteBuffer
 718    mkStdHandle fd_stdout "<stdout>" WriteHandle buf bmode
 719
 720 -- | A handle managing output to the Haskell program's standard error channel.
 721 stderr :: Handle
 722 stderr = unsafePerformIO $ do
 723     -- ToDo: acquire lock
 724    -- We don't set non-blocking mode on stdout or sterr, because
 725    -- some shells don't recover properly.
 726    -- setNonBlockingFD fd_stderr
 727    buf <- mkUnBuffer
 728    mkStdHandle fd_stderr "<stderr>" WriteHandle buf NoBuffering
 729
 730 -- ---------------------------------------------------------------------------
 731 -- Opening and Closing Files
 732
 733 addFilePathToIOError fun fp (IOError h iot _ str _)
 734   = IOError h iot fun str (Just fp)
 735
 736 -- | Computation 'openFile' @file mode@ allocates and returns a new, open
 737 -- handle to manage the file @file@.  It manages input if @mode@
 738 -- is 'ReadMode', output if @mode@ is 'WriteMode' or 'AppendMode',
 739 -- and both input and output if mode is 'ReadWriteMode'.
 740 --
 741 -- If the file does not exist and it is opened for output, it should be
 742 -- created as a new file.  If @mode@ is 'WriteMode' and the file
 743 -- already exists, then it should be truncated to zero length.
 744 -- Some operating systems delete empty files, so there is no guarantee
 745 -- that the file will exist following an 'openFile' with @mode@
 746 -- 'WriteMode' unless it is subsequently written to successfully.
 747 -- The handle is positioned at the end of the file if @mode@ is
 748 -- 'AppendMode', and otherwise at the beginning (in which case its
 749 -- internal position is 0).
 750 -- The initial buffer mode is implementation-dependent.
 751 --
 752 -- This operation may fail with:
 753 --
 754 --  * 'isAlreadyInUseError' if the file is already open and cannot be reopened;
 755 --
 756 --  * 'isDoesNotExistError' if the file does not exist; or
 757 --
 758 --  * 'isPermissionError' if the user does not have permission to open the file.
 759 --
 760 -- Note: if you will be working with files containing binary data, you'll want to
 761 -- be using 'openBinaryFile'.
 762 openFile :: FilePath -> IOMode -> IO Handle
 763 openFile fp im =
 764   catch
 765     (openFile' fp im dEFAULT_OPEN_IN_BINARY_MODE)
 766     (\e -> ioError (addFilePathToIOError "openFile" fp e))
 767
 768 -- | Like 'openFile', but open the file in binary mode.
 769 -- On Windows, reading a file in text mode (which is the default)
 770 -- will translate CRLF to LF, and writing will translate LF to CRLF.
 771 -- This is usually what you want with text files.  With binary files
 772 -- this is undesirable; also, as usual under Microsoft operating systems,
 773 -- text mode treats control-Z as EOF.  Binary mode turns off all special
 774 -- treatment of end-of-line and end-of-file characters.
 775 -- (See also 'hSetBinaryMode'.)
 776
 777 openBinaryFile :: FilePath -> IOMode -> IO Handle
 778 openBinaryFile fp m =
 779   catch
 780     (openFile' fp m True)
 781     (\e -> ioError (addFilePathToIOError "openBinaryFile" fp e))
 782
 783 openFile' filepath mode binary =
 784   withCString filepath $ \ f ->
 785
 786     let
 787       oflags1 = case mode of
 788                   ReadMode      -> read_flags
 789 #ifdef mingw32_HOST_OS
 790                   WriteMode     -> write_flags .|. o_TRUNC
 791 #else
 792                   WriteMode     -> write_flags
 793 #endif
 794                   ReadWriteMode -> rw_flags
 795                   AppendMode    -> append_flags
 796
 797       binary_flags
 798           | binary    = o_BINARY
 799           | otherwise = 0
 800
 801       oflags = oflags1 .|. binary_flags
 802     in do
 803
 804     -- the old implementation had a complicated series of three opens,
 805     -- which is perhaps because we have to be careful not to open
 806     -- directories.  However, the man pages I've read say that open()
 807     -- always returns EISDIR if the file is a directory and was opened
 808     -- for writing, so I think we're ok with a single open() here...
 809     fd <- fromIntegral `liftM`
 810               throwErrnoIfMinus1Retry "openFile"
 811                 (c_open f (fromIntegral oflags) 0o666)
 812
 813     h <- openFd fd Nothing False filepath mode binary
 814             `catchException` \e -> do c_close (fromIntegral fd); throw e
 815         -- NB. don't forget to close the FD if openFd fails, otherwise
 816         -- this FD leaks.
 817         -- ASSERT: if we just created the file, then openFd won't fail
 818         -- (so we don't need to worry about removing the newly created file
 819         --  in the event of an error).
 820 #ifndef mingw32_HOST_OS
 821     if mode == WriteMode
 822       then throwErrnoIf (/=0) "openFile"
 823               (c_ftruncate (fromIntegral fd) 0)
 824       else return 0
 825 #endif
 826     return h
 827
 828
 829 -- | The function creates a temporary file in ReadWrite mode.
 830 -- The created file isn\'t deleted automatically, so you need to delete it manually.
 831 openTempFile :: FilePath   -- ^ Directory in which to create the file
 832              -> String     -- ^ File name template. If the template is \"foo.ext\" then
 833                            -- the create file will be \"fooXXX.ext\" where XXX is some
 834                            -- random number.
 835              -> IO (FilePath, Handle)
 836 openTempFile tmp_dir template = openTempFile' "openTempFile" tmp_dir template dEFAULT_OPEN_IN_BINARY_MODE
 837
 838 -- | Like 'openTempFile', but opens the file in binary mode. See 'openBinaryFile' for more comments.
 839 openBinaryTempFile :: FilePath -> String -> IO (FilePath, Handle)
 840 openBinaryTempFile tmp_dir template = openTempFile' "openBinaryTempFile" tmp_dir template True
 841
 842 openTempFile' :: String -> FilePath -> String -> Bool -> IO (FilePath, Handle)
 843 openTempFile' loc tmp_dir template binary = do
 844   pid <- c_getpid
 845   findTempName pid
 846   where
 847     (prefix,suffix) = break (=='.') template
 848
 849     oflags1 = rw_flags .|. o_EXCL
 850
 851     binary_flags
 852       | binary    = o_BINARY
 853       | otherwise = 0
 854
 855     oflags = oflags1 .|. binary_flags
 856
 857     findTempName x = do
 858       fd <- withCString filepath $ \ f ->
 859               c_open f oflags 0o666
 860       if fd < 0
 861        then do
 862          errno <- getErrno
 863          if errno == eEXIST
 864            then findTempName (x+1)
 865            else ioError (errnoToIOError loc errno Nothing (Just tmp_dir))
 866        else do
 867          h <- openFd (fromIntegral fd) Nothing False filepath ReadWriteMode True
 868                 `catchException` \e -> do c_close (fromIntegral fd); throw e
 869          return (filepath, h)
 870       where
 871         filename        = prefix ++ show x ++ suffix
 872         filepath        = tmp_dir `joinFileName` filename
 873
 874
 875 std_flags    = o_NONBLOCK   .|. o_NOCTTY
 876 output_flags = std_flags    .|. o_CREAT
 877 read_flags   = std_flags    .|. o_RDONLY
 878 write_flags  = output_flags .|. o_WRONLY
 879 rw_flags     = output_flags .|. o_RDWR
 880 append_flags = write_flags  .|. o_APPEND
 881
 882 -- ---------------------------------------------------------------------------
 883 -- openFd
 884
 885 openFd :: FD -> Maybe FDType -> Bool -> FilePath -> IOMode -> Bool -> IO Handle
 886 openFd fd mb_fd_type is_socket filepath mode binary = do
 887     -- turn on non-blocking mode
 888     setNonBlockingFD fd
 889
 890     let (ha_type, write) =
 891           case mode of
 892             ReadMode      -> ( ReadHandle,      False )
 893             WriteMode     -> ( WriteHandle,     True )
 894             ReadWriteMode -> ( ReadWriteHandle, True )
 895             AppendMode    -> ( AppendHandle,    True )
 896
 897     -- open() won't tell us if it was a directory if we only opened for
 898     -- reading, so check again.
 899     fd_type <-
 900       case mb_fd_type of
 901         Just x  -> return x
 902         Nothing -> fdType fd
 903
 904     case fd_type of
 905         Directory ->
 906            ioException (IOError Nothing InappropriateType "openFile"
 907                            "is a directory" Nothing)
 908
 909         Stream
 910            | ReadWriteHandle <- ha_type -> mkDuplexHandle fd is_socket filepath binary
 911            | otherwise                  -> mkFileHandle fd is_socket filepath ha_type binary
 912
 913         -- regular files need to be locked
 914         RegularFile -> do
 915 #ifndef mingw32_HOST_OS
 916            r <- lockFile (fromIntegral fd) (fromBool write) 1{-exclusive-}
 917            when (r == -1)  $
 918                 ioException (IOError Nothing ResourceBusy "openFile"
 919                                    "file is locked" Nothing)
 920 #endif
 921            mkFileHandle fd is_socket filepath ha_type binary
 922
 923
 924 fdToHandle :: FD -> IO Handle
 925 fdToHandle fd = do
 926    mode <- fdGetMode fd
 927    let fd_str = "<file descriptor: " ++ show fd ++ ">"
 928    openFd fd Nothing False{-XXX!-} fd_str mode True{-bin mode-}
 929
 930
 931 #ifndef mingw32_HOST_OS
 932 foreign import ccall unsafe "lockFile"
 933   lockFile :: CInt -> CInt -> CInt -> IO CInt
 934
 935 foreign import ccall unsafe "unlockFile"
 936   unlockFile :: CInt -> IO CInt
 937 #endif
 938
 939 mkStdHandle :: FD -> FilePath -> HandleType -> IORef Buffer -> BufferMode
 940         -> IO Handle
 941 mkStdHandle fd filepath ha_type buf bmode = do
 942    spares <- newIORef BufferListNil
 943    newFileHandle filepath (stdHandleFinalizer filepath)
 944             (Handle__ { haFD = fd,
 945                         haType = ha_type,
 946                         haIsBin = dEFAULT_OPEN_IN_BINARY_MODE,
 947                         haIsStream = False,
 948                         haBufferMode = bmode,
 949                         haBuffer = buf,
 950                         haBuffers = spares,
 951                         haOtherSide = Nothing
 952                       })
 953
 954 mkFileHandle :: FD -> Bool -> FilePath -> HandleType -> Bool -> IO Handle
 955 mkFileHandle fd is_stream filepath ha_type binary = do
 956   (buf, bmode) <- getBuffer fd (initBufferState ha_type)
 957   spares <- newIORef BufferListNil
 958   newFileHandle filepath (handleFinalizer filepath)
 959             (Handle__ { haFD = fd,
 960                         haType = ha_type,
 961                         haIsBin = binary,
 962                         haIsStream = is_stream,
 963                         haBufferMode = bmode,
 964                         haBuffer = buf,
 965                         haBuffers = spares,
 966                         haOtherSide = Nothing
 967                       })
 968
 969 mkDuplexHandle :: FD -> Bool -> FilePath -> Bool -> IO Handle
 970 mkDuplexHandle fd is_stream filepath binary = do
 971   (w_buf, w_bmode) <- getBuffer fd WriteBuffer
 972   w_spares <- newIORef BufferListNil
 973   let w_handle_ =
 974              Handle__ { haFD = fd,
 975                         haType = WriteHandle,
 976                         haIsBin = binary,
 977                         haIsStream = is_stream,
 978                         haBufferMode = w_bmode,
 979                         haBuffer = w_buf,
 980                         haBuffers = w_spares,
 981                         haOtherSide = Nothing
 982                       }
 983   write_side <- newMVar w_handle_
 984
 985   (r_buf, r_bmode) <- getBuffer fd ReadBuffer
 986   r_spares <- newIORef BufferListNil
 987   let r_handle_ =
 988              Handle__ { haFD = fd,
 989                         haType = ReadHandle,
 990                         haIsBin = binary,
 991                         haIsStream = is_stream,
 992                         haBufferMode = r_bmode,
 993                         haBuffer = r_buf,
 994                         haBuffers = r_spares,
 995                         haOtherSide = Just write_side
 996                       }
 997   read_side <- newMVar r_handle_
 998
 999   addMVarFinalizer write_side (handleFinalizer filepath write_side)
1000   return (DuplexHandle filepath read_side write_side)
1001
1002
1003 initBufferState ReadHandle = ReadBuffer
1004 initBufferState _          = WriteBuffer
1005
1006 -- ---------------------------------------------------------------------------
1007 -- Closing a handle
1008
1009 -- | Computation 'hClose' @hdl@ makes handle @hdl@ closed.  Before the
1010 -- computation finishes, if @hdl@ is writable its buffer is flushed as
1011 -- for 'hFlush'.
1012 -- Performing 'hClose' on a handle that has already been closed has no effect;
1013 -- doing so not an error.  All other operations on a closed handle will fail.
1014 -- If 'hClose' fails for any reason, any further operations (apart from
1015 -- 'hClose') on the handle will still fail as if @hdl@ had been successfully
1016 -- closed.
1017
1018 hClose :: Handle -> IO ()
1019 hClose h@(FileHandle _ m)     = hClose' h m
1020 hClose h@(DuplexHandle _ r w) = hClose' h w >> hClose' h r
1021
1022 hClose' h m = withHandle__' "hClose" h m $ hClose_help
1023
1024 -- hClose_help is also called by lazyRead (in PrelIO) when EOF is read
1025 -- or an IO error occurs on a lazy stream.  The semi-closed Handle is
1026 -- then closed immediately.  We have to be careful with DuplexHandles
1027 -- though: we have to leave the closing to the finalizer in that case,
1028 -- because the write side may still be in use.
1029 hClose_help :: Handle__ -> IO Handle__
1030 hClose_help handle_ =
1031   case haType handle_ of
1032       ClosedHandle -> return handle_
1033       _ -> do flushWriteBufferOnly handle_ -- interruptible
1034               hClose_handle_ handle_
1035
1036 hClose_handle_ handle_ = do
1037     let fd = haFD handle_
1038         c_fd = fromIntegral fd
1039
1040     -- close the file descriptor, but not when this is the read
1041     -- side of a duplex handle.
1042     case haOtherSide handle_ of
1043       Nothing ->
1044                   throwErrnoIfMinus1Retry_ "hClose"
1045 #ifdef mingw32_HOST_OS
1046                                 (closeFd (haIsStream handle_) c_fd)
1047 #else
1048                                 (c_close c_fd)
1049 #endif
1050       Just _  -> return ()
1051
1052     -- free the spare buffers
1053     writeIORef (haBuffers handle_) BufferListNil
1054
1055 #ifndef mingw32_HOST_OS
1056     -- unlock it
1057     unlockFile c_fd
1058 #endif
1059
1060     -- we must set the fd to -1, because the finalizer is going
1061     -- to run eventually and try to close/unlock it.
1062     return (handle_{ haFD        = -1,
1063                      haType      = ClosedHandle
1064                    })
1065
1066 -----------------------------------------------------------------------------
1067 -- Detecting and changing the size of a file
1068
1069 -- | For a handle @hdl@ which attached to a physical file,
1070 -- 'hFileSize' @hdl@ returns the size of that file in 8-bit bytes.
1071
1072 hFileSize :: Handle -> IO Integer
1073 hFileSize handle =
1074     withHandle_ "hFileSize" handle $ \ handle_ -> do
1075     case haType handle_ of
1076       ClosedHandle              -> ioe_closedHandle
1077       SemiClosedHandle          -> ioe_closedHandle
1078       _ -> do flushWriteBufferOnly handle_
1079               r <- fdFileSize (haFD handle_)
1080               if r /= -1
1081                  then return r
1082                  else ioException (IOError Nothing InappropriateType "hFileSize"
1083                                    "not a regular file" Nothing)
1084
1085
1086 -- | 'hSetFileSize' @hdl@ @size@ truncates the physical file with handle @hdl@ to @size@ bytes.
1087
1088 hSetFileSize :: Handle -> Integer -> IO ()
1089 hSetFileSize handle size =
1090     withHandle_ "hSetFileSize" handle $ \ handle_ -> do
1091     case haType handle_ of
1092       ClosedHandle              -> ioe_closedHandle
1093       SemiClosedHandle          -> ioe_closedHandle
1094       _ -> do flushWriteBufferOnly handle_
1095               throwErrnoIf (/=0) "hSetFileSize"
1096                  (c_ftruncate (fromIntegral (haFD handle_)) (fromIntegral size))
1097               return ()
1098
1099 -- ---------------------------------------------------------------------------
1100 -- Detecting the End of Input
1101
1102 -- | For a readable handle @hdl@, 'hIsEOF' @hdl@ returns
1103 -- 'True' if no further input can be taken from @hdl@ or for a
1104 -- physical file, if the current I\/O position is equal to the length of
1105 -- the file.  Otherwise, it returns 'False'.
1106
1107 hIsEOF :: Handle -> IO Bool
1108 hIsEOF handle =
1109   catch
1110      (do hLookAhead handle; return False)
1111      (\e -> if isEOFError e then return True else ioError e)
1112
1113 -- | The computation 'isEOF' is identical to 'hIsEOF',
1114 -- except that it works only on 'stdin'.
1115
1116 isEOF :: IO Bool
1117 isEOF = hIsEOF stdin
1118
1119 -- ---------------------------------------------------------------------------
1120 -- Looking ahead
1121
1122 -- | Computation 'hLookAhead' returns the next character from the handle
1123 -- without removing it from the input buffer, blocking until a character
1124 -- is available.
1125 --
1126 -- This operation may fail with:
1127 --
1128 --  * 'isEOFError' if the end of file has been reached.
1129
1130 hLookAhead :: Handle -> IO Char
1131 hLookAhead handle = do
1132   wantReadableHandle "hLookAhead"  handle $ \handle_ -> do
1133   let ref     = haBuffer handle_
1134       fd      = haFD handle_
1135       is_line = haBufferMode handle_ == LineBuffering
1136   buf <- readIORef ref
1137
1138   -- fill up the read buffer if necessary
1139   new_buf <- if bufferEmpty buf
1140                 then fillReadBuffer fd is_line (haIsStream handle_) buf
1141                 else return buf
1142
1143   writeIORef ref new_buf
1144
1145   (c,_) <- readCharFromBuffer (bufBuf buf) (bufRPtr buf)
1146   return c
1147
1148 -- ---------------------------------------------------------------------------
1149 -- Buffering Operations
1150
1151 -- Three kinds of buffering are supported: line-buffering,
1152 -- block-buffering or no-buffering.  See GHC.IOBase for definition and
1153 -- further explanation of what the type represent.
1154
1155 -- | Computation 'hSetBuffering' @hdl mode@ sets the mode of buffering for
1156 -- handle @hdl@ on subsequent reads and writes.
1157 --
1158 -- If the buffer mode is changed from 'BlockBuffering' or
1159 -- 'LineBuffering' to 'NoBuffering', then
1160 --
1161 --  * if @hdl@ is writable, the buffer is flushed as for 'hFlush';
1162 --
1163 --  * if @hdl@ is not writable, the contents of the buffer is discarded.
1164 --
1165 -- This operation may fail with:
1166 --
1167 --  * 'isPermissionError' if the handle has already been used for reading
1168 --    or writing and the implementation does not allow the buffering mode
1169 --    to be changed.
1170
1171 hSetBuffering :: Handle -> BufferMode -> IO ()
1172 hSetBuffering handle mode =
1173   withAllHandles__ "hSetBuffering" handle $ \ handle_ -> do
1174   case haType handle_ of
1175     ClosedHandle -> ioe_closedHandle
1176     _ -> do
1177          {- Note:
1178             - we flush the old buffer regardless of whether
1179               the new buffer could fit the contents of the old buffer
1180               or not.
1181             - allow a handle's buffering to change even if IO has
1182               occurred (ANSI C spec. does not allow this, nor did
1183               the previous implementation of IO.hSetBuffering).
1184             - a non-standard extension is to allow the buffering
1185               of semi-closed handles to change [sof 6/98]
1186           -}
1187           flushBuffer handle_
1188
1189           let state = initBufferState (haType handle_)
1190           new_buf <-
1191             case mode of
1192                 -- we always have a 1-character read buffer for
1193                 -- unbuffered  handles: it's needed to
1194                 -- support hLookAhead.
1195               NoBuffering            -> allocateBuffer 1 ReadBuffer
1196               LineBuffering          -> allocateBuffer dEFAULT_BUFFER_SIZE state
1197               BlockBuffering Nothing -> allocateBuffer dEFAULT_BUFFER_SIZE state
1198               BlockBuffering (Just n) | n <= 0    -> ioe_bufsiz n
1199                                       | otherwise -> allocateBuffer n state
1200           writeIORef (haBuffer handle_) new_buf
1201
1202           -- for input terminals we need to put the terminal into
1203           -- cooked or raw mode depending on the type of buffering.
1204           is_tty <- fdIsTTY (haFD handle_)
1205           when (is_tty && isReadableHandleType (haType handle_)) $
1206                 case mode of
1207 #ifndef mingw32_HOST_OS
1208         -- 'raw' mode under win32 is a bit too specialised (and troublesome
1209         -- for most common uses), so simply disable its use here.
1210                   NoBuffering -> setCooked (haFD handle_) False
1211 #endif
1212                   _           -> setCooked (haFD handle_) True
1213
1214           -- throw away spare buffers, they might be the wrong size
1215           writeIORef (haBuffers handle_) BufferListNil
1216
1217           return (handle_{ haBufferMode = mode })
1218
1219 -- -----------------------------------------------------------------------------
1220 -- hFlush
1221
1222 -- | The action 'hFlush' @hdl@ causes any items buffered for output
1223 -- in handle @hdl@ to be sent immediately to the operating system.
1224 --
1225 -- This operation may fail with:
1226 --
1227 --  * 'isFullError' if the device is full;
1228 --
1229 --  * 'isPermissionError' if a system resource limit would be exceeded.
1230 --    It is unspecified whether the characters in the buffer are discarded
1231 --    or retained under these circumstances.
1232
1233 hFlush :: Handle -> IO ()
1234 hFlush handle =
1235    wantWritableHandle "hFlush" handle $ \ handle_ -> do
1236    buf <- readIORef (haBuffer handle_)
1237    if bufferIsWritable buf && not (bufferEmpty buf)
1238         then do flushed_buf <- flushWriteBuffer (haFD handle_) (haIsStream handle_) buf
1239                 writeIORef (haBuffer handle_) flushed_buf
1240         else return ()
1241
1242
1243 -- -----------------------------------------------------------------------------
1244 -- Repositioning Handles
1245
1246 data HandlePosn = HandlePosn Handle HandlePosition
1247
1248 instance Eq HandlePosn where
1249     (HandlePosn h1 p1) == (HandlePosn h2 p2) = p1==p2 && h1==h2
1250
1251 instance Show HandlePosn where
1252    showsPrec p (HandlePosn h pos) =
1253         showsPrec p h . showString " at position " . shows pos
1254
1255   -- HandlePosition is the Haskell equivalent of POSIX' off_t.
1256   -- We represent it as an Integer on the Haskell side, but
1257   -- cheat slightly in that hGetPosn calls upon a C helper
1258   -- that reports the position back via (merely) an Int.
1259 type HandlePosition = Integer
1260
1261 -- | Computation 'hGetPosn' @hdl@ returns the current I\/O position of
1262 -- @hdl@ as a value of the abstract type 'HandlePosn'.
1263
1264 hGetPosn :: Handle -> IO HandlePosn
1265 hGetPosn handle = do
1266     posn <- hTell handle
1267     return (HandlePosn handle posn)
1268
1269 -- | If a call to 'hGetPosn' @hdl@ returns a position @p@,
1270 -- then computation 'hSetPosn' @p@ sets the position of @hdl@
1271 -- to the position it held at the time of the call to 'hGetPosn'.
1272 --
1273 -- This operation may fail with:
1274 --
1275 --  * 'isPermissionError' if a system resource limit would be exceeded.
1276
1277 hSetPosn :: HandlePosn -> IO ()
1278 hSetPosn (HandlePosn h i) = hSeek h AbsoluteSeek i
1279
1280 -- ---------------------------------------------------------------------------
1281 -- hSeek
1282
1283 -- | A mode that determines the effect of 'hSeek' @hdl mode i@, as follows:
1284 data SeekMode
1285   = AbsoluteSeek        -- ^ the position of @hdl@ is set to @i@.
1286   | RelativeSeek        -- ^ the position of @hdl@ is set to offset @i@
1287                         -- from the current position.
1288   | SeekFromEnd         -- ^ the position of @hdl@ is set to offset @i@
1289                         -- from the end of the file.
1290     deriving (Eq, Ord, Ix, Enum, Read, Show)
1291
1292 {- Note:
1293  - when seeking using `SeekFromEnd', positive offsets (>=0) means
1294    seeking at or past EOF.
1295
1296  - we possibly deviate from the report on the issue of seeking within
1297    the buffer and whether to flush it or not.  The report isn't exactly
1298    clear here.
1299 -}
1300
1301 -- | Computation 'hSeek' @hdl mode i@ sets the position of handle
1302 -- @hdl@ depending on @mode@.
1303 -- The offset @i@ is given in terms of 8-bit bytes.
1304 --
1305 -- If @hdl@ is block- or line-buffered, then seeking to a position which is not
1306 -- in the current buffer will first cause any items in the output buffer to be
1307 -- written to the device, and then cause the input buffer to be discarded.
1308 -- Some handles may not be seekable (see 'hIsSeekable'), or only support a
1309 -- subset of the possible positioning operations (for instance, it may only
1310 -- be possible to seek to the end of a tape, or to a positive offset from
1311 -- the beginning or current position).
1312 -- It is not possible to set a negative I\/O position, or for
1313 -- a physical file, an I\/O position beyond the current end-of-file.
1314 --
1315 -- This operation may fail with:
1316 --
1317 --  * 'isPermissionError' if a system resource limit would be exceeded.
1318
1319 hSeek :: Handle -> SeekMode -> Integer -> IO ()
1320 hSeek handle mode offset =
1321     wantSeekableHandle "hSeek" handle $ \ handle_ -> do
1322 #   ifdef DEBUG_DUMP
1323     puts ("hSeek " ++ show (mode,offset) ++ "\n")
1324 #   endif
1325     let ref = haBuffer handle_
1326     buf <- readIORef ref
1327     let r = bufRPtr buf
1328         w = bufWPtr buf
1329         fd = haFD handle_
1330
1331     let do_seek =
1332           throwErrnoIfMinus1Retry_ "hSeek"
1333             (c_lseek (fromIntegral (haFD handle_)) (fromIntegral offset) whence)
1334
1335         whence :: CInt
1336         whence = case mode of
1337                    AbsoluteSeek -> sEEK_SET
1338                    RelativeSeek -> sEEK_CUR
1339                    SeekFromEnd  -> sEEK_END
1340
1341     if bufferIsWritable buf
1342         then do new_buf <- flushWriteBuffer fd (haIsStream handle_) buf
1343                 writeIORef ref new_buf
1344                 do_seek
1345         else do
1346
1347     if mode == RelativeSeek && offset >= 0 && offset < fromIntegral (w - r)
1348         then writeIORef ref buf{ bufRPtr = r + fromIntegral offset }
1349         else do
1350
1351     new_buf <- flushReadBuffer (haFD handle_) buf
1352     writeIORef ref new_buf
1353     do_seek
1354
1355
1356 hTell :: Handle -> IO Integer
1357 hTell handle =
1358     wantSeekableHandle "hGetPosn" handle $ \ handle_ -> do
1359
1360 #if defined(mingw32_HOST_OS)
1361         -- urgh, on Windows we have to worry about \n -> \r\n translation,
1362         -- so we can't easily calculate the file position using the
1363         -- current buffer size.  Just flush instead.
1364       flushBuffer handle_
1365 #endif
1366       let fd = fromIntegral (haFD handle_)
1367       posn <- fromIntegral `liftM`
1368                 throwErrnoIfMinus1Retry "hGetPosn"
1369                    (c_lseek fd 0 sEEK_CUR)
1370
1371       let ref = haBuffer handle_
1372       buf <- readIORef ref
1373
1374       let real_posn
1375            | bufferIsWritable buf = posn + fromIntegral (bufWPtr buf)
1376            | otherwise = posn - fromIntegral (bufWPtr buf - bufRPtr buf)
1377 #     ifdef DEBUG_DUMP
1378       puts ("\nhGetPosn: (fd, posn, real_posn) = " ++ show (fd, posn, real_posn) ++ "\n")
1379       puts ("   (bufWPtr, bufRPtr) = " ++ show (bufWPtr buf, bufRPtr buf) ++ "\n")
1380 #     endif
1381       return real_posn
1382
1383 -- -----------------------------------------------------------------------------
1384 -- Handle Properties
1385
1386 -- A number of operations return information about the properties of a
1387 -- handle.  Each of these operations returns `True' if the handle has
1388 -- the specified property, and `False' otherwise.
1389
1390 hIsOpen :: Handle -> IO Bool
1391 hIsOpen handle =
1392     withHandle_ "hIsOpen" handle $ \ handle_ -> do
1393     case haType handle_ of
1394       ClosedHandle         -> return False
1395       SemiClosedHandle     -> return False
1396       _                    -> return True
1397
1398 hIsClosed :: Handle -> IO Bool
1399 hIsClosed handle =
1400     withHandle_ "hIsClosed" handle $ \ handle_ -> do
1401     case haType handle_ of
1402       ClosedHandle         -> return True
1403       _                    -> return False
1404
1405 {- not defined, nor exported, but mentioned
1406    here for documentation purposes:
1407
1408     hSemiClosed :: Handle -> IO Bool
1409     hSemiClosed h = do
1410        ho <- hIsOpen h
1411        hc <- hIsClosed h
1412        return (not (ho || hc))
1413 -}
1414
1415 hIsReadable :: Handle -> IO Bool
1416 hIsReadable (DuplexHandle _ _ _) = return True
1417 hIsReadable handle =
1418     withHandle_ "hIsReadable" handle $ \ handle_ -> do
1419     case haType handle_ of
1420       ClosedHandle         -> ioe_closedHandle
1421       SemiClosedHandle     -> ioe_closedHandle
1422       htype                -> return (isReadableHandleType htype)
1423
1424 hIsWritable :: Handle -> IO Bool
1425 hIsWritable (DuplexHandle _ _ _) = return True
1426 hIsWritable handle =
1427     withHandle_ "hIsWritable" handle $ \ handle_ -> do
1428     case haType handle_ of
1429       ClosedHandle         -> ioe_closedHandle
1430       SemiClosedHandle     -> ioe_closedHandle
1431       htype                -> return (isWritableHandleType htype)
1432
1433 -- | Computation 'hGetBuffering' @hdl@ returns the current buffering mode
1434 -- for @hdl@.
1435
1436 hGetBuffering :: Handle -> IO BufferMode
1437 hGetBuffering handle =
1438     withHandle_ "hGetBuffering" handle $ \ handle_ -> do
1439     case haType handle_ of
1440       ClosedHandle         -> ioe_closedHandle
1441       _ ->
1442            -- We're being non-standard here, and allow the buffering
1443            -- of a semi-closed handle to be queried.   -- sof 6/98
1444           return (haBufferMode handle_)  -- could be stricter..
1445
1446 hIsSeekable :: Handle -> IO Bool
1447 hIsSeekable handle =
1448     withHandle_ "hIsSeekable" handle $ \ handle_ -> do
1449     case haType handle_ of
1450       ClosedHandle         -> ioe_closedHandle
1451       SemiClosedHandle     -> ioe_closedHandle
1452       AppendHandle         -> return False
1453       _                    -> do t <- fdType (haFD handle_)
1454                                  return (t == RegularFile
1455                                          && (haIsBin handle_
1456                                                 || tEXT_MODE_SEEK_ALLOWED))
1457
1458 -- -----------------------------------------------------------------------------
1459 -- Changing echo status (Non-standard GHC extensions)
1460
1461 -- | Set the echoing status of a handle connected to a terminal.
1462
1463 hSetEcho :: Handle -> Bool -> IO ()
1464 hSetEcho handle on = do
1465     isT   <- hIsTerminalDevice handle
1466     if not isT
1467      then return ()
1468      else
1469       withHandle_ "hSetEcho" handle $ \ handle_ -> do
1470       case haType handle_ of
1471          ClosedHandle -> ioe_closedHandle
1472          _            -> setEcho (haFD handle_) on
1473
1474 -- | Get the echoing status of a handle connected to a terminal.
1475
1476 hGetEcho :: Handle -> IO Bool
1477 hGetEcho handle = do
1478     isT   <- hIsTerminalDevice handle
1479     if not isT
1480      then return False
1481      else
1482        withHandle_ "hGetEcho" handle $ \ handle_ -> do
1483        case haType handle_ of
1484          ClosedHandle -> ioe_closedHandle
1485          _            -> getEcho (haFD handle_)
1486
1487 -- | Is the handle connected to a terminal?
1488
1489 hIsTerminalDevice :: Handle -> IO Bool
1490 hIsTerminalDevice handle = do
1491     withHandle_ "hIsTerminalDevice" handle $ \ handle_ -> do
1492      case haType handle_ of
1493        ClosedHandle -> ioe_closedHandle
1494        _            -> fdIsTTY (haFD handle_)
1495
1496 -- -----------------------------------------------------------------------------
1497 -- hSetBinaryMode
1498
1499 -- | Select binary mode ('True') or text mode ('False') on a open handle.
1500 -- (See also 'openBinaryFile'.)
1501
1502 hSetBinaryMode :: Handle -> Bool -> IO ()
1503 hSetBinaryMode handle bin =
1504   withAllHandles__ "hSetBinaryMode" handle $ \ handle_ ->
1505     do throwErrnoIfMinus1_ "hSetBinaryMode"
1506           (setmode (fromIntegral (haFD handle_)) bin)
1507        return handle_{haIsBin=bin}
1508
1509 foreign import ccall unsafe "__hscore_setmode"
1510   setmode :: CInt -> Bool -> IO CInt
1511
1512 -- -----------------------------------------------------------------------------
1513 -- Duplicating a Handle
1514
1515 -- | Returns a duplicate of the original handle, with its own buffer.
1516 -- The two Handles will share a file pointer, however.  The original
1517 -- handle's buffer is flushed, including discarding any input data,
1518 -- before the handle is duplicated.
1519
1520 hDuplicate :: Handle -> IO Handle
1521 hDuplicate h@(FileHandle path m) = do
1522   new_h_ <- withHandle' "hDuplicate" h m (dupHandle Nothing)
1523   newFileHandle path (handleFinalizer path) new_h_
1524 hDuplicate h@(DuplexHandle path r w) = do
1525   new_w_ <- withHandle' "hDuplicate" h w (dupHandle Nothing)
1526   new_w <- newMVar new_w_
1527   new_r_ <- withHandle' "hDuplicate" h r (dupHandle (Just new_w))
1528   new_r <- newMVar new_r_
1529   addMVarFinalizer new_w (handleFinalizer path new_w)
1530   return (DuplexHandle path new_r new_w)
1531
1532 dupHandle other_side h_ = do
1533   -- flush the buffer first, so we don't have to copy its contents
1534   flushBuffer h_
1535   new_fd <- throwErrnoIfMinus1 "dupHandle" $
1536                 c_dup (fromIntegral (haFD h_))
1537   dupHandle_ other_side h_ new_fd
1538
1539 dupHandleTo other_side hto_ h_ = do
1540   flushBuffer h_
1541   new_fd <- throwErrnoIfMinus1 "dupHandleTo" $
1542                 c_dup2 (fromIntegral (haFD h_)) (fromIntegral (haFD hto_))
1543   dupHandle_ other_side h_ new_fd
1544
1545 dupHandle_ other_side h_ new_fd = do
1546   buffer <- allocateBuffer dEFAULT_BUFFER_SIZE (initBufferState (haType h_))
1547   ioref <- newIORef buffer
1548   ioref_buffers <- newIORef BufferListNil
1549
1550   let new_handle_ = h_{ haFD = fromIntegral new_fd,
1551                         haBuffer = ioref,
1552                         haBuffers = ioref_buffers,
1553                         haOtherSide = other_side }
1554   return (h_, new_handle_)
1555
1556 -- -----------------------------------------------------------------------------
1557 -- Replacing a Handle
1558
1559 {- |
1560 Makes the second handle a duplicate of the first handle.  The second
1561 handle will be closed first, if it is not already.
1562
1563 This can be used to retarget the standard Handles, for example:
1564
1565 > do h <- openFile "mystdout" WriteMode
1566 >    hDuplicateTo h stdout
1567 -}
1568
1569 hDuplicateTo :: Handle -> Handle -> IO ()
1570 hDuplicateTo h1@(FileHandle _ m1) h2@(FileHandle _ m2)  = do
1571  withHandle__' "hDuplicateTo" h2 m2 $ \h2_ -> do
1572    _ <- hClose_help h2_
1573    withHandle' "hDuplicateTo" h1 m1 (dupHandleTo Nothing h2_)
1574 hDuplicateTo h1@(DuplexHandle _ r1 w1) h2@(DuplexHandle _ r2 w2)  = do
1575  withHandle__' "hDuplicateTo" h2 w2  $ \w2_ -> do
1576    _ <- hClose_help w2_
1577    withHandle' "hDuplicateTo" h1 r1 (dupHandleTo Nothing w2_)
1578  withHandle__' "hDuplicateTo" h2 r2  $ \r2_ -> do
1579    _ <- hClose_help r2_
1580    withHandle' "hDuplicateTo" h1 r1 (dupHandleTo (Just w1) r2_)
1581 hDuplicateTo h1 _ =
1582    ioException (IOError (Just h1) IllegalOperation "hDuplicateTo"
1583                 "handles are incompatible" Nothing)
1584
1585 -- ---------------------------------------------------------------------------
1586 -- showing Handles.
1587 --
1588 -- | 'hShow' is in the 'IO' monad, and gives more comprehensive output
1589 -- than the (pure) instance of 'Show' for 'Handle'.
1590
1591 hShow :: Handle -> IO String
1592 hShow h@(FileHandle path _) = showHandle' path False h
1593 hShow h@(DuplexHandle path _ _) = showHandle' path True h
1594
1595 showHandle' filepath is_duplex h =
1596   withHandle_ "showHandle" h $ \hdl_ ->
1597     let
1598      showType | is_duplex = showString "duplex (read-write)"
1599               | otherwise = shows (haType hdl_)
1600     in
1601     return
1602       (( showChar '{' .
1603         showHdl (haType hdl_)
1604             (showString "loc=" . showString filepath . showChar ',' .
1605              showString "type=" . showType . showChar ',' .
1606              showString "binary=" . shows (haIsBin hdl_) . showChar ',' .
1607              showString "buffering=" . showBufMode (unsafePerformIO (readIORef (haBuffer hdl_))) (haBufferMode hdl_) . showString "}" )
1608       ) "")
1609    where
1610
1611     showHdl :: HandleType -> ShowS -> ShowS
1612     showHdl ht cont =
1613        case ht of
1614         ClosedHandle  -> shows ht . showString "}"
1615         _ -> cont
1616
1617     showBufMode :: Buffer -> BufferMode -> ShowS
1618     showBufMode buf bmo =
1619       case bmo of
1620         NoBuffering   -> showString "none"
1621         LineBuffering -> showString "line"
1622         BlockBuffering (Just n) -> showString "block " . showParen True (shows n)
1623         BlockBuffering Nothing  -> showString "block " . showParen True (shows def)
1624       where
1625        def :: Int
1626        def = bufSize buf
1627
1628 -- ---------------------------------------------------------------------------
1629 -- debugging
1630
1631 #ifdef DEBUG_DUMP
1632 puts :: String -> IO ()
1633 puts s = withCString s $ \cstr -> do write_rawBuffer 1 False cstr 0 (fromIntegral (length s))
1634                                      return ()
1635 #endif
1636
1637 -- -----------------------------------------------------------------------------
1638 -- utils
1639
1640 throwErrnoIfMinus1RetryOnBlock  :: String -> IO CInt -> IO CInt -> IO CInt
1641 throwErrnoIfMinus1RetryOnBlock loc f on_block  =
1642   do
1643     res <- f
1644     if (res :: CInt) == -1
1645       then do
1646         err <- getErrno
1647         if err == eINTR
1648           then throwErrnoIfMinus1RetryOnBlock loc f on_block
1649           else if err == eWOULDBLOCK || err == eAGAIN
1650                  then do on_block
1651                  else throwErrno loc
1652       else return res
1653
1654 -- -----------------------------------------------------------------------------
1655 -- wrappers to platform-specific constants:
1656
1657 foreign import ccall unsafe "__hscore_supportsTextMode"
1658   tEXT_MODE_SEEK_ALLOWED :: Bool
1659
1660 foreign import ccall unsafe "__hscore_bufsiz"   dEFAULT_BUFFER_SIZE :: Int
1661 foreign import ccall unsafe "__hscore_seek_cur" sEEK_CUR :: CInt
1662 foreign import ccall unsafe "__hscore_seek_set" sEEK_SET :: CInt
1663 foreign import ccall unsafe "__hscore_seek_end" sEEK_END :: CInt