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