ghc/lib/std/PrelHandle.lhs

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