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 getBMode__ :: FILE_OBJECT -> IO (BufferMode, Int)
 709 getBMode__ fo = do
 710   rc <- getBufferMode fo    -- ConcHask: SAFE, won't block
 711   case (rc::Int) of
 712     0  -> return (NoBuffering, 0)
 713     -1 -> return (LineBuffering, default_buffer_size)
 714     -2 -> return (BlockBuffering Nothing, default_buffer_size)
 715     -3 -> return (NoBuffering, 0)               -- only happens on un-stat()able files.
 716     n  -> return (BlockBuffering (Just n), n)
 717  where
 718    default_buffer_size :: Int
 719    default_buffer_size = (const_BUFSIZ - 1)
 720 \end{code}
 721
 722 Querying how a handle buffers its data:
 723
 724 \begin{code}
 725 hGetBuffering :: Handle -> IO BufferMode
 726 hGetBuffering handle =
 727     withHandle_ handle $ \ handle_ -> do
 728     case haType__ handle_ of
 729       ErrorHandle theError -> ioError theError
 730       ClosedHandle         -> ioe_closedHandle "hGetBuffering" handle
 731       _ ->
 732           {-
 733            We're being non-standard here, and allow the buffering
 734            of a semi-closed handle to be queried.   -- sof 6/98
 735           -}
 736           return (haBufferMode__ handle_)  -- could be stricter..
 737 \end{code}
 738
 739 \begin{code}
 740 hIsSeekable :: Handle -> IO Bool
 741 hIsSeekable handle =
 742     withHandle_ handle $ \ handle_ -> do
 743     case haType__ handle_ of
 744       ErrorHandle theError -> ioError theError
 745       ClosedHandle         -> ioe_closedHandle "hIsSeekable" handle
 746       SemiClosedHandle     -> ioe_closedHandle "hIsSeekable" handle
 747       AppendHandle         -> return False
 748       _ -> do
 749           rc <- seekFileP (haFO__ handle_)   -- ConcHask: SAFE, won't block
 750           case (rc::Int) of
 751             0 -> return False
 752             1 -> return True
 753             _ -> constructErrorAndFail "hIsSeekable"
 754 \end{code}
 755
 756
 757 %*********************************************************
 758 %*                                                      *
 759 \subsection{Changing echo status}
 760 %*                                                      *
 761 %*********************************************************
 762
 763 Non-standard GHC extension is to allow the echoing status
 764 of a handles connected to terminals to be reconfigured:
 765
 766 \begin{code}
 767 hSetEcho :: Handle -> Bool -> IO ()
 768 hSetEcho handle on = do
 769     isT   <- hIsTerminalDevice handle
 770     if not isT
 771      then return ()
 772      else
 773       withHandle_ handle $ \ handle_ -> do
 774       case haType__ handle_ of
 775          ErrorHandle theError -> ioError theError
 776          ClosedHandle         -> ioe_closedHandle "hSetEcho" handle
 777          _ -> do
 778             rc <- setTerminalEcho (haFO__ handle_) (if on then 1 else 0)  -- ConcHask: SAFE, won't block
 779             if rc /= ((-1)::Int)
 780              then return ()
 781              else constructErrorAndFail "hSetEcho"
 782
 783 hGetEcho :: Handle -> IO Bool
 784 hGetEcho handle = do
 785     isT   <- hIsTerminalDevice handle
 786     if not isT
 787      then return False
 788      else
 789        withHandle_ handle $ \ handle_ -> do
 790        case haType__ handle_ of
 791          ErrorHandle theError -> ioError theError
 792          ClosedHandle         -> ioe_closedHandle "hGetEcho" handle
 793          _ -> do
 794             rc <- getTerminalEcho (haFO__ handle_)  -- ConcHask: SAFE, won't block
 795             case (rc::Int) of
 796               1 -> return True
 797               0 -> return False
 798               _ -> constructErrorAndFail "hSetEcho"
 799
 800 hIsTerminalDevice :: Handle -> IO Bool
 801 hIsTerminalDevice handle = do
 802     withHandle_ handle $ \ handle_ -> do
 803      case haType__ handle_ of
 804        ErrorHandle theError -> ioError theError
 805        ClosedHandle         -> ioe_closedHandle "hIsTerminalDevice" handle
 806        _ -> do
 807           rc <- isTerminalDevice (haFO__ handle_)   -- ConcHask: SAFE, won't block
 808           case (rc::Int) of
 809             1 -> return True
 810             0 -> return False
 811             _ -> constructErrorAndFail "hIsTerminalDevice"
 812 \end{code}
 813
 814 \begin{code}
 815 hConnectTerms :: Handle -> Handle -> IO ()
 816 hConnectTerms hW hR = hConnectHdl_ hW hR 1{-check if they're both coming connected to ttys-}
 817
 818 hConnectTo :: Handle -> Handle -> IO ()
 819 hConnectTo hW hR = hConnectHdl_ hW hR 0{-connect regardless-}
 820
 821 hConnectHdl_ :: Handle -> Handle -> Int -> IO ()
 822 hConnectHdl_ hW hR is_tty =
 823   wantRWHandle "hConnectTo" hW $ \ hW_ ->
 824   wantRWHandle "hConnectTo" hR $ \ hR_ -> do
 825   setConnectedTo (haFO__ hR_) (haFO__ hW_) is_tty  -- ConcHask: SAFE, won't block
 826 \end{code}
 827
 828 As an extension, we also allow characters to be pushed back.
 829 Like ANSI C stdio, we guarantee no more than one character of
 830 pushback. (For unbuffered channels, the (default) push-back limit is
 831 2 chars tho.)
 832
 833 \begin{code}
 834 hUngetChar :: Handle -> Char -> IO ()
 835 hUngetChar handle c =
 836     wantReadableHandle "hLookAhead" handle $ \ handle_ -> do
 837     rc      <- ungetChar (haFO__ handle_) c  -- ConcHask: SAFE, won't block
 838     if rc == ((-1)::Int)
 839      then constructErrorAndFail "hUngetChar"
 840      else return ()
 841
 842 \end{code}
 843
 844
 845 Hoisting files in in one go is sometimes useful, so we support
 846 this as an extension:
 847
 848 \begin{code}
 849 -- in one go, read file into an externally allocated buffer.
 850 slurpFile :: FilePath -> IO (Addr, Int)
 851 slurpFile fname = do
 852   handle <- openFile fname ReadMode
 853   sz     <- hFileSize handle
 854   if sz > toInteger (maxBound::Int) then
 855     ioError (userError "slurpFile: file too big")
 856    else do
 857      let sz_i = fromInteger sz
 858      chunk <- allocMemory__ sz_i
 859      if chunk == nullAddr
 860       then do
 861         hClose handle
 862         constructErrorAndFail "slurpFile"
 863       else do
 864         rc <- withHandle_ handle ( \ handle_ -> do
 865           let fo = haFO__ handle_
 866           mayBlock fo (readChunk fo chunk 0 sz_i)    -- ConcHask: UNSAFE, may block.
 867          )
 868         hClose handle
 869         if rc < (0::Int)
 870          then constructErrorAndFail "slurpFile"
 871          else return (chunk, rc)
 872
 873 #ifndef __HUGS__ /* Hugs' Prelude doesn't need this */
 874 hFillBufBA :: Handle -> MutableByteArray RealWorld a -> Int -> IO Int
 875 hFillBufBA handle buf sz
 876   | sz <= 0 = ioError (IOError (Just handle)
 877                             InvalidArgument
 878                             "hFillBufBA"
 879                             ("illegal buffer size " ++ showsPrec 9 sz []))  -- 9 => should be parens'ified.
 880   | otherwise = hFillBuf' sz 0
 881   where
 882   hFillBuf' sz len = do
 883         r <- mayBlockRead "hFillBufBA" handle (\fo -> readChunkBA fo buf len sz)
 884         if r >= sz || r == 0  -- r == 0 indicates EOF
 885             then return (len+r)
 886             else hFillBuf' (sz-r) (len+r)
 887 #endif
 888
 889 hFillBuf :: Handle -> Addr -> Int -> IO Int
 890 hFillBuf handle buf sz
 891   | sz <= 0 = ioError (IOError (Just handle)
 892                             InvalidArgument
 893                             "hFillBuf"
 894                             ("illegal buffer size " ++ showsPrec 9 sz []))
 895                                         -- 9 => should be parens'ified.
 896   | otherwise = hFillBuf' sz 0
 897   where
 898   hFillBuf' sz len = do
 899         r <- mayBlockRead "hFillBuf" handle (\fo -> readChunk fo buf len sz)
 900         if r >= sz || r == 0  -- r == 0 indicates EOF
 901             then return (len+r)
 902             else hFillBuf' (sz-r) (len+r)
 903 \end{code}
 904
 905 The @hPutBuf hdl buf len@ action writes an already packed sequence of
 906 bytes to the file/channel managed by @hdl@ - non-standard.
 907
 908 \begin{code}
 909 hPutBuf :: Handle -> Addr -> Int -> IO ()
 910 hPutBuf handle buf sz
 911   | sz <= 0 = ioError (IOError (Just handle)
 912                             InvalidArgument
 913                             "hPutBuf"
 914                             ("illegal buffer size " ++ showsPrec 9 sz []))
 915                                         -- 9 => should be parens'ified.
 916   | otherwise = hPutBuf' sz 0
 917   where
 918   hPutBuf' sz len = do
 919         r <- mayBlockWrite "hPutBuf" handle (\fo -> writeBuf fo buf len sz)
 920         if r >= sz
 921             then return ()
 922             else hPutBuf' (sz-r) (len+r) -- <= sz indicates blocking
 923
 924 #ifndef __HUGS__ /* An_ one Hugs doesn't provide */
 925 hPutBufBA :: Handle -> MutableByteArray RealWorld a -> Int -> IO ()
 926 hPutBufBA handle buf sz
 927   | sz <= 0 = ioError (IOError (Just handle)
 928                             InvalidArgument
 929                             "hPutBufBA"
 930                             ("illegal buffer size " ++ showsPrec 9 sz []))
 931                                         -- 9 => should be parens'ified.
 932   | otherwise = hPutBuf' sz 0
 933   where
 934   hPutBuf' sz len = do
 935         r <- mayBlockWrite "hPutBufBA" handle (\fo -> writeBufBA fo buf len sz)
 936         if r >= sz
 937             then return ()
 938             else hPutBuf' (sz-r) (len+r) -- <= sz indicates blocking
 939 #endif
 940 \end{code}
 941
 942 Sometimes it's useful to get at the file descriptor that
 943 the Handle contains..
 944
 945 \begin{code}
 946 getHandleFd :: Handle -> IO Int
 947 getHandleFd handle =
 948     withHandle_ handle $ \ handle_ -> do
 949     case (haType__ handle_) of
 950       ErrorHandle theError -> ioError theError
 951       ClosedHandle         -> ioe_closedHandle "getHandleFd" handle
 952       _ -> do
 953           fd <- getFileFd (haFO__ handle_)
 954           return fd
 955 \end{code}
 956
 957
 958 %*********************************************************
 959 %*                                                      *
 960 \subsection{Miscellaneous}
 961 %*                                                      *
 962 %*********************************************************
 963
 964 These three functions are meant to get things out of @IOErrors@.
 965
 966 (ToDo: improve!)
 967
 968 \begin{code}
 969 ioeGetFileName        :: IOError -> Maybe FilePath
 970 ioeGetErrorString     :: IOError -> String
 971 ioeGetHandle          :: IOError -> Maybe Handle
 972
 973 ioeGetHandle   (IOError h _ _ _)   = h
 974 ioeGetErrorString (IOError _ iot _ str) =
 975  case iot of
 976    EOF -> "end of file"
 977    _   -> str
 978
 979 ioeGetFileName (IOError _ _  _ str) =
 980  case span (/=':') str of
 981    (_,[])  -> Nothing
 982    (fs,_)  -> Just fs
 983
 984 \end{code}
 985
 986 'Top-level' IO actions want to catch exceptions (e.g., forkIO and
 987 PrelMain.mainIO) and report them - topHandler is the exception
 988 handler they should use for this:
 989
 990 \begin{code}
 991 -- make sure we handle errors while reporting the error!
 992 -- (e.g. evaluating the string passed to 'error' might generate
 993 --  another error, etc.)
 994 topHandler :: Bool -> Exception -> IO ()
 995 topHandler bombOut err = catchException (real_handler bombOut err) (topHandler bombOut)
 996
 997 real_handler :: Bool -> Exception -> IO ()
 998 real_handler bombOut ex =
 999   case ex of
1000         AsyncException StackOverflow -> reportStackOverflow bombOut
1001         ErrorCall s -> reportError bombOut s
1002         other       -> reportError bombOut (showsPrec 0 other "\n")
1003
1004 reportStackOverflow :: Bool -> IO ()
1005 reportStackOverflow bombOut = do
1006    (hFlush stdout) `catchException` (\ _ -> return ())
1007    callStackOverflowHook
1008    if bombOut then
1009      stg_exit 2
1010     else
1011      return ()
1012
1013 reportError :: Bool -> String -> IO ()
1014 reportError bombOut str = do
1015    (hFlush stdout) `catchException` (\ _ -> return ())
1016    let bs@(ByteArray _ len _) = packString str
1017    writeErrString addrOf_ErrorHdrHook bs len
1018    if bombOut then
1019      stg_exit 1
1020     else
1021      return ()
1022
1023 foreign label "ErrorHdrHook"
1024         addrOf_ErrorHdrHook :: Addr
1025
1026 foreign import ccall "writeErrString__" unsafe
1027         writeErrString :: Addr -> ByteArray Int -> Int -> IO ()
1028
1029 foreign import ccall "stackOverflow"
1030         callStackOverflowHook :: IO ()
1031
1032 foreign import ccall "stg_exit"
1033         stg_exit :: Int -> IO ()
1034 \end{code}
1035
1036
1037 A number of operations want to get at a readable or writeable handle, and fail
1038 if it isn't:
1039
1040 \begin{code}
1041 wantReadableHandle :: String -> Handle -> (Handle__ -> IO a) -> IO a
1042 wantReadableHandle fun handle act =
1043     withHandle_ handle $ \ handle_ -> do
1044     case haType__ handle_ of
1045       ErrorHandle theError -> ioError theError
1046       ClosedHandle         -> ioe_closedHandle fun handle
1047       SemiClosedHandle     -> ioe_closedHandle fun handle
1048       AppendHandle         -> ioError not_readable_error
1049       WriteHandle          -> ioError not_readable_error
1050       _                    -> act handle_
1051   where
1052    not_readable_error =
1053            IOError (Just handle) IllegalOperation fun
1054                    ("handle is not open for reading")
1055
1056 wantWriteableHandle :: String -> Handle -> (Handle__ -> IO a) -> IO a
1057 wantWriteableHandle fun handle act =
1058     withHandle_ handle $ \ handle_ -> do
1059     case haType__ handle_ of
1060       ErrorHandle theError -> ioError theError
1061       ClosedHandle         -> ioe_closedHandle fun handle
1062       SemiClosedHandle     -> ioe_closedHandle fun handle
1063       ReadHandle           -> ioError not_writeable_error
1064       _                    -> act handle_
1065   where
1066    not_writeable_error =
1067            IOError (Just handle) IllegalOperation fun
1068                    ("handle is not open for writing")
1069
1070 wantRWHandle :: String -> Handle -> (Handle__ -> IO a) -> IO a
1071 wantRWHandle fun handle act =
1072     withHandle_ handle $ \ handle_ -> do
1073     case haType__ handle_ of
1074       ErrorHandle theError -> ioError theError
1075       ClosedHandle         -> ioe_closedHandle fun handle
1076       SemiClosedHandle     -> ioe_closedHandle fun handle
1077       _                    -> act handle_
1078
1079 wantSeekableHandle :: String -> Handle -> (Handle__ -> IO a) -> IO a
1080 wantSeekableHandle 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   where
1088    not_seekable_error =
1089            IOError (Just handle)
1090                    IllegalOperation fun
1091                    ("handle is not seekable")
1092
1093 \end{code}
1094
1095 Internal function for creating an @IOError@ representing the
1096 access to a closed file.
1097
1098 \begin{code}
1099 ioe_closedHandle :: String -> Handle -> IO a
1100 ioe_closedHandle fun h = ioError (IOError (Just h) IllegalOperation fun "handle is closed")
1101 \end{code}
1102
1103 Internal helper functions for Concurrent Haskell implementation
1104 of IO:
1105
1106 \begin{code}
1107 mayBlock :: FILE_OBJECT -> IO Int -> IO Int
1108 mayBlock fo act = do
1109    rc <- act
1110    case rc of
1111      -5 -> do  -- (possibly blocking) read
1112         fd <- getFileFd fo
1113         threadWaitRead fd
1114         mayBlock fo act  -- input available, re-try
1115      -6 -> do  -- (possibly blocking) write
1116         fd <- getFileFd fo
1117         threadWaitWrite fd
1118         mayBlock fo act  -- output possible
1119      -7 -> do  -- (possibly blocking) write on connected handle
1120         fd <- getConnFileFd fo
1121         threadWaitWrite fd
1122         mayBlock fo act  -- output possible
1123      _ -> do
1124         return rc
1125
1126 data MayBlock
1127   = BlockRead Int
1128   | BlockWrite Int
1129   | NoBlock Int
1130
1131 mayBlockRead :: String -> Handle -> (FILE_OBJECT -> IO Int) -> IO Int
1132 mayBlockRead fname handle fn = do
1133     r <- wantReadableHandle fname handle $ \ handle_ -> do
1134          let fo = haFO__ handle_
1135          rc <- fn fo
1136          case rc of
1137            -5 -> do  -- (possibly blocking) read
1138              fd <- getFileFd fo
1139              return (BlockRead fd)
1140            -6 -> do  -- (possibly blocking) write
1141              fd <- getFileFd fo
1142              return (BlockWrite fd)
1143            -7 -> do  -- (possibly blocking) write on connected handle
1144              fd <- getConnFileFd fo
1145              return (BlockWrite fd)
1146            _ ->
1147              if rc >= 0
1148                   then return (NoBlock rc)
1149                   else constructErrorAndFail fname
1150     case r of
1151         BlockRead fd -> do
1152            threadWaitRead fd
1153            mayBlockRead fname handle fn
1154         BlockWrite fd -> do
1155            threadWaitWrite fd
1156            mayBlockRead fname handle fn
1157         NoBlock c -> return c
1158
1159 mayBlockWrite :: String -> Handle -> (FILE_OBJECT -> IO Int) -> IO Int
1160 mayBlockWrite fname handle fn = do
1161     r <- wantWriteableHandle fname handle $ \ handle_ -> do
1162          let fo = haFO__ handle_
1163          rc <- fn fo
1164          case rc of
1165            -5 -> do  -- (possibly blocking) read
1166              fd <- getFileFd fo
1167              return (BlockRead fd)
1168            -6 -> do  -- (possibly blocking) write
1169              fd <- getFileFd fo
1170              return (BlockWrite fd)
1171            -7 -> do  -- (possibly blocking) write on connected handle
1172              fd <- getConnFileFd fo
1173              return (BlockWrite fd)
1174            _ ->
1175              if rc >= 0
1176                   then return (NoBlock rc)
1177                   else constructErrorAndFail fname
1178     case r of
1179         BlockRead fd -> do
1180            threadWaitRead fd
1181            mayBlockWrite fname handle fn
1182         BlockWrite fd -> do
1183            threadWaitWrite fd
1184            mayBlockWrite fname handle fn
1185         NoBlock c -> return c
1186 \end{code}
1187
1188 Foreign import declarations of helper functions:
1189
1190 \begin{code}
1191
1192 #ifdef __HUGS__
1193 type Bytes = PrimByteArray RealWorld
1194 #else
1195 type Bytes = ByteArray#
1196 #endif
1197
1198 foreign import "libHS_cbits" "inputReady"  unsafe
1199            inputReady       :: FILE_OBJECT -> Int -> IO Int{-ret code-}
1200 foreign import "libHS_cbits" "fileGetc"    unsafe
1201            fileGetc         :: FILE_OBJECT -> IO Int
1202 foreign import "libHS_cbits" "fileLookAhead" unsafe
1203            fileLookAhead    :: FILE_OBJECT -> IO Int
1204 foreign import "libHS_cbits" "readBlock" unsafe
1205            readBlock        :: FILE_OBJECT -> IO Int
1206 foreign import "libHS_cbits" "readLine" unsafe
1207            readLine         :: FILE_OBJECT -> IO Int
1208 foreign import "libHS_cbits" "readChar" unsafe
1209            readChar         :: FILE_OBJECT -> IO Int
1210 foreign import "libHS_cbits" "writeFileObject" unsafe
1211            writeFileObject  :: FILE_OBJECT -> Int -> IO Int{-ret code-}
1212 foreign import "libHS_cbits" "filePutc" unsafe
1213            filePutc         :: FILE_OBJECT -> Char -> IO Int{-ret code-}
1214 foreign import "libHS_cbits" "getBufStart" unsafe
1215            getBufStart      :: FILE_OBJECT -> Int -> IO Addr
1216 foreign import "libHS_cbits" "getWriteableBuf" unsafe
1217            getWriteableBuf  :: FILE_OBJECT -> IO Addr
1218 foreign import "libHS_cbits" "getBufWPtr" unsafe
1219            getBufWPtr       :: FILE_OBJECT -> IO Int
1220 foreign import "libHS_cbits" "setBufWPtr" unsafe
1221            setBufWPtr       :: FILE_OBJECT -> Int -> IO ()
1222 foreign import "libHS_cbits" "closeFile" unsafe
1223            closeFile        :: FILE_OBJECT -> Int{-Flush-} -> IO Int{-ret code-}
1224 foreign import "libHS_cbits" "fileEOF" unsafe
1225            fileEOF           :: FILE_OBJECT -> IO Int{-ret code-}
1226 foreign import "libHS_cbits" "setBuffering" unsafe
1227            setBuffering      :: FILE_OBJECT -> Int -> IO Int{-ret code-}
1228 foreign import "libHS_cbits" "flushFile" unsafe
1229            flushFile         :: FILE_OBJECT -> IO Int{-ret code-}
1230 foreign import "libHS_cbits" "flushConnectedBuf" unsafe
1231            flushConnectedBuf :: FILE_OBJECT -> IO ()
1232 foreign import "libHS_cbits" "getBufferMode" unsafe
1233            getBufferMode     :: FILE_OBJECT -> IO Int{-ret code-}
1234 #ifdef __HUGS__
1235 foreign import "libHS_cbits" "seekFile_int64" unsafe
1236            seekFile    :: FILE_OBJECT -> Int -> Int64 -> IO Int
1237 #else
1238 foreign import "libHS_cbits" "seekFile" unsafe
1239            seekFile    :: FILE_OBJECT -> Int -> Int -> Bytes -> IO Int
1240 #endif
1241
1242 foreign import "libHS_cbits" "seekFileP" unsafe
1243            seekFileP        :: FILE_OBJECT -> IO Int{-ret code-}
1244 foreign import "libHS_cbits" "setTerminalEcho" unsafe
1245            setTerminalEcho  :: FILE_OBJECT -> Int -> IO Int{-ret code-}
1246 foreign import "libHS_cbits" "getTerminalEcho" unsafe
1247            getTerminalEcho  :: FILE_OBJECT -> IO Int{-ret code-}
1248 foreign import "libHS_cbits" "isTerminalDevice" unsafe
1249            isTerminalDevice :: FILE_OBJECT -> IO Int{-ret code-}
1250 foreign import "libHS_cbits" "setConnectedTo" unsafe
1251            setConnectedTo   :: FILE_OBJECT -> FILE_OBJECT -> Int -> IO ()
1252 foreign import "libHS_cbits" "ungetChar" unsafe
1253            ungetChar        :: FILE_OBJECT -> Char -> IO Int{-ret code-}
1254 foreign import "libHS_cbits" "readChunk" unsafe
1255            readChunk        :: FILE_OBJECT -> Addr -> Int -> Int -> IO Int{-ret code-}
1256 foreign import "libHS_cbits" "readChunk" unsafe
1257            readChunkBA      :: FILE_OBJECT -> MutableByteArray s a -> Int -> Int -> IO Int{-ret code-}
1258 foreign import "libHS_cbits" "writeBuf" unsafe
1259            writeBuf         :: FILE_OBJECT -> Addr -> Int -> Int -> IO Int{-ret code-}
1260 #ifndef __HUGS__
1261 foreign import "libHS_cbits" "writeBufBA" unsafe
1262            writeBufBA       :: FILE_OBJECT -> MutableByteArray s a -> Int -> Int -> IO Int{-ret code-}
1263 #endif
1264 foreign import "libHS_cbits" "getFileFd" unsafe
1265            getFileFd        :: FILE_OBJECT -> IO Int{-fd-}
1266 #ifdef __HUGS__
1267 foreign import "libHS_cbits" "fileSize_int64" unsafe
1268            fileSize_int64   :: FILE_OBJECT -> Bytes -> IO Int{-ret code-}
1269 #else
1270 foreign import "libHS_cbits" "fileSize" unsafe
1271            fileSize  :: FILE_OBJECT -> Bytes -> IO Int{-ret code-}
1272 #endif
1273
1274 foreign import "libHS_cbits" "getFilePosn" unsafe
1275            getFilePosn      :: FILE_OBJECT -> IO Int
1276 foreign import "libHS_cbits" "setFilePosn" unsafe
1277            setFilePosn      :: FILE_OBJECT -> Int -> ByteArray# -> IO Int
1278 foreign import "libHS_cbits" "getConnFileFd" unsafe
1279            getConnFileFd    :: FILE_OBJECT -> IO Int{-fd-}
1280 foreign import "libHS_cbits" "getLock" unsafe
1281            getLock  :: Int{-Fd-} -> Int{-exclusive-} -> IO Int{-return code-}
1282 foreign import "libHS_cbits" "openStdFile" unsafe
1283            openStdFile      :: Int{-fd-} -> Int{-Readable?-} -> IO Addr{-file obj-}
1284 foreign import "libHS_cbits" "openFile" unsafe
1285            primOpenFile         :: ByteArray Int{-CString-}
1286                                 -> Int{-How-}
1287                                 -> Int{-Binary-}
1288                                 -> IO Addr {-file obj-}
1289 foreign import "libHS_cbits" "const_BUFSIZ" unsafe
1290            const_BUFSIZ          :: Int
1291
1292 foreign import "libHS_cbits" "setBinaryMode__"
1293            setBinaryMode :: FILE_OBJECT -> Int -> IO Int
1294 \end{code}
1295
1296