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