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