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 -fcompiling-prelude -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           if rc == (0::Int)
 396            then return (handle_{ haType__   = ClosedHandle,
 397                                  haFO__     = nullFile__ })
 398            else constructErrorAndFail "hClose"
 399
 400 \end{code}
 401
 402 Computation $hClose hdl$ makes handle {\em hdl} closed.  Before the
 403 computation finishes, any items buffered for output and not already
 404 sent to the operating system are flushed as for $flush$.
 405
 406 %*********************************************************
 407 %*                                                      *
 408 \subsection[FileSize]{Detecting the size of a file}
 409 %*                                                      *
 410 %*********************************************************
 411
 412
 413 For a handle {\em hdl} which attached to a physical file, $hFileSize
 414 hdl$ returns the size of {\em hdl} in terms of the number of items
 415 which can be read from {\em hdl}.
 416
 417 \begin{code}
 418 hFileSize :: Handle -> IO Integer
 419 hFileSize handle =
 420     withHandle_ handle $ \ handle_ -> do
 421     case haType__ handle_ of
 422       ErrorHandle theError      -> ioError theError
 423       ClosedHandle              -> ioe_closedHandle "hFileSize" handle
 424       SemiClosedHandle          -> ioe_closedHandle "hFileSize" handle
 425 #ifdef __HUGS__
 426       _ -> do
 427           mem <- primNewByteArray 8{-sizeof_int64-}
 428           rc <- fileSize_int64 (haFO__ handle_) mem  -- ConcHask: SAFE, won't block
 429           if rc == 0 then do
 430              result <- primReadInt64Array mem 0
 431              return (primInt64ToInteger result)
 432            else
 433              constructErrorAndFail "hFileSize"
 434 #else
 435       _ ->
 436           -- HACK!  We build a unique MP_INT of the right shape to hold
 437           -- a single unsigned word, and we let the C routine
 438           -- change the data bits
 439           --
 440           case int2Integer# 1# of
 441               (# s, d #) -> do
 442                 rc <- fileSize (haFO__ handle_) d  -- ConcHask: SAFE, won't block
 443                 if rc == (0::Int) then
 444                    return (J# s d)
 445                  else
 446                    constructErrorAndFail "hFileSize"
 447 #endif
 448 \end{code}
 449
 450 %*********************************************************
 451 %*                                                      *
 452 \subsection[EOF]{Detecting the End of Input}
 453 %*                                                      *
 454 %*********************************************************
 455
 456
 457 For a readable handle {\em hdl}, @hIsEOF hdl@ returns
 458 @True@ if no further input can be taken from @hdl@ or for a
 459 physical file, if the current I/O position is equal to the length of
 460 the file.  Otherwise, it returns @False@.
 461
 462 \begin{code}
 463 hIsEOF :: Handle -> IO Bool
 464 hIsEOF handle = do
 465     rc <- mayBlockRead "hIsEOF" handle fileEOF
 466     case rc of
 467       0 -> return False
 468       1 -> return True
 469       _ -> constructErrorAndFail "hIsEOF"
 470
 471 isEOF :: IO Bool
 472 isEOF = hIsEOF stdin
 473 \end{code}
 474
 475 %*********************************************************
 476 %*                                                      *
 477 \subsection[Buffering]{Buffering Operations}
 478 %*                                                      *
 479 %*********************************************************
 480
 481 Three kinds of buffering are supported: line-buffering,
 482 block-buffering or no-buffering.  See @IOBase@ for definition
 483 and further explanation of what the type represent.
 484
 485 Computation @hSetBuffering hdl mode@ sets the mode of buffering for
 486 handle {\em hdl} on subsequent reads and writes.
 487
 488 \begin{itemize}
 489 \item
 490 If {\em mode} is @LineBuffering@, line-buffering should be
 491 enabled if possible.
 492 \item
 493 If {\em mode} is @BlockBuffering@ {\em size}, then block-buffering
 494 should be enabled if possible.  The size of the buffer is {\em n} items
 495 if {\em size} is @Just@~{\em n} and is otherwise implementation-dependent.
 496 \item
 497 If {\em mode} is @NoBuffering@, then buffering is disabled if possible.
 498 \end{itemize}
 499
 500 If the buffer mode is changed from @BlockBuffering@ or @LineBuffering@
 501 to @NoBuffering@, then any items in the output buffer are written to
 502 the device, and any items in the input buffer are discarded.  The
 503 default buffering mode when a handle is opened is
 504 implementation-dependent and may depend on the object which is
 505 attached to that handle.
 506
 507 \begin{code}
 508 hSetBuffering :: Handle -> BufferMode -> IO ()
 509
 510 hSetBuffering handle mode =
 511     case mode of
 512       BlockBuffering (Just n)
 513         | n <= 0 -> ioError
 514                          (IOError (Just handle)
 515                                   InvalidArgument
 516                                   "hSetBuffering"
 517                                   ("illegal buffer size " ++ showsPrec 9 n []))  -- 9 => should be parens'ified.
 518       _ ->
 519           withHandle__ handle $ \ handle_ -> do
 520           case haType__ handle_ of
 521              ErrorHandle theError -> ioError theError
 522              ClosedHandle         -> ioe_closedHandle "hSetBuffering" handle
 523              _ -> do
 524                 {- Note:
 525                     - we flush the old buffer regardless of whether
 526                       the new buffer could fit the contents of the old buffer
 527                       or not.
 528                     - allow a handle's buffering to change even if IO has
 529                       occurred (ANSI C spec. does not allow this, nor did
 530                       the previous implementation of IO.hSetBuffering).
 531                     - a non-standard extension is to allow the buffering
 532                       of semi-closed handles to change [sof 6/98]
 533                 -}
 534                 let fo = haFO__ handle_
 535                 rc <- mayBlock fo (setBuffering fo bsize) -- ConcHask: UNSAFE, may block
 536                 if rc == 0
 537                  then do
 538                    return (handle_{ haBufferMode__ = mode })
 539                  else do
 540                    -- Note: failure to change the buffer size will cause old buffer to be flushed.
 541                    constructErrorAndFail "hSetBuffering"
 542   where
 543     bsize :: Int
 544     bsize = case mode of
 545               NoBuffering             ->  0
 546               LineBuffering           -> -1
 547               BlockBuffering Nothing  -> -2
 548               BlockBuffering (Just n) ->  n
 549 \end{code}
 550
 551 The action @hFlush hdl@ causes any items buffered for output
 552 in handle {\em hdl} to be sent immediately to the operating
 553 system.
 554
 555 \begin{code}
 556 hFlush :: Handle -> IO ()
 557 hFlush handle =
 558     wantWriteableHandle "hFlush" handle $ \ handle_ -> do
 559     let fo = haFO__ handle_
 560     rc      <- mayBlock fo (flushFile fo)   -- ConcHask: UNSAFE, may block
 561     if rc == 0 then
 562        return ()
 563      else
 564        constructErrorAndFail "hFlush"
 565
 566 \end{code}
 567
 568
 569 %*********************************************************
 570 %*                                                      *
 571 \subsection[Seeking]{Repositioning Handles}
 572 %*                                                      *
 573 %*********************************************************
 574
 575 \begin{code}
 576 data HandlePosn
 577  = HandlePosn
 578         Handle   -- Q: should this be a weak or strong ref. to the handle?
 579                  --    [what's the winning argument for it not being strong? --sof]
 580         HandlePosition
 581
 582 instance Eq HandlePosn where
 583     (HandlePosn h1 p1) == (HandlePosn h2 p2) = p1==p2 && h1==h2
 584
 585   -- HandlePosition is the Haskell equivalent of POSIX' off_t.
 586   -- We represent it as an Integer on the Haskell side, but
 587   -- cheat slightly in that hGetPosn calls upon a C helper
 588   -- that reports the position back via (merely) an Int.
 589 type HandlePosition = Integer
 590
 591 mkHandlePosn :: Handle -> HandlePosition -> HandlePosn
 592 mkHandlePosn h p = HandlePosn h p
 593
 594 data SeekMode    =  AbsoluteSeek | RelativeSeek | SeekFromEnd
 595                     deriving (Eq, Ord, Ix, Enum, Read, Show)
 596 \end{code}
 597
 598 Computation @hGetPosn hdl@ returns the current I/O
 599 position of {\em hdl} as an abstract position.  Computation
 600 $hSetPosn p$ sets the position of {\em hdl}
 601 to a previously obtained position {\em p}.
 602
 603 \begin{code}
 604 hGetPosn :: Handle -> IO HandlePosn
 605 hGetPosn handle =
 606     wantSeekableHandle "hGetPosn" handle $ \ handle_ -> do
 607     posn    <- getFilePosn (haFO__ handle_)   -- ConcHask: SAFE, won't block
 608     if posn /= -1 then do
 609       return (mkHandlePosn handle (fromInt posn))
 610      else
 611       constructErrorAndFail "hGetPosn"
 612
 613 hSetPosn :: HandlePosn -> IO ()
 614 hSetPosn (HandlePosn handle i@(S# _))   = hSetPosn (HandlePosn handle (toBig i))
 615 hSetPosn (HandlePosn handle (J# s# d#)) =
 616     wantSeekableHandle "hSetPosn" handle $ \ handle_ -> do
 617            -- not as silly as it looks: the handle may have been closed in the meantime.
 618     let fo = haFO__ handle_
 619     rc     <- mayBlock fo (setFilePosn fo (I# s#) d#)    -- ConcHask: UNSAFE, may block
 620     if rc == 0 then do
 621        return ()
 622      else
 623         constructErrorAndFail "hSetPosn"
 624 \end{code}
 625
 626 The action @hSeek hdl mode i@ sets the position of handle
 627 @hdl@ depending on @mode@.  If @mode@ is
 628
 629  * AbsoluteSeek - The position of @hdl@ is set to @i@.
 630  * RelativeSeek - The position of @hdl@ is set to offset @i@ from
 631                   the current position.
 632  * SeekFromEnd  - The position of @hdl@ is set to offset @i@ from
 633                   the end of the file.
 634
 635 Some handles may not be seekable (see @hIsSeekable@), or only
 636 support a subset of the possible positioning operations (e.g. it may
 637 only be possible to seek to the end of a tape, or to a positive
 638 offset from the beginning or current position).
 639
 640 It is not possible to set a negative I/O position, or for a physical
 641 file, an I/O position beyond the current end-of-file.
 642
 643 Note:
 644  - when seeking using @SeekFromEnd@, positive offsets (>=0) means
 645    seeking at or past EOF.
 646  - relative seeking on buffered handles can lead to non-obvious results.
 647
 648 \begin{code}
 649 hSeek :: Handle -> SeekMode -> Integer -> IO ()
 650 #ifdef __HUGS__
 651 hSeek handle mode offset =
 652     wantSeekableHandle "hSeek" handle $ \ handle_ -> do
 653     let fo = haFO__ handle_
 654     rc      <- mayBlock fo (seekFile fo whence (primIntegerToInt64 offset))  -- ConcHask: UNSAFE, may block
 655 #else
 656 hSeek handle mode i@(S# _) = hSeek handle mode (toBig i)
 657 hSeek handle mode (J# s# d#) =
 658     wantSeekableHandle "hSeek" handle $ \ handle_ -> do
 659     let fo = haFO__ handle_
 660     rc      <- mayBlock fo (seekFile fo whence (I# s#) d#)  -- ConcHask: UNSAFE, may block
 661 #endif
 662     if rc == 0 then do
 663        return ()
 664      else
 665         constructErrorAndFail "hSeek"
 666   where
 667     whence :: Int
 668     whence = case mode of
 669                AbsoluteSeek -> 0
 670                RelativeSeek -> 1
 671                SeekFromEnd  -> 2
 672 \end{code}
 673
 674 %*********************************************************
 675 %*                                                      *
 676 \subsection[Query]{Handle Properties}
 677 %*                                                      *
 678 %*********************************************************
 679
 680 A number of operations return information about the properties of a
 681 handle.  Each of these operations returns $True$ if the
 682 handle has the specified property, and $False$
 683 otherwise.
 684
 685 Computation $hIsBlockBuffered hdl$ returns $( False, Nothing )$ if
 686 {\em hdl} is not block-buffered.  Otherwise it returns
 687 $( True, size )$, where {\em size} is $Nothing$ for default buffering, and
 688 $( Just n )$ for block-buffering of {\em n} bytes.
 689
 690 \begin{code}
 691 hIsOpen :: Handle -> IO Bool
 692 hIsOpen handle =
 693     withHandle_ handle $ \ handle_ -> do
 694     case haType__ handle_ of
 695       ErrorHandle theError -> ioError theError
 696       ClosedHandle         -> return False
 697       SemiClosedHandle     -> return False
 698       _                    -> return True
 699
 700 hIsClosed :: Handle -> IO Bool
 701 hIsClosed handle =
 702     withHandle_ handle $ \ handle_ -> do
 703     case haType__ handle_ of
 704       ErrorHandle theError -> ioError theError
 705       ClosedHandle         -> return True
 706       _                    -> return False
 707
 708 {- not defined, nor exported, but mentioned
 709    here for documentation purposes:
 710
 711     hSemiClosed :: Handle -> IO Bool
 712     hSemiClosed h = do
 713        ho <- hIsOpen h
 714        hc <- hIsClosed h
 715        return (not (ho || hc))
 716 -}
 717
 718 hIsReadable :: Handle -> IO Bool
 719 hIsReadable handle =
 720     withHandle_ handle $ \ handle_ -> do
 721     case haType__ handle_ of
 722       ErrorHandle theError -> ioError theError
 723       ClosedHandle         -> ioe_closedHandle "hIsReadable" handle
 724       SemiClosedHandle     -> ioe_closedHandle "hIsReadable" handle
 725       htype                -> return (isReadable htype)
 726   where
 727     isReadable ReadHandle      = True
 728     isReadable ReadWriteHandle = True
 729     isReadable _               = False
 730
 731 hIsWritable :: Handle -> IO Bool
 732 hIsWritable handle =
 733     withHandle_ handle $ \ handle_ -> do
 734     case haType__ handle_ of
 735       ErrorHandle theError -> ioError theError
 736       ClosedHandle         -> ioe_closedHandle "hIsWritable" handle
 737       SemiClosedHandle     -> ioe_closedHandle "hIsWritable" handle
 738       htype                -> return (isWritable htype)
 739   where
 740     isWritable AppendHandle    = True
 741     isWritable WriteHandle     = True
 742     isWritable ReadWriteHandle = True
 743     isWritable _               = False
 744
 745
 746 getBMode__ :: FILE_OBJECT -> IO (BufferMode, Int)
 747 getBMode__ fo = do
 748   rc <- getBufferMode fo    -- ConcHask: SAFE, won't block
 749   case (rc::Int) of
 750     0  -> return (NoBuffering, 0)
 751     -1 -> return (LineBuffering, default_buffer_size)
 752     -2 -> return (BlockBuffering Nothing, default_buffer_size)
 753     -3 -> return (NoBuffering, 0)               -- only happens on un-stat()able files.
 754     n  -> return (BlockBuffering (Just n), n)
 755  where
 756    default_buffer_size :: Int
 757    default_buffer_size = const_BUFSIZ
 758 \end{code}
 759
 760 Querying how a handle buffers its data:
 761
 762 \begin{code}
 763 hGetBuffering :: Handle -> IO BufferMode
 764 hGetBuffering handle =
 765     withHandle_ handle $ \ handle_ -> do
 766     case haType__ handle_ of
 767       ErrorHandle theError -> ioError theError
 768       ClosedHandle         -> ioe_closedHandle "hGetBuffering" handle
 769       _ ->
 770           {-
 771            We're being non-standard here, and allow the buffering
 772            of a semi-closed handle to be queried.   -- sof 6/98
 773           -}
 774           return (haBufferMode__ handle_)  -- could be stricter..
 775 \end{code}
 776
 777 \begin{code}
 778 hIsSeekable :: Handle -> IO Bool
 779 hIsSeekable handle =
 780     withHandle_ handle $ \ handle_ -> do
 781     case haType__ handle_ of
 782       ErrorHandle theError -> ioError theError
 783       ClosedHandle         -> ioe_closedHandle "hIsSeekable" handle
 784       SemiClosedHandle     -> ioe_closedHandle "hIsSeekable" handle
 785       AppendHandle         -> return False
 786       _ -> do
 787           rc <- seekFileP (haFO__ handle_)   -- ConcHask: SAFE, won't block
 788           case (rc::Int) of
 789             0 -> return False
 790             1 -> return True
 791             _ -> constructErrorAndFail "hIsSeekable"
 792 \end{code}
 793
 794
 795 %*********************************************************
 796 %*                                                      *
 797 \subsection{Changing echo status}
 798 %*                                                      *
 799 %*********************************************************
 800
 801 Non-standard GHC extension is to allow the echoing status
 802 of a handles connected to terminals to be reconfigured:
 803
 804 \begin{code}
 805 hSetEcho :: Handle -> Bool -> IO ()
 806 hSetEcho handle on = do
 807     isT   <- hIsTerminalDevice handle
 808     if not isT
 809      then return ()
 810      else
 811       withHandle_ handle $ \ handle_ -> do
 812       case haType__ handle_ of
 813          ErrorHandle theError -> ioError theError
 814          ClosedHandle         -> ioe_closedHandle "hSetEcho" handle
 815          _ -> do
 816             rc <- setTerminalEcho (haFO__ handle_) (if on then 1 else 0)  -- ConcHask: SAFE, won't block
 817             if rc /= ((-1)::Int)
 818              then return ()
 819              else constructErrorAndFail "hSetEcho"
 820
 821 hGetEcho :: Handle -> IO Bool
 822 hGetEcho handle = do
 823     isT   <- hIsTerminalDevice handle
 824     if not isT
 825      then return False
 826      else
 827        withHandle_ handle $ \ handle_ -> do
 828        case haType__ handle_ of
 829          ErrorHandle theError -> ioError theError
 830          ClosedHandle         -> ioe_closedHandle "hGetEcho" handle
 831          _ -> do
 832             rc <- getTerminalEcho (haFO__ handle_)  -- ConcHask: SAFE, won't block
 833             case (rc::Int) of
 834               1 -> return True
 835               0 -> return False
 836               _ -> constructErrorAndFail "hSetEcho"
 837
 838 hIsTerminalDevice :: Handle -> IO Bool
 839 hIsTerminalDevice handle = do
 840     withHandle_ handle $ \ handle_ -> do
 841      case haType__ handle_ of
 842        ErrorHandle theError -> ioError theError
 843        ClosedHandle         -> ioe_closedHandle "hIsTerminalDevice" handle
 844        _ -> do
 845           rc <- isTerminalDevice (haFO__ handle_)   -- ConcHask: SAFE, won't block
 846           case (rc::Int) of
 847             1 -> return True
 848             0 -> return False
 849             _ -> constructErrorAndFail "hIsTerminalDevice"
 850 \end{code}
 851
 852 \begin{code}
 853 hConnectTerms :: Handle -> Handle -> IO ()
 854 hConnectTerms hW hR = hConnectHdl_ hW hR 1{-check if they're both coming connected to ttys-}
 855
 856 hConnectTo :: Handle -> Handle -> IO ()
 857 hConnectTo hW hR = hConnectHdl_ hW hR 0{-connect regardless-}
 858
 859 hConnectHdl_ :: Handle -> Handle -> Int -> IO ()
 860 hConnectHdl_ hW hR is_tty =
 861   wantRWHandle "hConnectTo" hW $ \ hW_ ->
 862   wantRWHandle "hConnectTo" hR $ \ hR_ -> do
 863   setConnectedTo (haFO__ hR_) (haFO__ hW_) is_tty  -- ConcHask: SAFE, won't block
 864 \end{code}
 865
 866 As an extension, we also allow characters to be pushed back.
 867 Like ANSI C stdio, we guarantee no more than one character of
 868 pushback. (For unbuffered channels, the (default) push-back limit is
 869 2 chars tho.)
 870
 871 \begin{code}
 872 hUngetChar :: Handle -> Char -> IO ()
 873 hUngetChar handle c =
 874     wantReadableHandle "hLookAhead" handle $ \ handle_ -> do
 875     rc      <- ungetChar (haFO__ handle_) c  -- ConcHask: SAFE, won't block
 876     if rc == ((-1)::Int)
 877      then constructErrorAndFail "hUngetChar"
 878      else return ()
 879
 880 \end{code}
 881
 882
 883 Hoisting files in in one go is sometimes useful, so we support
 884 this as an extension:
 885
 886 \begin{code}
 887 -- in one go, read file into an externally allocated buffer.
 888 slurpFile :: FilePath -> IO (Addr, Int)
 889 slurpFile fname = do
 890   handle <- openFile fname ReadMode
 891   sz     <- hFileSize handle
 892   if sz > toInteger (maxBound::Int) then
 893     ioError (userError "slurpFile: file too big")
 894    else do
 895      let sz_i = fromInteger sz
 896      chunk <- allocMemory__ sz_i
 897      if chunk == nullAddr
 898       then do
 899         hClose handle
 900         constructErrorAndFail "slurpFile"
 901       else do
 902         rc <- withHandle_ handle ( \ handle_ -> do
 903           let fo = haFO__ handle_
 904           mayBlock fo (readChunk fo chunk 0 sz_i)    -- ConcHask: UNSAFE, may block.
 905          )
 906         hClose handle
 907         if rc < (0::Int)
 908          then constructErrorAndFail "slurpFile"
 909          else return (chunk, rc)
 910
 911 \end{code}
 912
 913 Sometimes it's useful to get at the file descriptor that
 914 the Handle contains..
 915
 916 \begin{code}
 917 getHandleFd :: Handle -> IO Int
 918 getHandleFd handle =
 919     withHandle_ handle $ \ handle_ -> do
 920     case (haType__ handle_) of
 921       ErrorHandle theError -> ioError theError
 922       ClosedHandle         -> ioe_closedHandle "getHandleFd" handle
 923       _ -> do
 924           fd <- getFileFd (haFO__ handle_)
 925           return fd
 926 \end{code}
 927
 928
 929 %*********************************************************
 930 %*                                                      *
 931 \subsection{Miscellaneous}
 932 %*                                                      *
 933 %*********************************************************
 934
 935 These three functions are meant to get things out of @IOErrors@.
 936
 937 (ToDo: improve!)
 938
 939 \begin{code}
 940 ioeGetFileName        :: IOError -> Maybe FilePath
 941 ioeGetErrorString     :: IOError -> String
 942 ioeGetHandle          :: IOError -> Maybe Handle
 943
 944 ioeGetHandle   (IOError h _ _ _)   = h
 945 ioeGetErrorString (IOError _ iot _ str) =
 946  case iot of
 947    EOF -> "end of file"
 948    _   -> str
 949
 950 ioeGetFileName (IOError _ _  _ str) =
 951  case span (/=':') str of
 952    (_,[])  -> Nothing
 953    (fs,_)  -> Just fs
 954
 955 \end{code}
 956
 957 'Top-level' IO actions want to catch exceptions (e.g., forkIO and
 958 PrelMain.mainIO) and report them - topHandler is the exception
 959 handler they should use for this:
 960
 961 \begin{code}
 962 -- make sure we handle errors while reporting the error!
 963 -- (e.g. evaluating the string passed to 'error' might generate
 964 --  another error, etc.)
 965 topHandler :: Bool -> Exception -> IO ()
 966 topHandler bombOut err = catchException (real_handler bombOut err) (topHandler bombOut)
 967
 968 real_handler :: Bool -> Exception -> IO ()
 969 real_handler bombOut ex =
 970   case ex of
 971         AsyncException StackOverflow -> reportStackOverflow bombOut
 972         ErrorCall s -> reportError bombOut s
 973         other       -> reportError bombOut (showsPrec 0 other "\n")
 974
 975 reportStackOverflow :: Bool -> IO ()
 976 reportStackOverflow bombOut = do
 977    (hFlush stdout) `catchException` (\ _ -> return ())
 978    callStackOverflowHook
 979    if bombOut then
 980      stg_exit 2
 981     else
 982      return ()
 983
 984 reportError :: Bool -> String -> IO ()
 985 reportError bombOut str = do
 986    (hFlush stdout) `catchException` (\ _ -> return ())
 987    let bs@(ByteArray _ len _) = packString str
 988    writeErrString addrOf_ErrorHdrHook bs len
 989    if bombOut then
 990      stg_exit 1
 991     else
 992      return ()
 993
 994 foreign label "ErrorHdrHook"
 995         addrOf_ErrorHdrHook :: Addr
 996
 997 foreign import ccall "writeErrString__" unsafe
 998         writeErrString :: Addr -> ByteArray Int -> Int -> IO ()
 999
1000 foreign import ccall "stackOverflow"
1001         callStackOverflowHook :: IO ()
1002
1003 foreign import ccall "stg_exit"
1004         stg_exit :: Int -> IO ()
1005 \end{code}
1006
1007
1008 A number of operations want to get at a readable or writeable handle, and fail
1009 if it isn't:
1010
1011 \begin{code}
1012 wantReadableHandle :: String -> Handle -> (Handle__ -> IO a) -> IO a
1013 wantReadableHandle fun handle act =
1014     withHandle_ handle $ \ handle_ -> do
1015     case haType__ handle_ of
1016       ErrorHandle theError -> ioError theError
1017       ClosedHandle         -> ioe_closedHandle fun handle
1018       SemiClosedHandle     -> ioe_closedHandle fun handle
1019       AppendHandle         -> ioError not_readable_error
1020       WriteHandle          -> ioError not_readable_error
1021       _                    -> act handle_
1022   where
1023    not_readable_error =
1024            IOError (Just handle) IllegalOperation fun
1025                    ("handle is not open for reading")
1026
1027 wantWriteableHandle :: String -> Handle -> (Handle__ -> IO a) -> IO a
1028 wantWriteableHandle fun handle act =
1029     withHandle_ handle $ \ handle_ ->
1030         checkWriteableHandle fun handle handle_ (act handle_)
1031
1032 wantWriteableHandle_ :: String -> Handle -> (Handle__ -> IO (Handle__, a)) -> IO a
1033 wantWriteableHandle_ fun handle act =
1034     withHandle handle $ \ handle_ ->
1035         checkWriteableHandle fun handle handle_ (act handle_)
1036
1037 checkWriteableHandle fun handle handle_ act
1038   = case haType__ handle_ of
1039       ErrorHandle theError -> ioError theError
1040       ClosedHandle         -> ioe_closedHandle fun handle
1041       SemiClosedHandle     -> ioe_closedHandle fun handle
1042       ReadHandle           -> ioError not_writeable_error
1043       _                    -> act
1044   where
1045    not_writeable_error =
1046            IOError (Just handle) IllegalOperation fun
1047                    ("handle is not open for writing")
1048
1049 wantRWHandle :: String -> Handle -> (Handle__ -> IO a) -> IO a
1050 wantRWHandle fun handle act =
1051     withHandle_ handle $ \ handle_ -> do
1052     case haType__ handle_ of
1053       ErrorHandle theError -> ioError theError
1054       ClosedHandle         -> ioe_closedHandle fun handle
1055       SemiClosedHandle     -> ioe_closedHandle fun handle
1056       _                    -> act handle_
1057
1058 wantSeekableHandle :: String -> Handle -> (Handle__ -> IO a) -> IO a
1059 wantSeekableHandle fun handle act =
1060     withHandle_ handle $ \ handle_ -> do
1061     case haType__ handle_ of
1062       ErrorHandle theError -> ioError theError
1063       ClosedHandle         -> ioe_closedHandle fun handle
1064       SemiClosedHandle     -> ioe_closedHandle fun handle
1065       _                    -> act handle_
1066   where
1067    not_seekable_error =
1068            IOError (Just handle)
1069                    IllegalOperation fun
1070                    ("handle is not seekable")
1071
1072 \end{code}
1073
1074 Internal function for creating an @IOError@ representing the
1075 access to a closed file.
1076
1077 \begin{code}
1078 ioe_closedHandle :: String -> Handle -> IO a
1079 ioe_closedHandle fun h = ioError (IOError (Just h) IllegalOperation fun "handle is closed")
1080 \end{code}
1081
1082 Internal helper functions for Concurrent Haskell implementation
1083 of IO:
1084
1085 \begin{code}
1086 mayBlock :: FILE_OBJECT -> IO Int -> IO Int
1087 mayBlock fo act = do
1088    rc <- act
1089    case rc of
1090      -5 -> do  -- (possibly blocking) read
1091         fd <- getFileFd fo
1092         threadWaitRead fd
1093         mayBlock fo act  -- input available, re-try
1094      -6 -> do  -- (possibly blocking) write
1095         fd <- getFileFd fo
1096         threadWaitWrite fd
1097         mayBlock fo act  -- output possible
1098      -7 -> do  -- (possibly blocking) write on connected handle
1099         fd <- getConnFileFd fo
1100         threadWaitWrite fd
1101         mayBlock fo act  -- output possible
1102      _ -> do
1103         return rc
1104
1105 data MayBlock
1106   = BlockRead Int
1107   | BlockWrite Int
1108   | NoBlock Int
1109
1110 mayBlockRead :: String -> Handle -> (FILE_OBJECT -> IO Int) -> IO Int
1111 mayBlockRead fname handle fn = do
1112     r <- wantReadableHandle fname handle $ \ handle_ -> do
1113          let fo = haFO__ handle_
1114          rc <- fn fo
1115          case rc of
1116            -5 -> do  -- (possibly blocking) read
1117              fd <- getFileFd fo
1118              return (BlockRead fd)
1119            -6 -> do  -- (possibly blocking) write
1120              fd <- getFileFd fo
1121              return (BlockWrite fd)
1122            -7 -> do  -- (possibly blocking) write on connected handle
1123              fd <- getConnFileFd fo
1124              return (BlockWrite fd)
1125            _ ->
1126              if rc >= 0
1127                   then return (NoBlock rc)
1128                   else constructErrorAndFail fname
1129     case r of
1130         BlockRead fd -> do
1131            threadWaitRead fd
1132            mayBlockRead fname handle fn
1133         BlockWrite fd -> do
1134            threadWaitWrite fd
1135            mayBlockRead fname handle fn
1136         NoBlock c -> return c
1137
1138 mayBlockWrite :: String -> Handle -> (FILE_OBJECT -> IO Int) -> IO Int
1139 mayBlockWrite fname handle fn = do
1140     r <- wantWriteableHandle fname handle $ \ handle_ -> do
1141          let fo = haFO__ handle_
1142          rc <- fn fo
1143          case rc of
1144            -5 -> do  -- (possibly blocking) read
1145              fd <- getFileFd fo
1146              return (BlockRead fd)
1147            -6 -> do  -- (possibly blocking) write
1148              fd <- getFileFd fo
1149              return (BlockWrite fd)
1150            -7 -> do  -- (possibly blocking) write on connected handle
1151              fd <- getConnFileFd fo
1152              return (BlockWrite fd)
1153            _ ->
1154              if rc >= 0
1155                   then return (NoBlock rc)
1156                   else constructErrorAndFail fname
1157     case r of
1158         BlockRead fd -> do
1159            threadWaitRead fd
1160            mayBlockWrite fname handle fn
1161         BlockWrite fd -> do
1162            threadWaitWrite fd
1163            mayBlockWrite fname handle fn
1164         NoBlock c -> return c
1165 \end{code}
1166
1167 Foreign import declarations of helper functions:
1168
1169 \begin{code}
1170
1171 #ifdef __HUGS__
1172 type Bytes = PrimByteArray RealWorld
1173 #else
1174 type Bytes = ByteArray#
1175 #endif
1176
1177 foreign import "libHS_cbits" "inputReady"  unsafe
1178            inputReady       :: FILE_OBJECT -> Int -> IO Int{-ret code-}
1179 foreign import "libHS_cbits" "fileGetc"    unsafe
1180            fileGetc         :: FILE_OBJECT -> IO Int
1181 foreign import "libHS_cbits" "fileLookAhead" unsafe
1182            fileLookAhead    :: FILE_OBJECT -> IO Int
1183 foreign import "libHS_cbits" "readBlock" unsafe
1184            readBlock        :: FILE_OBJECT -> IO Int
1185 foreign import "libHS_cbits" "readLine" unsafe
1186            readLine         :: FILE_OBJECT -> IO Int
1187 foreign import "libHS_cbits" "readChar" unsafe
1188            readChar         :: FILE_OBJECT -> IO Int
1189 foreign import "libHS_cbits" "writeFileObject" unsafe
1190            writeFileObject  :: FILE_OBJECT -> Int -> IO Int{-ret code-}
1191 foreign import "libHS_cbits" "filePutc" unsafe
1192            filePutc         :: FILE_OBJECT -> Char -> IO Int{-ret code-}
1193 foreign import "libHS_cbits" "write_" unsafe
1194            write_           :: FILE_OBJECT -> Addr -> Int -> IO Int{-ret code-}
1195 foreign import "libHS_cbits" "getBufStart" unsafe
1196            getBufStart      :: FILE_OBJECT -> Int -> IO Addr
1197 foreign import "libHS_cbits" "getWriteableBuf" unsafe
1198            getWriteableBuf  :: FILE_OBJECT -> IO Addr
1199 foreign import "libHS_cbits" "getBuf" unsafe
1200            getBuf           :: FILE_OBJECT -> IO Addr
1201 foreign import "libHS_cbits" "getBufWPtr" unsafe
1202            getBufWPtr       :: FILE_OBJECT -> IO Int
1203 foreign import "libHS_cbits" "setBufWPtr" unsafe
1204            setBufWPtr       :: FILE_OBJECT -> Int -> IO ()
1205 foreign import "libHS_cbits" "closeFile" unsafe
1206            closeFile        :: FILE_OBJECT -> Int{-Flush-} -> IO Int{-ret code-}
1207 foreign import "libHS_cbits" "fileEOF" unsafe
1208            fileEOF           :: FILE_OBJECT -> IO Int{-ret code-}
1209 foreign import "libHS_cbits" "setBuffering" unsafe
1210            setBuffering      :: FILE_OBJECT -> Int -> IO Int{-ret code-}
1211 foreign import "libHS_cbits" "flushFile" unsafe
1212            flushFile         :: FILE_OBJECT -> IO Int{-ret code-}
1213 foreign import "libHS_cbits" "flushConnectedBuf" unsafe
1214            flushConnectedBuf :: FILE_OBJECT -> IO ()
1215 foreign import "libHS_cbits" "getBufferMode" unsafe
1216            getBufferMode     :: FILE_OBJECT -> IO Int{-ret code-}
1217 #ifdef __HUGS__
1218 foreign import "libHS_cbits" "seekFile_int64" unsafe
1219            seekFile    :: FILE_OBJECT -> Int -> Int64 -> IO Int
1220 #else
1221 foreign import "libHS_cbits" "seekFile" unsafe
1222            seekFile    :: FILE_OBJECT -> Int -> Int -> Bytes -> IO Int
1223 #endif
1224
1225 foreign import "libHS_cbits" "seekFileP" unsafe
1226            seekFileP        :: FILE_OBJECT -> IO Int{-ret code-}
1227 foreign import "libHS_cbits" "setTerminalEcho" unsafe
1228            setTerminalEcho  :: FILE_OBJECT -> Int -> IO Int{-ret code-}
1229 foreign import "libHS_cbits" "getTerminalEcho" unsafe
1230            getTerminalEcho  :: FILE_OBJECT -> IO Int{-ret code-}
1231 foreign import "libHS_cbits" "isTerminalDevice" unsafe
1232            isTerminalDevice :: FILE_OBJECT -> IO Int{-ret code-}
1233 foreign import "libHS_cbits" "setConnectedTo" unsafe
1234            setConnectedTo   :: FILE_OBJECT -> FILE_OBJECT -> Int -> IO ()
1235 foreign import "libHS_cbits" "ungetChar" unsafe
1236            ungetChar        :: FILE_OBJECT -> Char -> IO Int{-ret code-}
1237 foreign import "libHS_cbits" "readChunk" unsafe
1238            readChunk        :: FILE_OBJECT -> Addr -> Int -> Int -> IO Int{-ret code-}
1239 foreign import "libHS_cbits" "getFileFd" unsafe
1240            getFileFd        :: FILE_OBJECT -> IO Int{-fd-}
1241 #ifdef __HUGS__
1242 foreign import "libHS_cbits" "fileSize_int64" unsafe
1243            fileSize_int64   :: FILE_OBJECT -> Bytes -> IO Int{-ret code-}
1244 #else
1245 foreign import "libHS_cbits" "fileSize" unsafe
1246            fileSize  :: FILE_OBJECT -> Bytes -> IO Int{-ret code-}
1247 #endif
1248
1249 foreign import "libHS_cbits" "getFilePosn" unsafe
1250            getFilePosn      :: FILE_OBJECT -> IO Int
1251 foreign import "libHS_cbits" "setFilePosn" unsafe
1252            setFilePosn      :: FILE_OBJECT -> Int -> ByteArray# -> IO Int
1253 foreign import "libHS_cbits" "getConnFileFd" unsafe
1254            getConnFileFd    :: FILE_OBJECT -> IO Int{-fd-}
1255 foreign import "libHS_cbits" "getLock" unsafe
1256            getLock  :: Int{-Fd-} -> Int{-exclusive-} -> IO Int{-return code-}
1257 foreign import "libHS_cbits" "openStdFile" unsafe
1258            openStdFile      :: Int{-fd-} -> Int{-Readable?-} -> IO Addr{-file obj-}
1259 foreign import "libHS_cbits" "openFile" unsafe
1260            primOpenFile         :: ByteArray Int{-CString-}
1261                                 -> Int{-How-}
1262                                 -> Int{-Binary-}
1263                                 -> IO Addr {-file obj-}
1264 foreign import "libHS_cbits" "const_BUFSIZ" unsafe
1265            const_BUFSIZ          :: Int
1266
1267 foreign import "libHS_cbits" "setBinaryMode__"
1268            setBinaryMode :: FILE_OBJECT -> Int -> IO Int
1269 \end{code}
1270
1271