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(..) )
  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 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 -> ByteArray Int -> 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 =
 913     mayBlockRead "hFillBufBA" handle (\fo -> readChunkBA fo buf sz)
 914 #endif
 915
 916 hFillBuf :: Handle -> Addr -> Int -> IO Int
 917 hFillBuf handle buf sz
 918   | sz <= 0 = ioError (IOError (Just handle)
 919                             InvalidArgument
 920                             "hFillBuf"
 921                             ("illegal buffer size " ++ showsPrec 9 sz []))  -- 9 => should be parens'ified.
 922   | otherwise =
 923     mayBlockRead "hFillBuf" handle (\fo -> readChunk fo buf sz)
 924 \end{code}
 925
 926 The @hPutBuf hdl buf len@ action writes an already packed sequence of
 927 bytes to the file/channel managed by @hdl@ - non-standard.
 928
 929 \begin{code}
 930 hPutBuf :: Handle -> Addr -> Int -> IO ()
 931 hPutBuf handle buf len =
 932     wantWriteableHandle "hPutBuf" handle $ \ handle_ -> do
 933     let fo  = haFO__ handle_
 934     rc      <- mayBlock fo (writeBuf fo buf len)  -- ConcHask: UNSAFE, may block.
 935     if rc == (0::Int)
 936      then return ()
 937      else constructErrorAndFail "hPutBuf"
 938
 939 #ifndef __HUGS__ /* An_ one Hugs doesn't provide */
 940 hPutBufBA :: Handle -> ByteArray Int -> Int -> IO ()
 941 hPutBufBA handle buf len =
 942     wantWriteableHandle "hPutBufBA" handle $ \ handle_ -> do
 943     let fo = haFO__ handle_
 944     rc      <- mayBlock fo (writeBufBA fo buf len)  -- ConcHask: UNSAFE, may block.
 945     if rc == (0::Int)
 946      then return ()
 947      else constructErrorAndFail "hPutBuf"
 948 #endif
 949 \end{code}
 950
 951 Sometimes it's useful to get at the file descriptor that
 952 the Handle contains..
 953
 954 \begin{code}
 955 getHandleFd :: Handle -> IO Int
 956 getHandleFd handle =
 957     withHandle_ handle $ \ handle_ -> do
 958     case (haType__ handle_) of
 959       ErrorHandle theError -> ioError theError
 960       ClosedHandle         -> ioe_closedHandle "getHandleFd" handle
 961       _ -> do
 962           fd <- getFileFd (haFO__ handle_)
 963           return fd
 964 \end{code}
 965
 966
 967 %*********************************************************
 968 %*                                                      *
 969 \subsection{Miscellaneous}
 970 %*                                                      *
 971 %*********************************************************
 972
 973 These three functions are meant to get things out of @IOErrors@.
 974
 975 (ToDo: improve!)
 976
 977 \begin{code}
 978 ioeGetFileName        :: IOError -> Maybe FilePath
 979 ioeGetErrorString     :: IOError -> String
 980 ioeGetHandle          :: IOError -> Maybe Handle
 981
 982 ioeGetHandle   (IOError h _ _ _)   = h
 983 ioeGetErrorString (IOError _ iot _ str) =
 984  case iot of
 985    EOF -> "end of file"
 986    _   -> str
 987
 988 ioeGetFileName (IOError _ _  _ str) =
 989  case span (/=':') str of
 990    (_,[])  -> Nothing
 991    (fs,_)  -> Just fs
 992
 993 \end{code}
 994
 995 'Top-level' IO actions want to catch exceptions (e.g., forkIO and
 996 PrelMain.mainIO) and report them - topHandler is the exception
 997 handler they should use for this:
 998
 999 \begin{code}
1000 -- make sure we handle errors while reporting the error!
1001 -- (e.g. evaluating the string passed to 'error' might generate
1002 --  another error, etc.)
1003 topHandler :: Bool -> Exception -> IO ()
1004 topHandler bombOut err = catchException (real_handler bombOut err) (topHandler bombOut)
1005
1006 real_handler :: Bool -> Exception -> IO ()
1007 real_handler bombOut ex =
1008   case ex of
1009         AsyncException StackOverflow -> reportStackOverflow bombOut
1010         ErrorCall s -> reportError bombOut s
1011         other       -> reportError bombOut (showsPrec 0 other "\n")
1012
1013 reportStackOverflow :: Bool -> IO ()
1014 reportStackOverflow bombOut = do
1015    (hFlush stdout) `catchException` (\ _ -> return ())
1016    callStackOverflowHook
1017    if bombOut then
1018      stg_exit 2
1019     else
1020      return ()
1021
1022 reportError :: Bool -> String -> IO ()
1023 reportError bombOut str = do
1024    (hFlush stdout) `catchException` (\ _ -> return ())
1025    let bs@(ByteArray _ len _) = packString str
1026    writeErrString addrOf_ErrorHdrHook bs len
1027    if bombOut then
1028      stg_exit 1
1029     else
1030      return ()
1031
1032 foreign label "ErrorHdrHook"
1033         addrOf_ErrorHdrHook :: Addr
1034
1035 foreign import ccall "writeErrString__" unsafe
1036         writeErrString :: Addr -> ByteArray Int -> Int -> IO ()
1037
1038 foreign import ccall "stackOverflow"
1039         callStackOverflowHook :: IO ()
1040
1041 foreign import ccall "stg_exit"
1042         stg_exit :: Int -> IO ()
1043 \end{code}
1044
1045
1046 A number of operations want to get at a readable or writeable handle, and fail
1047 if it isn't:
1048
1049 \begin{code}
1050 wantReadableHandle :: String -> Handle -> (Handle__ -> IO a) -> IO a
1051 wantReadableHandle fun handle act =
1052     withHandle_ handle $ \ handle_ -> do
1053     case haType__ handle_ of
1054       ErrorHandle theError -> ioError theError
1055       ClosedHandle         -> ioe_closedHandle fun handle
1056       SemiClosedHandle     -> ioe_closedHandle fun handle
1057       AppendHandle         -> ioError not_readable_error
1058       WriteHandle          -> ioError not_readable_error
1059       _                    -> act handle_
1060   where
1061    not_readable_error =
1062            IOError (Just handle) IllegalOperation fun
1063                    ("handle is not open for reading")
1064
1065 wantWriteableHandle :: String -> Handle -> (Handle__ -> IO a) -> IO a
1066 wantWriteableHandle fun handle act =
1067     withHandle_ handle $ \ handle_ -> do
1068     case haType__ handle_ of
1069       ErrorHandle theError -> ioError theError
1070       ClosedHandle         -> ioe_closedHandle fun handle
1071       SemiClosedHandle     -> ioe_closedHandle fun handle
1072       ReadHandle           -> ioError not_writeable_error
1073       _                    -> act handle_
1074   where
1075    not_writeable_error =
1076            IOError (Just handle) IllegalOperation fun
1077                    ("handle is not open for writing")
1078
1079 wantRWHandle :: String -> Handle -> (Handle__ -> IO a) -> IO a
1080 wantRWHandle fun handle act =
1081     withHandle_ handle $ \ handle_ -> do
1082     case haType__ handle_ of
1083       ErrorHandle theError -> ioError theError
1084       ClosedHandle         -> ioe_closedHandle fun handle
1085       SemiClosedHandle     -> ioe_closedHandle fun handle
1086       _                    -> act handle_
1087
1088 wantSeekableHandle :: String -> Handle -> (Handle__ -> IO a) -> IO a
1089 wantSeekableHandle fun handle act =
1090     withHandle_ handle $ \ handle_ -> do
1091     case haType__ handle_ of
1092       ErrorHandle theError -> ioError theError
1093       ClosedHandle         -> ioe_closedHandle fun handle
1094       SemiClosedHandle     -> ioe_closedHandle fun handle
1095       _                    -> act handle_
1096   where
1097    not_seekable_error =
1098            IOError (Just handle)
1099                    IllegalOperation fun
1100                    ("handle is not seekable")
1101
1102 \end{code}
1103
1104 Internal function for creating an @IOError@ representing the
1105 access to a closed file.
1106
1107 \begin{code}
1108 ioe_closedHandle :: String -> Handle -> IO a
1109 ioe_closedHandle fun h = ioError (IOError (Just h) IllegalOperation fun "handle is closed")
1110 \end{code}
1111
1112 Internal helper functions for Concurrent Haskell implementation
1113 of IO:
1114
1115 \begin{code}
1116 #ifndef __PARALLEL_HASKELL__
1117 mayBlock :: ForeignObj -> IO Int -> IO Int
1118 #else
1119 mayBlock :: Addr  -> IO Int -> IO Int
1120 #endif
1121
1122 mayBlock fo act = do
1123    rc <- act
1124    case rc of
1125      -5 -> do  -- (possibly blocking) read
1126         fd <- getFileFd fo
1127         threadWaitRead fd
1128         mayBlock fo act  -- input available, re-try
1129      -6 -> do  -- (possibly blocking) write
1130         fd <- getFileFd fo
1131         threadWaitWrite fd
1132         mayBlock fo act  -- output possible
1133      -7 -> do  -- (possibly blocking) write on connected handle
1134         fd <- getConnFileFd fo
1135         threadWaitWrite fd
1136         mayBlock fo act  -- output possible
1137      _ -> do
1138         return rc
1139
1140 data MayBlock
1141   = BlockRead Int
1142   | BlockWrite Int
1143   | NoBlock Int
1144
1145 mayBlockRead :: String -> Handle -> (ForeignObj -> IO Int) -> IO Int
1146 mayBlockRead fname handle fn = do
1147     r <- wantReadableHandle fname handle $ \ handle_ -> do
1148          let fo = haFO__ handle_
1149          rc <- fn fo
1150          case rc of
1151            -5 -> do  -- (possibly blocking) read
1152              fd <- getFileFd fo
1153              return (BlockRead fd)
1154            -6 -> do  -- (possibly blocking) write
1155              fd <- getFileFd fo
1156              return (BlockWrite fd)
1157            -7 -> do  -- (possibly blocking) write on connected handle
1158              fd <- getConnFileFd fo
1159              return (BlockWrite fd)
1160            _ ->
1161              if rc >= 0
1162                   then return (NoBlock rc)
1163                   else constructErrorAndFail fname
1164     case r of
1165         BlockRead fd -> do
1166            threadWaitRead fd
1167            mayBlockRead fname handle fn
1168         BlockWrite fd -> do
1169            threadWaitWrite fd
1170            mayBlockRead fname handle fn
1171         NoBlock c -> return c
1172 \end{code}
1173
1174 Foreign import declarations of helper functions:
1175
1176 \begin{code}
1177
1178 #ifdef __HUGS__
1179 type Bytes = PrimByteArray RealWorld
1180 #else
1181 type Bytes = ByteArray#
1182 #endif
1183
1184 foreign import "libHS_cbits" "inputReady"  unsafe
1185            inputReady       :: FILE_OBJECT -> Int -> IO Int{-ret code-}
1186 foreign import "libHS_cbits" "fileGetc"    unsafe
1187            fileGetc         :: FILE_OBJECT -> IO Int
1188 foreign import "libHS_cbits" "fileLookAhead" unsafe
1189            fileLookAhead    :: FILE_OBJECT -> IO Int
1190 foreign import "libHS_cbits" "readBlock" unsafe
1191            readBlock        :: FILE_OBJECT -> IO Int
1192 foreign import "libHS_cbits" "readLine" unsafe
1193            readLine         :: FILE_OBJECT -> IO Int
1194 foreign import "libHS_cbits" "readChar" unsafe
1195            readChar         :: FILE_OBJECT -> IO Int
1196 foreign import "libHS_cbits" "writeFileObject" unsafe
1197            writeFileObject  :: FILE_OBJECT -> Int -> IO Int{-ret code-}
1198 foreign import "libHS_cbits" "filePutc" unsafe
1199            filePutc         :: FILE_OBJECT -> Char -> IO Int{-ret code-}
1200 foreign import "libHS_cbits" "getBufStart" unsafe
1201            getBufStart      :: FILE_OBJECT -> Int -> IO Addr
1202 foreign import "libHS_cbits" "getWriteableBuf" unsafe
1203            getWriteableBuf  :: FILE_OBJECT -> IO Addr
1204 foreign import "libHS_cbits" "getBufWPtr" unsafe
1205            getBufWPtr       :: FILE_OBJECT -> IO Int
1206 foreign import "libHS_cbits" "setBufWPtr" unsafe
1207            setBufWPtr       :: FILE_OBJECT -> Int -> IO ()
1208 foreign import "libHS_cbits" "closeFile" unsafe
1209            closeFile        :: FILE_OBJECT -> Int{-Flush-} -> IO Int{-ret code-}
1210 foreign import "libHS_cbits" "fileEOF" unsafe
1211            fileEOF           :: FILE_OBJECT -> IO Int{-ret code-}
1212 foreign import "libHS_cbits" "setBuffering" unsafe
1213            setBuffering      :: FILE_OBJECT -> Int -> IO Int{-ret code-}
1214 foreign import "libHS_cbits" "flushFile" unsafe
1215            flushFile         :: FILE_OBJECT -> IO Int{-ret code-}
1216 foreign import "libHS_cbits" "flushConnectedBuf" unsafe
1217            flushConnectedBuf :: FILE_OBJECT -> IO ()
1218 foreign import "libHS_cbits" "getBufferMode" unsafe
1219            getBufferMode     :: FILE_OBJECT -> IO Int{-ret code-}
1220 #ifdef __HUGS__
1221 foreign import "libHS_cbits" "seekFile_int64" unsafe
1222            seekFile    :: FILE_OBJECT -> Int -> Int64 -> IO Int
1223 #else
1224 foreign import "libHS_cbits" "seekFile" unsafe
1225            seekFile    :: FILE_OBJECT -> Int -> Int -> Bytes -> IO Int
1226 #endif
1227
1228 foreign import "libHS_cbits" "seekFileP" unsafe
1229            seekFileP        :: FILE_OBJECT -> IO Int{-ret code-}
1230 foreign import "libHS_cbits" "setTerminalEcho" unsafe
1231            setTerminalEcho  :: FILE_OBJECT -> Int -> IO Int{-ret code-}
1232 foreign import "libHS_cbits" "getTerminalEcho" unsafe
1233            getTerminalEcho  :: FILE_OBJECT -> IO Int{-ret code-}
1234 foreign import "libHS_cbits" "isTerminalDevice" unsafe
1235            isTerminalDevice :: FILE_OBJECT -> IO Int{-ret code-}
1236 foreign import "libHS_cbits" "setConnectedTo" unsafe
1237            setConnectedTo   :: FILE_OBJECT -> FILE_OBJECT -> Int -> IO ()
1238 foreign import "libHS_cbits" "ungetChar" unsafe
1239            ungetChar        :: FILE_OBJECT -> Char -> IO Int{-ret code-}
1240 foreign import "libHS_cbits" "readChunk" unsafe
1241            readChunk        :: FILE_OBJECT -> Addr -> Int -> IO Int{-ret code-}
1242 foreign import "libHS_cbits" "readChunk" unsafe
1243            readChunkBA      :: FILE_OBJECT -> ByteArray Int -> Int -> IO Int{-ret code-}
1244 foreign import "libHS_cbits" "writeBuf" unsafe
1245            writeBuf         :: FILE_OBJECT -> Addr -> Int -> IO Int{-ret code-}
1246 #ifndef __HUGS__
1247 foreign import "libHS_cbits" "writeBufBA" unsafe
1248            writeBufBA       :: FILE_OBJECT -> ByteArray Int -> Int -> IO Int{-ret code-}
1249 #endif
1250 foreign import "libHS_cbits" "getFileFd" unsafe
1251            getFileFd        :: FILE_OBJECT -> IO Int{-fd-}
1252 #ifdef __HUGS__
1253 foreign import "libHS_cbits" "fileSize_int64" unsafe
1254            fileSize_int64   :: FILE_OBJECT -> Bytes -> IO Int{-ret code-}
1255 #else
1256 foreign import "libHS_cbits" "fileSize" unsafe
1257            fileSize  :: FILE_OBJECT -> Bytes -> IO Int{-ret code-}
1258 #endif
1259
1260 foreign import "libHS_cbits" "getFilePosn" unsafe
1261            getFilePosn      :: FILE_OBJECT -> IO Int
1262 foreign import "libHS_cbits" "setFilePosn" unsafe
1263            setFilePosn      :: FILE_OBJECT -> Int -> ByteArray# -> IO Int
1264 foreign import "libHS_cbits" "getConnFileFd" unsafe
1265            getConnFileFd    :: FILE_OBJECT -> IO Int{-fd-}
1266 foreign import "libHS_cbits" "getLock" unsafe
1267            getLock  :: Int{-Fd-} -> Int{-exclusive-} -> IO Int{-return code-}
1268 foreign import "libHS_cbits" "openStdFile" unsafe
1269            openStdFile      :: Int{-fd-} -> Int{-Readable?-} -> IO Addr{-file obj-}
1270 foreign import "libHS_cbits" "openFile" unsafe
1271            primOpenFile         :: ByteArray Int{-CString-}
1272                                 -> Int{-How-}
1273                                 -> Int{-Binary-}
1274                                 -> IO Addr {-file obj-}
1275 foreign import "libHS_cbits" "const_BUFSIZ" unsafe
1276            const_BUFSIZ          :: Int
1277
1278 foreign import "libHS_cbits" "setBinaryMode__"
1279            setBinaryMode :: FILE_OBJECT -> Int -> IO Int
1280 \end{code}
1281
1282