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