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