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