ghc/lib/std/PrelHandle.lhs

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