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