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