ghc/lib/std/PrelHandle.lhs

   1 %
   2 % (c) The AQUA Project, Glasgow University, 1994-1996
   3 %
   4
   5 \section[PrelHandle]{Module @PrelHandle@}
   6
   7 This module defines Haskell {\em handles} and the basic operations
   8 which are supported for them.
   9
  10 \begin{code}
  11 {-# OPTIONS -fno-implicit-prelude -#include "cbits/stgio.h" #-}
  12 #include "cbits/stgerror.h"
  13
  14 #ifndef __HUGS__ /* Hugs just includes this in PreludeBuiltin so no header needed */
  15 module PrelHandle where
  16
  17 import PrelBase
  18 import PrelAddr         ( Addr, nullAddr )
  19 import PrelByteArr      ( ByteArray(..), MutableByteArray(..) )
  20 import PrelRead         ( Read )
  21 import PrelList         ( span )
  22 import PrelIOBase
  23 import PrelException
  24 import PrelMaybe        ( Maybe(..) )
  25 import PrelEnum
  26 import PrelNum          ( toBig, Integer(..), Num(..) )
  27 import PrelShow
  28 import PrelAddr         ( Addr, nullAddr )
  29 import PrelReal         ( toInteger )
  30 import PrelPack         ( packString )
  31 #ifndef __PARALLEL_HASKELL__
  32 import PrelWeak         ( addForeignFinalizer )
  33 #endif
  34 import Ix
  35
  36 import PrelConc
  37
  38 #ifndef __PARALLEL_HASKELL__
  39 import PrelForeign  ( makeForeignObj )
  40 #endif
  41
  42 #endif /* ndef(__HUGS__) */
  43
  44 #ifdef __HUGS__
  45 #define __CONCURRENT_HASKELL__
  46 #define stToIO id
  47 #endif
  48
  49 #ifndef __PARALLEL_HASKELL__
  50 #define FILE_OBJECT         ForeignObj
  51 #else
  52 #define FILE_OBJECT         Addr
  53 #endif
  54 \end{code}
  55
  56 %*********************************************************
  57 %*                                                      *
  58 \subsection{Types @Handle@, @Handle__@}
  59 %*                                                      *
  60 %*********************************************************
  61
  62 The @Handle@ and @Handle__@ types are defined in @IOBase@.
  63
  64 \begin{code}
  65 {-# INLINE newHandle   #-}
  66 {-# INLINE withHandle #-}
  67 newHandle     :: Handle__ -> IO Handle
  68
  69 -- Use MVars for concurrent Haskell
  70 newHandle hc  = newMVar hc      >>= \ h ->
  71                 return (Handle h)
  72 \end{code}
  73
  74 %*********************************************************
  75 %*                                                      *
  76 \subsection{@withHandle@ operations}
  77 %*                                                      *
  78 %*********************************************************
  79
  80 In the concurrent world, handles are locked during use.  This is done
  81 by wrapping an MVar around the handle which acts as a mutex over
  82 operations on the handle.
  83
  84 To avoid races, we use the following bracketing operations.  The idea
  85 is to obtain the lock, do some operation and replace the lock again,
  86 whether the operation succeeded or failed.  We also want to handle the
  87 case where the thread receives an exception while processing the IO
  88 operation: in these cases we also want to relinquish the lock.
  89
  90 There are three versions of @withHandle@: corresponding to the three
  91 possible combinations of:
  92
  93         - the operation may side-effect the handle
  94         - the operation may return a result
  95
  96 If the operation generates an error or an exception is raised, the
  97 orignal handle is always replaced [ this is the case at the moment,
  98 but we might want to revisit this in the future --SDM ].
  99
 100 \begin{code}
 101 withHandle :: Handle -> (Handle__ -> IO (Handle__,a)) -> IO a
 102 withHandle (Handle h) act = do
 103    h_ <- takeMVar h
 104    (h',v)  <- catchException (act h_) (\ ex -> putMVar h h_ >> throw ex)
 105    putMVar h h'
 106    return v
 107
 108 withHandle_ :: Handle -> (Handle__ -> IO a) -> IO a
 109 withHandle_ (Handle h) act = do
 110    h_ <- takeMVar h
 111    v  <- catchException (act h_) (\ ex -> putMVar h h_ >> throw ex)
 112    putMVar h h_
 113    return v
 114
 115 withHandle__ :: Handle -> (Handle__ -> IO Handle__) -> IO ()
 116 withHandle__ (Handle h) act = do
 117    h_ <- takeMVar h
 118    h'  <- catchException (act h_) (\ ex -> putMVar h h_ >> throw ex)
 119    putMVar h h'
 120    return ()
 121 \end{code}
 122
 123 nullFile__ is only used for closed handles, plugging it in as a null
 124 file object reference.
 125
 126 \begin{code}
 127 nullFile__ :: FILE_OBJECT
 128 nullFile__ =
 129 #ifndef __PARALLEL_HASKELL__
 130     unsafePerformIO (makeForeignObj nullAddr)
 131 #else
 132     nullAddr
 133 #endif
 134
 135
 136 mkClosedHandle__ :: Handle__
 137 mkClosedHandle__ =
 138   Handle__
 139            nullFile__
 140            ClosedHandle
 141            NoBuffering
 142            "closed file"
 143
 144 mkErrorHandle__ :: IOError -> Handle__
 145 mkErrorHandle__ ioe =
 146   Handle__
 147            nullFile__
 148            (ErrorHandle ioe)
 149            NoBuffering
 150            "error handle"
 151 \end{code}
 152
 153 %*********************************************************
 154 %*                                                      *
 155 \subsection{Handle Finalizers}
 156 %*                                                      *
 157 %*********************************************************
 158
 159 \begin{code}
 160 foreign import "libHS_cbits" "freeStdFileObject" unsafe
 161         freeStdFileObject :: FILE_OBJECT -> IO ()
 162 foreign import "libHS_cbits" "freeFileObject" unsafe
 163         freeFileObject :: FILE_OBJECT -> IO ()
 164
 165 \end{code}
 166
 167 %*********************************************************
 168 %*                                                      *
 169 \subsection[StdHandles]{Standard handles}
 170 %*                                                      *
 171 %*********************************************************
 172
 173 Three handles are allocated during program initialisation.  The first
 174 two manage input or output from the Haskell program's standard input
 175 or output channel respectively.  The third manages output to the
 176 standard error channel. These handles are initially open.
 177
 178
 179 \begin{code}
 180 stdin, stdout, stderr :: Handle
 181
 182 stdout = unsafePerformIO (do
 183     rc <- getLock (1::Int) (1::Int)   -- ConcHask: SAFE, won't block
 184     case (rc::Int) of
 185        0 -> newHandle (mkClosedHandle__)
 186        1 -> do
 187             fo <- openStdFile (1::Int)
 188                               (0::Int){-writeable-}  -- ConcHask: SAFE, won't block
 189
 190 #ifndef __PARALLEL_HASKELL__
 191             fo <- makeForeignObj fo
 192             addForeignFinalizer fo (freeStdFileObject fo)
 193 #endif
 194
 195 #ifdef __HUGS__
 196 /* I dont care what the Haskell report says, in an interactive system,
 197  * stdout should be unbuffered by default.
 198  */
 199             let bm = NoBuffering
 200 #else
 201             (bm, bf_size)  <- getBMode__ fo
 202             mkBuffer__ fo bf_size
 203 #endif
 204             newHandle (Handle__ fo WriteHandle bm "stdout")
 205        _ -> do ioError <- constructError "stdout"
 206                newHandle (mkErrorHandle__ ioError)
 207   )
 208
 209 stdin = unsafePerformIO (do
 210     rc <- getLock (0::Int) (0::Int)   -- ConcHask: SAFE, won't block
 211     case (rc::Int) of
 212        0 -> newHandle (mkClosedHandle__)
 213        1 -> do
 214             fo <- openStdFile (0::Int)
 215                               (1::Int){-readable-}  -- ConcHask: SAFE, won't block
 216
 217 #ifndef __PARALLEL_HASKELL__
 218             fo <- makeForeignObj fo
 219             addForeignFinalizer fo (freeStdFileObject fo)
 220 #endif
 221             (bm, bf_size) <- getBMode__ fo
 222             mkBuffer__ fo bf_size
 223             hdl <- newHandle (Handle__ fo ReadHandle bm "stdin")
 224              -- when stdin and stdout are both connected to a terminal, ensure
 225              -- that anything buffered on stdout is flushed prior to reading from stdin.
 226              --
 227             hConnectTerms stdout hdl
 228             return hdl
 229        _ -> do ioError <- constructError "stdin"
 230                newHandle (mkErrorHandle__ ioError)
 231   )
 232
 233
 234 stderr = unsafePerformIO (do
 235     rc <- getLock (2::Int) (1::Int){-writeable-}  -- ConcHask: SAFE, won't block
 236     case (rc::Int) of
 237        0 -> newHandle (mkClosedHandle__)
 238        1 -> do
 239             fo <- openStdFile (2::Int)
 240                               (0::Int){-writeable-} -- ConcHask: SAFE, won't block
 241
 242 #ifndef __PARALLEL_HASKELL__
 243             fo <- makeForeignObj fo
 244             addForeignFinalizer fo (freeStdFileObject fo)
 245 #endif
 246             hdl <- newHandle (Handle__ fo WriteHandle NoBuffering "stderr")
 247             -- when stderr and stdout are both connected to a terminal, ensure
 248             -- that anything buffered on stdout is flushed prior to writing to
 249             -- stderr.
 250             hConnectTo stdout hdl
 251             return hdl
 252
 253        _ -> do ioError <- constructError "stderr"
 254                newHandle (mkErrorHandle__ ioError)
 255   )
 256 \end{code}
 257
 258 %*********************************************************
 259 %*                                                      *
 260 \subsection[OpeningClosing]{Opening and Closing Files}
 261 %*                                                      *
 262 %*********************************************************
 263
 264 \begin{code}
 265 data IOMode      =  ReadMode | WriteMode | AppendMode | ReadWriteMode
 266                     deriving (Eq, Ord, Ix, Enum, Read, Show)
 267
 268 data IOModeEx
 269  = BinaryMode IOMode
 270  | TextMode   IOMode
 271    deriving (Eq, Read, Show)
 272
 273 openFile :: FilePath -> IOMode -> IO Handle
 274 openFile fp im = openFileEx fp (TextMode im)
 275
 276 openFileEx :: FilePath -> IOModeEx -> IO Handle
 277
 278 openFileEx f m = do
 279     fo <- primOpenFile (packString f)
 280                        (file_mode::Int)
 281                        (binary::Int)     -- ConcHask: SAFE, won't block
 282     if fo /= nullAddr then do
 283 #ifndef __PARALLEL_HASKELL__
 284         fo  <- makeForeignObj fo
 285         addForeignFinalizer fo (freeFileObject fo)
 286 #endif
 287         (bm, bf_size)  <- getBMode__ fo
 288         mkBuffer__ fo bf_size
 289         newHandle (Handle__ fo htype bm f)
 290       else do
 291         constructErrorAndFailWithInfo "openFile" f
 292   where
 293     (imo, binary) =
 294       case m of
 295         BinaryMode bmo -> (bmo, 1)
 296         TextMode tmo   -> (tmo, 0)
 297
 298     file_mode =
 299       case imo of
 300            AppendMode    -> 0
 301            WriteMode     -> 1
 302            ReadMode      -> 2
 303            ReadWriteMode -> 3
 304
 305     htype = case imo of
 306               ReadMode      -> ReadHandle
 307               WriteMode     -> WriteHandle
 308               AppendMode    -> AppendHandle
 309               ReadWriteMode -> ReadWriteHandle
 310 \end{code}
 311
 312 Computation $openFile file mode$ allocates and returns a new, open
 313 handle to manage the file {\em file}.  It manages input if {\em mode}
 314 is $ReadMode$, output if {\em mode} is $WriteMode$ or $AppendMode$,
 315 and both input and output if mode is $ReadWriteMode$.
 316
 317 If the file does not exist and it is opened for output, it should be
 318 created as a new file.  If {\em mode} is $WriteMode$ and the file
 319 already exists, then it should be truncated to zero length.  The
 320 handle is positioned at the end of the file if {\em mode} is
 321 $AppendMode$, and otherwise at the beginning (in which case its
 322 internal position is 0).
 323
 324 Implementations should enforce, locally to the Haskell process,
 325 multiple-reader single-writer locking on files, which is to say that
 326 there may either be many handles on the same file which manage input,
 327 or just one handle on the file which manages output.  If any open or
 328 semi-closed handle is managing a file for output, no new handle can be
 329 allocated for that file.  If any open or semi-closed handle is
 330 managing a file for input, new handles can only be allocated if they
 331 do not manage output.
 332
 333 Two files are the same if they have the same absolute name.  An
 334 implementation is free to impose stricter conditions.
 335
 336 \begin{code}
 337 hClose :: Handle -> IO ()
 338
 339 hClose handle =
 340     withHandle__ handle $ \ handle_ -> do
 341     case haType__ handle_ of
 342       ErrorHandle theError -> ioError theError
 343       ClosedHandle         -> return handle_
 344       _ -> do
 345           rc      <- closeFile (haFO__ handle_)
 346                                (1::Int){-flush if you can-}  -- ConcHask: SAFE, won't block
 347           {- We explicitly close a file object so that we can be told
 348              if there were any errors. Note that after @hClose@
 349              has been performed, the ForeignObj embedded in the Handle
 350              is still lying around in the heap, so care is taken
 351              to avoid closing the file object when the ForeignObj
 352              is finalized. (we overwrite the file ptr in the underlying
 353              FileObject with a NULL as part of closeFile())
 354           -}
 355           if rc == (0::Int)
 356            then return (handle_{ haType__   = ClosedHandle,
 357                                  haFO__     = nullFile__ })
 358            else constructErrorAndFail "hClose"
 359
 360 \end{code}
 361
 362 Computation $hClose hdl$ makes handle {\em hdl} closed.  Before the
 363 computation finishes, any items buffered for output and not already
 364 sent to the operating system are flushed as for $flush$.
 365
 366 %*********************************************************
 367 %*                                                      *
 368 \subsection[FileSize]{Detecting the size of a file}
 369 %*                                                      *
 370 %*********************************************************
 371
 372
 373 For a handle {\em hdl} which attached to a physical file, $hFileSize
 374 hdl$ returns the size of {\em hdl} in terms of the number of items
 375 which can be read from {\em hdl}.
 376
 377 \begin{code}
 378 hFileSize :: Handle -> IO Integer
 379 hFileSize handle =
 380     withHandle_ handle $ \ handle_ -> do
 381     case haType__ handle_ of
 382       ErrorHandle theError      -> ioError theError
 383       ClosedHandle              -> ioe_closedHandle "hFileSize" handle
 384       SemiClosedHandle          -> ioe_closedHandle "hFileSize" handle
 385 #ifdef __HUGS__
 386       _ -> do
 387           mem <- primNewByteArray 8{-sizeof_int64-}
 388           rc <- fileSize_int64 (haFO__ handle_) mem  -- ConcHask: SAFE, won't block
 389           if rc == 0 then do
 390              result <- primReadInt64Array mem 0
 391              return (primInt64ToInteger result)
 392            else
 393              constructErrorAndFail "hFileSize"
 394 #else
 395       _ ->
 396           -- HACK!  We build a unique MP_INT of the right shape to hold
 397           -- a single unsigned word, and we let the C routine
 398           -- change the data bits
 399           --
 400           case int2Integer# 1# of
 401               (# s, d #) -> do
 402                 rc <- fileSize (haFO__ handle_) d  -- ConcHask: SAFE, won't block
 403                 if rc == (0::Int) then
 404                    return (J# s d)
 405                  else
 406                    constructErrorAndFail "hFileSize"
 407 #endif
 408 \end{code}
 409
 410 %*********************************************************
 411 %*                                                      *
 412 \subsection[EOF]{Detecting the End of Input}
 413 %*                                                      *
 414 %*********************************************************
 415
 416
 417 For a readable handle {\em hdl}, @hIsEOF hdl@ returns
 418 @True@ if no further input can be taken from @hdl@ or for a
 419 physical file, if the current I/O position is equal to the length of
 420 the file.  Otherwise, it returns @False@.
 421
 422 \begin{code}
 423 hIsEOF :: Handle -> IO Bool
 424 hIsEOF handle = do
 425     rc <- mayBlockRead "hIsEOF" handle fileEOF
 426     case rc of
 427       0 -> return False
 428       1 -> return True
 429       _ -> constructErrorAndFail "hIsEOF"
 430
 431 isEOF :: IO Bool
 432 isEOF = hIsEOF stdin
 433 \end{code}
 434
 435 %*********************************************************
 436 %*                                                      *
 437 \subsection[Buffering]{Buffering Operations}
 438 %*                                                      *
 439 %*********************************************************
 440
 441 Three kinds of buffering are supported: line-buffering,
 442 block-buffering or no-buffering.  See @IOBase@ for definition
 443 and further explanation of what the type represent.
 444
 445 Computation @hSetBuffering hdl mode@ sets the mode of buffering for
 446 handle {\em hdl} on subsequent reads and writes.
 447
 448 \begin{itemize}
 449 \item
 450 If {\em mode} is @LineBuffering@, line-buffering should be
 451 enabled if possible.
 452 \item
 453 If {\em mode} is @BlockBuffering@ {\em size}, then block-buffering
 454 should be enabled if possible.  The size of the buffer is {\em n} items
 455 if {\em size} is @Just@~{\em n} and is otherwise implementation-dependent.
 456 \item
 457 If {\em mode} is @NoBuffering@, then buffering is disabled if possible.
 458 \end{itemize}
 459
 460 If the buffer mode is changed from @BlockBuffering@ or @LineBuffering@
 461 to @NoBuffering@, then any items in the output buffer are written to
 462 the device, and any items in the input buffer are discarded.  The
 463 default buffering mode when a handle is opened is
 464 implementation-dependent and may depend on the object which is
 465 attached to that handle.
 466
 467 \begin{code}
 468 hSetBuffering :: Handle -> BufferMode -> IO ()
 469
 470 hSetBuffering handle mode =
 471     case mode of
 472       BlockBuffering (Just n)
 473         | n <= 0 -> ioError
 474                          (IOError (Just handle)
 475                                   InvalidArgument
 476                                   "hSetBuffering"
 477                                   ("illegal buffer size " ++ showsPrec 9 n []))  -- 9 => should be parens'ified.
 478       _ ->
 479           withHandle__ handle $ \ handle_ -> do
 480           case haType__ handle_ of
 481              ErrorHandle theError -> ioError theError
 482              ClosedHandle         -> ioe_closedHandle "hSetBuffering" handle
 483              _ -> do
 484                 {- Note:
 485                     - we flush the old buffer regardless of whether
 486                       the new buffer could fit the contents of the old buffer
 487                       or not.
 488                     - allow a handle's buffering to change even if IO has
 489                       occurred (ANSI C spec. does not allow this, nor did
 490                       the previous implementation of IO.hSetBuffering).
 491                     - a non-standard extension is to allow the buffering
 492                       of semi-closed handles to change [sof 6/98]
 493                 -}
 494                 let fo = haFO__ handle_
 495                 rc <- mayBlock fo (setBuffering fo bsize) -- ConcHask: UNSAFE, may block
 496                 if rc == 0
 497                  then do
 498                    return (handle_{ haBufferMode__ = mode })
 499                  else do
 500                    -- Note: failure to change the buffer size will cause old buffer to be flushed.
 501                    constructErrorAndFail "hSetBuffering"
 502   where
 503     bsize :: Int
 504     bsize = case mode of
 505               NoBuffering             ->  0
 506               LineBuffering           -> -1
 507               BlockBuffering Nothing  -> -2
 508               BlockBuffering (Just n) ->  n
 509 \end{code}
 510
 511 The action @hFlush hdl@ causes any items buffered for output
 512 in handle {\em hdl} to be sent immediately to the operating
 513 system.
 514
 515 \begin{code}
 516 hFlush :: Handle -> IO ()
 517 hFlush handle =
 518     wantWriteableHandle "hFlush" handle $ \ handle_ -> do
 519     let fo = haFO__ handle_
 520     rc      <- mayBlock fo (flushFile fo)   -- ConcHask: UNSAFE, may block
 521     if rc == 0 then
 522        return ()
 523      else
 524        constructErrorAndFail "hFlush"
 525
 526 \end{code}
 527
 528
 529 %*********************************************************
 530 %*                                                      *
 531 \subsection[Seeking]{Repositioning Handles}
 532 %*                                                      *
 533 %*********************************************************
 534
 535 \begin{code}
 536 data HandlePosn
 537  = HandlePosn
 538         Handle   -- Q: should this be a weak or strong ref. to the handle?
 539                  --    [what's the winning argument for it not being strong? --sof]
 540         HandlePosition
 541
 542 instance Eq HandlePosn where
 543     (HandlePosn h1 p1) == (HandlePosn h2 p2) = p1==p2 && h1==h2
 544
 545   -- HandlePosition is the Haskell equivalent of POSIX' off_t.
 546   -- We represent it as an Integer on the Haskell side, but
 547   -- cheat slightly in that hGetPosn calls upon a C helper
 548   -- that reports the position back via (merely) an Int.
 549 type HandlePosition = Integer
 550
 551 mkHandlePosn :: Handle -> HandlePosition -> HandlePosn
 552 mkHandlePosn h p = HandlePosn h p
 553
 554 data SeekMode    =  AbsoluteSeek | RelativeSeek | SeekFromEnd
 555                     deriving (Eq, Ord, Ix, Enum, Read, Show)
 556 \end{code}
 557
 558 Computation @hGetPosn hdl@ returns the current I/O
 559 position of {\em hdl} as an abstract position.  Computation
 560 $hSetPosn p$ sets the position of {\em hdl}
 561 to a previously obtained position {\em p}.
 562
 563 \begin{code}
 564 hGetPosn :: Handle -> IO HandlePosn
 565 hGetPosn handle =
 566     wantSeekableHandle "hGetPosn" handle $ \ handle_ -> do
 567     posn    <- getFilePosn (haFO__ handle_)   -- ConcHask: SAFE, won't block
 568     if posn /= -1 then do
 569       return (mkHandlePosn handle (fromInt posn))
 570      else
 571       constructErrorAndFail "hGetPosn"
 572
 573 hSetPosn :: HandlePosn -> IO ()
 574 hSetPosn (HandlePosn handle i@(S# _))   = hSetPosn (HandlePosn handle (toBig i))
 575 hSetPosn (HandlePosn handle (J# s# d#)) =
 576     wantSeekableHandle "hSetPosn" handle $ \ handle_ -> do
 577            -- not as silly as it looks: the handle may have been closed in the meantime.
 578     let fo = haFO__ handle_
 579     rc     <- mayBlock fo (setFilePosn fo (I# s#) d#)    -- ConcHask: UNSAFE, may block
 580     if rc == 0 then do
 581        return ()
 582      else
 583         constructErrorAndFail "hSetPosn"
 584 \end{code}
 585
 586 The action @hSeek hdl mode i@ sets the position of handle
 587 @hdl@ depending on @mode@.  If @mode@ is
 588
 589  * AbsoluteSeek - The position of @hdl@ is set to @i@.
 590  * RelativeSeek - The position of @hdl@ is set to offset @i@ from
 591                   the current position.
 592  * SeekFromEnd  - The position of @hdl@ is set to offset @i@ from
 593                   the end of the file.
 594
 595 Some handles may not be seekable (see @hIsSeekable@), or only
 596 support a subset of the possible positioning operations (e.g. it may
 597 only be possible to seek to the end of a tape, or to a positive
 598 offset from the beginning or current position).
 599
 600 It is not possible to set a negative I/O position, or for a physical
 601 file, an I/O position beyond the current end-of-file.
 602
 603 Note:
 604  - when seeking using @SeekFromEnd@, positive offsets (>=0) means
 605    seeking at or past EOF.
 606  - relative seeking on buffered handles can lead to non-obvious results.
 607
 608 \begin{code}
 609 hSeek :: Handle -> SeekMode -> Integer -> IO ()
 610 #ifdef __HUGS__
 611 hSeek handle mode offset =
 612     wantSeekableHandle "hSeek" handle $ \ handle_ -> do
 613     let fo = haFO__ handle_
 614     rc      <- mayBlock fo (seekFile fo whence (primIntegerToInt64 offset))  -- ConcHask: UNSAFE, may block
 615 #else
 616 hSeek handle mode i@(S# _) = hSeek handle mode (toBig i)
 617 hSeek handle mode (J# s# d#) =
 618     wantSeekableHandle "hSeek" handle $ \ handle_ -> do
 619     let fo = haFO__ handle_
 620     rc      <- mayBlock fo (seekFile fo whence (I# s#) d#)  -- ConcHask: UNSAFE, may block
 621 #endif
 622     if rc == 0 then do
 623        return ()
 624      else
 625         constructErrorAndFail "hSeek"
 626   where
 627     whence :: Int
 628     whence = case mode of
 629                AbsoluteSeek -> 0
 630                RelativeSeek -> 1
 631                SeekFromEnd  -> 2
 632 \end{code}
 633
 634 %*********************************************************
 635 %*                                                      *
 636 \subsection[Query]{Handle Properties}
 637 %*                                                      *
 638 %*********************************************************
 639
 640 A number of operations return information about the properties of a
 641 handle.  Each of these operations returns $True$ if the
 642 handle has the specified property, and $False$
 643 otherwise.
 644
 645 Computation $hIsBlockBuffered hdl$ returns $( False, Nothing )$ if
 646 {\em hdl} is not block-buffered.  Otherwise it returns
 647 $( True, size )$, where {\em size} is $Nothing$ for default buffering, and
 648 $( Just n )$ for block-buffering of {\em n} bytes.
 649
 650 \begin{code}
 651 hIsOpen :: Handle -> IO Bool
 652 hIsOpen handle =
 653     withHandle_ handle $ \ handle_ -> do
 654     case haType__ handle_ of
 655       ErrorHandle theError -> ioError theError
 656       ClosedHandle         -> return False
 657       SemiClosedHandle     -> return False
 658       _                    -> return True
 659
 660 hIsClosed :: Handle -> IO Bool
 661 hIsClosed handle =
 662     withHandle_ handle $ \ handle_ -> do
 663     case haType__ handle_ of
 664       ErrorHandle theError -> ioError theError
 665       ClosedHandle         -> return True
 666       _                    -> return False
 667
 668 {- not defined, nor exported, but mentioned
 669    here for documentation purposes:
 670
 671     hSemiClosed :: Handle -> IO Bool
 672     hSemiClosed h = do
 673        ho <- hIsOpen h
 674        hc <- hIsClosed h
 675        return (not (ho || hc))
 676 -}
 677
 678 hIsReadable :: Handle -> IO Bool
 679 hIsReadable handle =
 680     withHandle_ handle $ \ handle_ -> do
 681     case haType__ handle_ of
 682       ErrorHandle theError -> ioError theError
 683       ClosedHandle         -> ioe_closedHandle "hIsReadable" handle
 684       SemiClosedHandle     -> ioe_closedHandle "hIsReadable" handle
 685       htype                -> return (isReadable htype)
 686   where
 687     isReadable ReadHandle      = True
 688     isReadable ReadWriteHandle = True
 689     isReadable _               = False
 690
 691 hIsWritable :: Handle -> IO Bool
 692 hIsWritable handle =
 693     withHandle_ handle $ \ handle_ -> do
 694     case haType__ handle_ of
 695       ErrorHandle theError -> ioError theError
 696       ClosedHandle         -> ioe_closedHandle "hIsWritable" handle
 697       SemiClosedHandle     -> ioe_closedHandle "hIsWritable" handle
 698       htype                -> return (isWritable htype)
 699   where
 700     isWritable AppendHandle    = True
 701     isWritable WriteHandle     = True
 702     isWritable ReadWriteHandle = True
 703     isWritable _               = False
 704
 705
 706 #ifndef __PARALLEL_HASKELL__
 707 getBMode__ :: ForeignObj -> IO (BufferMode, Int)
 708 #else
 709 getBMode__ :: Addr -> IO (BufferMode, Int)
 710 #endif
 711 getBMode__ fo = do
 712   rc <- getBufferMode fo    -- ConcHask: SAFE, won't block
 713   case (rc::Int) of
 714     0  -> return (NoBuffering, 0)
 715     -1 -> return (LineBuffering, default_buffer_size)
 716     -2 -> return (BlockBuffering Nothing, default_buffer_size)
 717     -3 -> return (NoBuffering, 0)               -- only happens on un-stat()able files.
 718     n  -> return (BlockBuffering (Just n), n)
 719  where
 720    default_buffer_size :: Int
 721    default_buffer_size = (const_BUFSIZ - 1)
 722 \end{code}
 723
 724 Querying how a handle buffers its data:
 725
 726 \begin{code}
 727 hGetBuffering :: Handle -> IO BufferMode
 728 hGetBuffering handle =
 729     withHandle_ handle $ \ handle_ -> do
 730     case haType__ handle_ of
 731       ErrorHandle theError -> ioError theError
 732       ClosedHandle         -> ioe_closedHandle "hGetBuffering" handle
 733       _ ->
 734           {-
 735            We're being non-standard here, and allow the buffering
 736            of a semi-closed handle to be queried.   -- sof 6/98
 737           -}
 738           return (haBufferMode__ handle_)  -- could be stricter..
 739 \end{code}
 740
 741 \begin{code}
 742 hIsSeekable :: Handle -> IO Bool
 743 hIsSeekable handle =
 744     withHandle_ handle $ \ handle_ -> do
 745     case haType__ handle_ of
 746       ErrorHandle theError -> ioError theError
 747       ClosedHandle         -> ioe_closedHandle "hIsSeekable" handle
 748       SemiClosedHandle     -> ioe_closedHandle "hIsSeekable" handle
 749       AppendHandle         -> return False
 750       _ -> do
 751           rc <- seekFileP (haFO__ handle_)   -- ConcHask: SAFE, won't block
 752           case (rc::Int) of
 753             0 -> return False
 754             1 -> return True
 755             _ -> constructErrorAndFail "hIsSeekable"
 756 \end{code}
 757
 758
 759 %*********************************************************
 760 %*                                                      *
 761 \subsection{Changing echo status}
 762 %*                                                      *
 763 %*********************************************************
 764
 765 Non-standard GHC extension is to allow the echoing status
 766 of a handles connected to terminals to be reconfigured:
 767
 768 \begin{code}
 769 hSetEcho :: Handle -> Bool -> IO ()
 770 hSetEcho handle on = do
 771     isT   <- hIsTerminalDevice handle
 772     if not isT
 773      then return ()
 774      else
 775       withHandle_ handle $ \ handle_ -> do
 776       case haType__ handle_ of
 777          ErrorHandle theError -> ioError theError
 778          ClosedHandle         -> ioe_closedHandle "hSetEcho" handle
 779          _ -> do
 780             rc <- setTerminalEcho (haFO__ handle_) (if on then 1 else 0)  -- ConcHask: SAFE, won't block
 781             if rc /= ((-1)::Int)
 782              then return ()
 783              else constructErrorAndFail "hSetEcho"
 784
 785 hGetEcho :: Handle -> IO Bool
 786 hGetEcho handle = do
 787     isT   <- hIsTerminalDevice handle
 788     if not isT
 789      then return False
 790      else
 791        withHandle_ handle $ \ handle_ -> do
 792        case haType__ handle_ of
 793          ErrorHandle theError -> ioError theError
 794          ClosedHandle         -> ioe_closedHandle "hGetEcho" handle
 795          _ -> do
 796             rc <- getTerminalEcho (haFO__ handle_)  -- ConcHask: SAFE, won't block
 797             case (rc::Int) of
 798               1 -> return True
 799               0 -> return False
 800               _ -> constructErrorAndFail "hSetEcho"
 801
 802 hIsTerminalDevice :: Handle -> IO Bool
 803 hIsTerminalDevice handle = do
 804     withHandle_ handle $ \ handle_ -> do
 805      case haType__ handle_ of
 806        ErrorHandle theError -> ioError theError
 807        ClosedHandle         -> ioe_closedHandle "hIsTerminalDevice" handle
 808        _ -> do
 809           rc <- isTerminalDevice (haFO__ handle_)   -- ConcHask: SAFE, won't block
 810           case (rc::Int) of
 811             1 -> return True
 812             0 -> return False
 813             _ -> constructErrorAndFail "hIsTerminalDevice"
 814 \end{code}
 815
 816 \begin{code}
 817 hConnectTerms :: Handle -> Handle -> IO ()
 818 hConnectTerms hW hR = hConnectHdl_ hW hR 1{-check if they're both coming connected to ttys-}
 819
 820 hConnectTo :: Handle -> Handle -> IO ()
 821 hConnectTo hW hR = hConnectHdl_ hW hR 0{-connect regardless-}
 822
 823 hConnectHdl_ :: Handle -> Handle -> Int -> IO ()
 824 hConnectHdl_ hW hR is_tty =
 825   wantRWHandle "hConnectTo" hW $ \ hW_ ->
 826   wantRWHandle "hConnectTo" hR $ \ hR_ -> do
 827   setConnectedTo (haFO__ hR_) (haFO__ hW_) is_tty  -- ConcHask: SAFE, won't block
 828
 829 #ifndef __PARALLEL_HASKELL__
 830 #define FILE_OBJECT     ForeignObj
 831 #else
 832 #define FILE_OBJECT     Addr
 833 #endif
 834
 835 \end{code}
 836
 837 As an extension, we also allow characters to be pushed back.
 838 Like ANSI C stdio, we guarantee no more than one character of
 839 pushback. (For unbuffered channels, the (default) push-back limit is
 840 2 chars tho.)
 841
 842 \begin{code}
 843 hUngetChar :: Handle -> Char -> IO ()
 844 hUngetChar handle c =
 845     wantReadableHandle "hLookAhead" handle $ \ handle_ -> do
 846     rc      <- ungetChar (haFO__ handle_) c  -- ConcHask: SAFE, won't block
 847     if rc == ((-1)::Int)
 848      then constructErrorAndFail "hUngetChar"
 849      else return ()
 850
 851 \end{code}
 852
 853
 854 Hoisting files in in one go is sometimes useful, so we support
 855 this as an extension:
 856
 857 \begin{code}
 858 -- in one go, read file into an externally allocated buffer.
 859 slurpFile :: FilePath -> IO (Addr, Int)
 860 slurpFile fname = do
 861   handle <- openFile fname ReadMode
 862   sz     <- hFileSize handle
 863   if sz > toInteger (maxBound::Int) then
 864     ioError (userError "slurpFile: file too big")
 865    else do
 866      let sz_i = fromInteger sz
 867      chunk <- allocMemory__ sz_i
 868      if chunk == nullAddr
 869       then do
 870         hClose handle
 871         constructErrorAndFail "slurpFile"
 872       else do
 873         rc <- withHandle_ handle ( \ handle_ -> do
 874           let fo = haFO__ handle_
 875           mayBlock fo (readChunk fo chunk 0 sz_i)    -- ConcHask: UNSAFE, may block.
 876          )
 877         hClose handle
 878         if rc < (0::Int)
 879          then constructErrorAndFail "slurpFile"
 880          else return (chunk, rc)
 881
 882 #ifndef __HUGS__ /* Hugs' Prelude doesn't need this */
 883 hFillBufBA :: Handle -> MutableByteArray RealWorld a -> Int -> IO Int
 884 hFillBufBA handle buf sz
 885   | sz <= 0 = ioError (IOError (Just handle)
 886                             InvalidArgument
 887                             "hFillBufBA"
 888                             ("illegal buffer size " ++ showsPrec 9 sz []))  -- 9 => should be parens'ified.
 889   | otherwise = hFillBuf' sz 0
 890   where
 891   hFillBuf' sz len = do
 892         r <- mayBlockRead "hFillBufBA" handle (\fo -> readChunkBA fo buf len sz)
 893         if r >= sz || r == 0  -- r == 0 indicates EOF
 894             then return (len+r)
 895             else hFillBuf' (sz-r) (len+r)
 896 #endif
 897
 898 hFillBuf :: Handle -> Addr -> Int -> IO Int
 899 hFillBuf handle buf sz
 900   | sz <= 0 = ioError (IOError (Just handle)
 901                             InvalidArgument
 902                             "hFillBuf"
 903                             ("illegal buffer size " ++ showsPrec 9 sz []))
 904                                         -- 9 => should be parens'ified.
 905   | otherwise = hFillBuf' sz 0
 906   where
 907   hFillBuf' sz len = do
 908         r <- mayBlockRead "hFillBuf" handle (\fo -> readChunk fo buf len sz)
 909         if r >= sz || r == 0  -- r == 0 indicates EOF
 910             then return (len+r)
 911             else hFillBuf' (sz-r) (len+r)
 912 \end{code}
 913
 914 The @hPutBuf hdl buf len@ action writes an already packed sequence of
 915 bytes to the file/channel managed by @hdl@ - non-standard.
 916
 917 \begin{code}
 918 hPutBuf :: Handle -> Addr -> Int -> IO ()
 919 hPutBuf handle buf sz
 920   | sz <= 0 = ioError (IOError (Just handle)
 921                             InvalidArgument
 922                             "hPutBuf"
 923                             ("illegal buffer size " ++ showsPrec 9 sz []))
 924                                         -- 9 => should be parens'ified.
 925   | otherwise = hPutBuf' sz 0
 926   where
 927   hPutBuf' sz len = do
 928         r <- mayBlockWrite "hPutBuf" handle (\fo -> writeBuf fo buf len sz)
 929         if r >= sz
 930             then return ()
 931             else hPutBuf' (sz-r) (len+r) -- <= sz indicates blocking
 932
 933 #ifndef __HUGS__ /* An_ one Hugs doesn't provide */
 934 hPutBufBA :: Handle -> MutableByteArray RealWorld a -> Int -> IO ()
 935 hPutBufBA handle buf sz
 936   | sz <= 0 = ioError (IOError (Just handle)
 937                             InvalidArgument
 938                             "hPutBufBA"
 939                             ("illegal buffer size " ++ showsPrec 9 sz []))
 940                                         -- 9 => should be parens'ified.
 941   | otherwise = hPutBuf' sz 0
 942   where
 943   hPutBuf' sz len = do
 944         r <- mayBlockWrite "hPutBufBA" handle (\fo -> writeBufBA fo buf len sz)
 945         if r >= sz
 946             then return ()
 947             else hPutBuf' (sz-r) (len+r) -- <= sz indicates blocking
 948 #endif
 949 \end{code}
 950
 951 Sometimes it's useful to get at the file descriptor that
 952 the Handle contains..
 953
 954 \begin{code}
 955 getHandleFd :: Handle -> IO Int
 956 getHandleFd handle =
 957     withHandle_ handle $ \ handle_ -> do
 958     case (haType__ handle_) of
 959       ErrorHandle theError -> ioError theError
 960       ClosedHandle         -> ioe_closedHandle "getHandleFd" handle
 961       _ -> do
 962           fd <- getFileFd (haFO__ handle_)
 963           return fd
 964 \end{code}
 965
 966
 967 %*********************************************************
 968 %*                                                      *
 969 \subsection{Miscellaneous}
 970 %*                                                      *
 971 %*********************************************************
 972
 973 These three functions are meant to get things out of @IOErrors@.
 974
 975 (ToDo: improve!)
 976
 977 \begin{code}
 978 ioeGetFileName        :: IOError -> Maybe FilePath
 979 ioeGetErrorString     :: IOError -> String
 980 ioeGetHandle          :: IOError -> Maybe Handle
 981
 982 ioeGetHandle   (IOError h _ _ _)   = h
 983 ioeGetErrorString (IOError _ iot _ str) =
 984  case iot of
 985    EOF -> "end of file"
 986    _   -> str
 987
 988 ioeGetFileName (IOError _ _  _ str) =
 989  case span (/=':') str of
 990    (_,[])  -> Nothing
 991    (fs,_)  -> Just fs
 992
 993 \end{code}
 994
 995 'Top-level' IO actions want to catch exceptions (e.g., forkIO and
 996 PrelMain.mainIO) and report them - topHandler is the exception
 997 handler they should use for this:
 998
 999 \begin{code}
1000 -- make sure we handle errors while reporting the error!
1001 -- (e.g. evaluating the string passed to 'error' might generate
1002 --  another error, etc.)
1003 topHandler :: Bool -> Exception -> IO ()
1004 topHandler bombOut err = catchException (real_handler bombOut err) (topHandler bombOut)
1005
1006 real_handler :: Bool -> Exception -> IO ()
1007 real_handler bombOut ex =
1008   case ex of
1009         AsyncException StackOverflow -> reportStackOverflow bombOut
1010         ErrorCall s -> reportError bombOut s
1011         other       -> reportError bombOut (showsPrec 0 other "\n")
1012
1013 reportStackOverflow :: Bool -> IO ()
1014 reportStackOverflow bombOut = do
1015    (hFlush stdout) `catchException` (\ _ -> return ())
1016    callStackOverflowHook
1017    if bombOut then
1018      stg_exit 2
1019     else
1020      return ()
1021
1022 reportError :: Bool -> String -> IO ()
1023 reportError bombOut str = do
1024    (hFlush stdout) `catchException` (\ _ -> return ())
1025    let bs@(ByteArray _ len _) = packString str
1026    writeErrString addrOf_ErrorHdrHook bs len
1027    if bombOut then
1028      stg_exit 1
1029     else
1030      return ()
1031
1032 foreign label "ErrorHdrHook"
1033         addrOf_ErrorHdrHook :: Addr
1034
1035 foreign import ccall "writeErrString__" unsafe
1036         writeErrString :: Addr -> ByteArray Int -> Int -> IO ()
1037
1038 foreign import ccall "stackOverflow"
1039         callStackOverflowHook :: IO ()
1040
1041 foreign import ccall "stg_exit"
1042         stg_exit :: Int -> IO ()
1043 \end{code}
1044
1045
1046 A number of operations want to get at a readable or writeable handle, and fail
1047 if it isn't:
1048
1049 \begin{code}
1050 wantReadableHandle :: String -> Handle -> (Handle__ -> IO a) -> IO a
1051 wantReadableHandle fun handle act =
1052     withHandle_ handle $ \ handle_ -> do
1053     case haType__ handle_ of
1054       ErrorHandle theError -> ioError theError
1055       ClosedHandle         -> ioe_closedHandle fun handle
1056       SemiClosedHandle     -> ioe_closedHandle fun handle
1057       AppendHandle         -> ioError not_readable_error
1058       WriteHandle          -> ioError not_readable_error
1059       _                    -> act handle_
1060   where
1061    not_readable_error =
1062            IOError (Just handle) IllegalOperation fun
1063                    ("handle is not open for reading")
1064
1065 wantWriteableHandle :: String -> Handle -> (Handle__ -> IO a) -> IO a
1066 wantWriteableHandle fun handle act =
1067     withHandle_ handle $ \ handle_ -> do
1068     case haType__ handle_ of
1069       ErrorHandle theError -> ioError theError
1070       ClosedHandle         -> ioe_closedHandle fun handle
1071       SemiClosedHandle     -> ioe_closedHandle fun handle
1072       ReadHandle           -> ioError not_writeable_error
1073       _                    -> act handle_
1074   where
1075    not_writeable_error =
1076            IOError (Just handle) IllegalOperation fun
1077                    ("handle is not open for writing")
1078
1079 wantRWHandle :: String -> Handle -> (Handle__ -> IO a) -> IO a
1080 wantRWHandle fun handle act =
1081     withHandle_ handle $ \ handle_ -> do
1082     case haType__ handle_ of
1083       ErrorHandle theError -> ioError theError
1084       ClosedHandle         -> ioe_closedHandle fun handle
1085       SemiClosedHandle     -> ioe_closedHandle fun handle
1086       _                    -> act handle_
1087
1088 wantSeekableHandle :: String -> Handle -> (Handle__ -> IO a) -> IO a
1089 wantSeekableHandle fun handle act =
1090     withHandle_ handle $ \ handle_ -> do
1091     case haType__ handle_ of
1092       ErrorHandle theError -> ioError theError
1093       ClosedHandle         -> ioe_closedHandle fun handle
1094       SemiClosedHandle     -> ioe_closedHandle fun handle
1095       _                    -> act handle_
1096   where
1097    not_seekable_error =
1098            IOError (Just handle)
1099                    IllegalOperation fun
1100                    ("handle is not seekable")
1101
1102 \end{code}
1103
1104 Internal function for creating an @IOError@ representing the
1105 access to a closed file.
1106
1107 \begin{code}
1108 ioe_closedHandle :: String -> Handle -> IO a
1109 ioe_closedHandle fun h = ioError (IOError (Just h) IllegalOperation fun "handle is closed")
1110 \end{code}
1111
1112 Internal helper functions for Concurrent Haskell implementation
1113 of IO:
1114
1115 \begin{code}
1116 #ifndef __PARALLEL_HASKELL__
1117 mayBlock :: ForeignObj -> IO Int -> IO Int
1118 #else
1119 mayBlock :: Addr  -> IO Int -> IO Int
1120 #endif
1121
1122 mayBlock fo act = do
1123    rc <- act
1124    case rc of
1125      -5 -> do  -- (possibly blocking) read
1126         fd <- getFileFd fo
1127         threadWaitRead fd
1128         mayBlock fo act  -- input available, re-try
1129      -6 -> do  -- (possibly blocking) write
1130         fd <- getFileFd fo
1131         threadWaitWrite fd
1132         mayBlock fo act  -- output possible
1133      -7 -> do  -- (possibly blocking) write on connected handle
1134         fd <- getConnFileFd fo
1135         threadWaitWrite fd
1136         mayBlock fo act  -- output possible
1137      _ -> do
1138         return rc
1139
1140 data MayBlock
1141   = BlockRead Int
1142   | BlockWrite Int
1143   | NoBlock Int
1144
1145 mayBlockRead :: String -> Handle -> (ForeignObj -> IO Int) -> IO Int
1146 mayBlockRead fname handle fn = do
1147     r <- wantReadableHandle fname handle $ \ handle_ -> do
1148          let fo = haFO__ handle_
1149          rc <- fn fo
1150          case rc of
1151            -5 -> do  -- (possibly blocking) read
1152              fd <- getFileFd fo
1153              return (BlockRead fd)
1154            -6 -> do  -- (possibly blocking) write
1155              fd <- getFileFd fo
1156              return (BlockWrite fd)
1157            -7 -> do  -- (possibly blocking) write on connected handle
1158              fd <- getConnFileFd fo
1159              return (BlockWrite fd)
1160            _ ->
1161              if rc >= 0
1162                   then return (NoBlock rc)
1163                   else constructErrorAndFail fname
1164     case r of
1165         BlockRead fd -> do
1166            threadWaitRead fd
1167            mayBlockRead fname handle fn
1168         BlockWrite fd -> do
1169            threadWaitWrite fd
1170            mayBlockRead fname handle fn
1171         NoBlock c -> return c
1172
1173 mayBlockWrite :: String -> Handle -> (ForeignObj -> IO Int) -> IO Int
1174 mayBlockWrite fname handle fn = do
1175     r <- wantWriteableHandle fname handle $ \ handle_ -> do
1176          let fo = haFO__ handle_
1177          rc <- fn fo
1178          case rc of
1179            -5 -> do  -- (possibly blocking) read
1180              fd <- getFileFd fo
1181              return (BlockRead fd)
1182            -6 -> do  -- (possibly blocking) write
1183              fd <- getFileFd fo
1184              return (BlockWrite fd)
1185            -7 -> do  -- (possibly blocking) write on connected handle
1186              fd <- getConnFileFd fo
1187              return (BlockWrite fd)
1188            _ ->
1189              if rc >= 0
1190                   then return (NoBlock rc)
1191                   else constructErrorAndFail fname
1192     case r of
1193         BlockRead fd -> do
1194            threadWaitRead fd
1195            mayBlockWrite fname handle fn
1196         BlockWrite fd -> do
1197            threadWaitWrite fd
1198            mayBlockWrite fname handle fn
1199         NoBlock c -> return c
1200 \end{code}
1201
1202 Foreign import declarations of helper functions:
1203
1204 \begin{code}
1205
1206 #ifdef __HUGS__
1207 type Bytes = PrimByteArray RealWorld
1208 #else
1209 type Bytes = ByteArray#
1210 #endif
1211
1212 foreign import "libHS_cbits" "inputReady"  unsafe
1213            inputReady       :: FILE_OBJECT -> Int -> IO Int{-ret code-}
1214 foreign import "libHS_cbits" "fileGetc"    unsafe
1215            fileGetc         :: FILE_OBJECT -> IO Int
1216 foreign import "libHS_cbits" "fileLookAhead" unsafe
1217            fileLookAhead    :: FILE_OBJECT -> IO Int
1218 foreign import "libHS_cbits" "readBlock" unsafe
1219            readBlock        :: FILE_OBJECT -> IO Int
1220 foreign import "libHS_cbits" "readLine" unsafe
1221            readLine         :: FILE_OBJECT -> IO Int
1222 foreign import "libHS_cbits" "readChar" unsafe
1223            readChar         :: FILE_OBJECT -> IO Int
1224 foreign import "libHS_cbits" "writeFileObject" unsafe
1225            writeFileObject  :: FILE_OBJECT -> Int -> IO Int{-ret code-}
1226 foreign import "libHS_cbits" "filePutc" unsafe
1227            filePutc         :: FILE_OBJECT -> Char -> IO Int{-ret code-}
1228 foreign import "libHS_cbits" "getBufStart" unsafe
1229            getBufStart      :: FILE_OBJECT -> Int -> IO Addr
1230 foreign import "libHS_cbits" "getWriteableBuf" unsafe
1231            getWriteableBuf  :: FILE_OBJECT -> IO Addr
1232 foreign import "libHS_cbits" "getBufWPtr" unsafe
1233            getBufWPtr       :: FILE_OBJECT -> IO Int
1234 foreign import "libHS_cbits" "setBufWPtr" unsafe
1235            setBufWPtr       :: FILE_OBJECT -> Int -> IO ()
1236 foreign import "libHS_cbits" "closeFile" unsafe
1237            closeFile        :: FILE_OBJECT -> Int{-Flush-} -> IO Int{-ret code-}
1238 foreign import "libHS_cbits" "fileEOF" unsafe
1239            fileEOF           :: FILE_OBJECT -> IO Int{-ret code-}
1240 foreign import "libHS_cbits" "setBuffering" unsafe
1241            setBuffering      :: FILE_OBJECT -> Int -> IO Int{-ret code-}
1242 foreign import "libHS_cbits" "flushFile" unsafe
1243            flushFile         :: FILE_OBJECT -> IO Int{-ret code-}
1244 foreign import "libHS_cbits" "flushConnectedBuf" unsafe
1245            flushConnectedBuf :: FILE_OBJECT -> IO ()
1246 foreign import "libHS_cbits" "getBufferMode" unsafe
1247            getBufferMode     :: FILE_OBJECT -> IO Int{-ret code-}
1248 #ifdef __HUGS__
1249 foreign import "libHS_cbits" "seekFile_int64" unsafe
1250            seekFile    :: FILE_OBJECT -> Int -> Int64 -> IO Int
1251 #else
1252 foreign import "libHS_cbits" "seekFile" unsafe
1253            seekFile    :: FILE_OBJECT -> Int -> Int -> Bytes -> IO Int
1254 #endif
1255
1256 foreign import "libHS_cbits" "seekFileP" unsafe
1257            seekFileP        :: FILE_OBJECT -> IO Int{-ret code-}
1258 foreign import "libHS_cbits" "setTerminalEcho" unsafe
1259            setTerminalEcho  :: FILE_OBJECT -> Int -> IO Int{-ret code-}
1260 foreign import "libHS_cbits" "getTerminalEcho" unsafe
1261            getTerminalEcho  :: FILE_OBJECT -> IO Int{-ret code-}
1262 foreign import "libHS_cbits" "isTerminalDevice" unsafe
1263            isTerminalDevice :: FILE_OBJECT -> IO Int{-ret code-}
1264 foreign import "libHS_cbits" "setConnectedTo" unsafe
1265            setConnectedTo   :: FILE_OBJECT -> FILE_OBJECT -> Int -> IO ()
1266 foreign import "libHS_cbits" "ungetChar" unsafe
1267            ungetChar        :: FILE_OBJECT -> Char -> IO Int{-ret code-}
1268 foreign import "libHS_cbits" "readChunk" unsafe
1269            readChunk        :: FILE_OBJECT -> Addr -> Int -> Int -> IO Int{-ret code-}
1270 foreign import "libHS_cbits" "readChunk" unsafe
1271            readChunkBA      :: FILE_OBJECT -> MutableByteArray s a -> Int -> Int -> IO Int{-ret code-}
1272 foreign import "libHS_cbits" "writeBuf" unsafe
1273            writeBuf         :: FILE_OBJECT -> Addr -> Int -> Int -> IO Int{-ret code-}
1274 #ifndef __HUGS__
1275 foreign import "libHS_cbits" "writeBufBA" unsafe
1276            writeBufBA       :: FILE_OBJECT -> MutableByteArray s a -> Int -> Int -> IO Int{-ret code-}
1277 #endif
1278 foreign import "libHS_cbits" "getFileFd" unsafe
1279            getFileFd        :: FILE_OBJECT -> IO Int{-fd-}
1280 #ifdef __HUGS__
1281 foreign import "libHS_cbits" "fileSize_int64" unsafe
1282            fileSize_int64   :: FILE_OBJECT -> Bytes -> IO Int{-ret code-}
1283 #else
1284 foreign import "libHS_cbits" "fileSize" unsafe
1285            fileSize  :: FILE_OBJECT -> Bytes -> IO Int{-ret code-}
1286 #endif
1287
1288 foreign import "libHS_cbits" "getFilePosn" unsafe
1289            getFilePosn      :: FILE_OBJECT -> IO Int
1290 foreign import "libHS_cbits" "setFilePosn" unsafe
1291            setFilePosn      :: FILE_OBJECT -> Int -> ByteArray# -> IO Int
1292 foreign import "libHS_cbits" "getConnFileFd" unsafe
1293            getConnFileFd    :: FILE_OBJECT -> IO Int{-fd-}
1294 foreign import "libHS_cbits" "getLock" unsafe
1295            getLock  :: Int{-Fd-} -> Int{-exclusive-} -> IO Int{-return code-}
1296 foreign import "libHS_cbits" "openStdFile" unsafe
1297            openStdFile      :: Int{-fd-} -> Int{-Readable?-} -> IO Addr{-file obj-}
1298 foreign import "libHS_cbits" "openFile" unsafe
1299            primOpenFile         :: ByteArray Int{-CString-}
1300                                 -> Int{-How-}
1301                                 -> Int{-Binary-}
1302                                 -> IO Addr {-file obj-}
1303 foreign import "libHS_cbits" "const_BUFSIZ" unsafe
1304            const_BUFSIZ          :: Int
1305
1306 foreign import "libHS_cbits" "setBinaryMode__"
1307            setBinaryMode :: FILE_OBJECT -> Int -> IO Int
1308 \end{code}
1309
1310