ghc/lib/std/PrelHandle.lhs

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