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