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 )
  27 import PrelWeak         ( addForeignFinaliser )
  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 Finalisers}
 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             addForeignFinaliser 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             addForeignFinaliser 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             addForeignFinaliser 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         addForeignFinaliser 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           ioe_closedHandle "hClose" handle
 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 finalised. (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             result@(J# _ _ 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 result
 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 (J# _ s# d#) =
 645     wantSeekableHandle "hSeek" handle $ \ handle_ -> do
 646     let fo = haFO__ handle_
 647     rc      <- mayBlock fo (CCALL(seekFile) fo whence (I# s#) d#)  -- ConcHask: UNSAFE, may block
 648 #endif
 649     writeHandle handle handle_
 650     if rc == 0 then
 651        return ()
 652      else
 653         constructErrorAndFail "hSeek"
 654   where
 655     whence :: Int
 656     whence = case mode of
 657                AbsoluteSeek -> 0
 658                RelativeSeek -> 1
 659                SeekFromEnd  -> 2
 660 \end{code}
 661
 662 %*********************************************************
 663 %*                                                      *
 664 \subsection[Query]{Handle Properties}
 665 %*                                                      *
 666 %*********************************************************
 667
 668 A number of operations return information about the properties of a
 669 handle.  Each of these operations returns $True$ if the
 670 handle has the specified property, and $False$
 671 otherwise.
 672
 673 Computation $hIsBlockBuffered hdl$ returns $( False, Nothing )$ if
 674 {\em hdl} is not block-buffered.  Otherwise it returns
 675 $( True, size )$, where {\em size} is $Nothing$ for default buffering, and
 676 $( Just n )$ for block-buffering of {\em n} bytes.
 677
 678 \begin{code}
 679 hIsOpen :: Handle -> IO Bool
 680 hIsOpen handle =
 681     withHandle handle $ \ handle_ -> do
 682     case haType__ handle_ of
 683       ErrorHandle theError -> do
 684           writeHandle handle handle_
 685           ioError theError
 686       ClosedHandle -> do
 687           writeHandle handle handle_
 688           return False
 689       SemiClosedHandle -> do
 690           writeHandle handle handle_
 691           return False
 692       _ -> do
 693           writeHandle handle handle_
 694           return True
 695
 696 hIsClosed :: Handle -> IO Bool
 697 hIsClosed handle =
 698     withHandle handle $ \ handle_ -> do
 699     case haType__ handle_ of
 700       ErrorHandle theError -> do
 701           writeHandle handle handle_
 702           ioError theError
 703       ClosedHandle -> do
 704           writeHandle handle handle_
 705           return True
 706       _ -> do
 707           writeHandle handle handle_
 708           return False
 709
 710 {- not defined, nor exported, but mentioned
 711    here for documentation purposes:
 712
 713     hSemiClosed :: Handle -> IO Bool
 714     hSemiClosed h = do
 715        ho <- hIsOpen h
 716        hc <- hIsClosed h
 717        return (not (ho || hc))
 718 -}
 719
 720 hIsReadable :: Handle -> IO Bool
 721 hIsReadable handle =
 722     withHandle handle $ \ handle_ -> do
 723     case haType__ handle_ of
 724       ErrorHandle theError -> do
 725           writeHandle handle handle_
 726           ioError theError
 727       ClosedHandle -> do
 728           writeHandle handle handle_
 729           ioe_closedHandle "hIsReadable" handle
 730       SemiClosedHandle -> do
 731           writeHandle handle handle_
 732           ioe_closedHandle "hIsReadable" handle
 733       htype -> do
 734           writeHandle handle handle_
 735           return (isReadable htype)
 736   where
 737     isReadable ReadHandle      = True
 738     isReadable ReadWriteHandle = True
 739     isReadable _               = False
 740
 741 hIsWritable :: Handle -> IO Bool
 742 hIsWritable handle =
 743     withHandle handle $ \ handle_ -> do
 744     case haType__ handle_ of
 745       ErrorHandle theError -> do
 746           writeHandle handle handle_
 747           ioError theError
 748       ClosedHandle -> do
 749           writeHandle handle handle_
 750           ioe_closedHandle "hIsWritable" handle
 751       SemiClosedHandle -> do
 752           writeHandle handle handle_
 753           ioe_closedHandle "hIsWritable" handle
 754       htype -> do
 755           writeHandle handle handle_
 756           return (isWritable htype)
 757   where
 758     isWritable AppendHandle    = True
 759     isWritable WriteHandle     = True
 760     isWritable ReadWriteHandle = True
 761     isWritable _               = False
 762
 763
 764 #ifndef __PARALLEL_HASKELL__
 765 getBMode__ :: ForeignObj -> IO (BufferMode, Int)
 766 #else
 767 getBMode__ :: Addr -> IO (BufferMode, Int)
 768 #endif
 769 getBMode__ fo = do
 770   rc <- CCALL(getBufferMode) fo    -- ConcHask: SAFE, won't block
 771   case (rc::Int) of
 772     0  -> return (NoBuffering, 0)
 773     -1 -> return (LineBuffering, default_buffer_size)
 774     -2 -> return (BlockBuffering Nothing, default_buffer_size)
 775     -3 -> return (NoBuffering, 0)               -- only happens on un-stat()able files.
 776     n  -> return (BlockBuffering (Just n), n)
 777  where
 778    default_buffer_size :: Int
 779    default_buffer_size = (const_BUFSIZ - 1)
 780 \end{code}
 781
 782 Querying how a handle buffers its data:
 783
 784 \begin{code}
 785 hGetBuffering :: Handle -> IO BufferMode
 786 hGetBuffering handle =
 787     withHandle handle $ \ handle_ -> do
 788     case haType__ handle_ of
 789       ErrorHandle theError -> do
 790           writeHandle handle handle_
 791           ioError theError
 792       ClosedHandle -> do
 793           writeHandle handle handle_
 794           ioe_closedHandle "hGetBuffering" handle
 795       _ -> do
 796           {-
 797            We're being non-standard here, and allow the buffering
 798            of a semi-closed handle to be queried.   -- sof 6/98
 799           -}
 800           let v = haBufferMode__ handle_
 801           writeHandle handle handle_
 802           return v  -- could be stricter..
 803
 804 \end{code}
 805
 806 \begin{code}
 807 hIsSeekable :: Handle -> IO Bool
 808 hIsSeekable handle =
 809     withHandle handle $ \ handle_ -> do
 810     case haType__ handle_ of
 811       ErrorHandle theError -> do
 812           writeHandle handle handle_
 813           ioError theError
 814       ClosedHandle -> do
 815           writeHandle handle handle_
 816           ioe_closedHandle "hIsSeekable" handle
 817       SemiClosedHandle -> do
 818           writeHandle handle handle_
 819           ioe_closedHandle "hIsSeekable" handle
 820       AppendHandle -> do
 821           writeHandle handle handle_
 822           return False
 823       _ -> do
 824           rc <- CCALL(seekFileP) (haFO__ handle_)   -- ConcHask: SAFE, won't block
 825           writeHandle handle handle_
 826           case (rc::Int) of
 827             0 -> return False
 828             1 -> return True
 829             _ -> constructErrorAndFail "hIsSeekable"
 830 \end{code}
 831
 832
 833 %*********************************************************
 834 %*                                                      *
 835 \subsection{Changing echo status}
 836 %*                                                      *
 837 %*********************************************************
 838
 839 Non-standard GHC extension is to allow the echoing status
 840 of a handles connected to terminals to be reconfigured:
 841
 842 \begin{code}
 843 hSetEcho :: Handle -> Bool -> IO ()
 844 hSetEcho handle on = do
 845     isT   <- hIsTerminalDevice handle
 846     if not isT
 847      then return ()
 848      else
 849       withHandle handle $ \ handle_ -> do
 850       case haType__ handle_ of
 851          ErrorHandle theError ->  do
 852             writeHandle handle handle_
 853             ioError theError
 854          ClosedHandle      ->  do
 855             writeHandle handle handle_
 856             ioe_closedHandle "hSetEcho" handle
 857          _ -> do
 858             rc <- CCALL(setTerminalEcho) (haFO__ handle_) ((if on then 1 else 0)::Int)  -- ConcHask: SAFE, won't block
 859             writeHandle handle handle_
 860             if rc /= ((-1)::Int)
 861              then return ()
 862              else constructErrorAndFail "hSetEcho"
 863
 864 hGetEcho :: Handle -> IO Bool
 865 hGetEcho handle = do
 866     isT   <- hIsTerminalDevice handle
 867     if not isT
 868      then return False
 869      else
 870        withHandle handle $ \ handle_ -> do
 871        case haType__ handle_ of
 872          ErrorHandle theError ->  do
 873             writeHandle handle handle_
 874             ioError theError
 875          ClosedHandle      ->  do
 876             writeHandle handle handle_
 877             ioe_closedHandle "hGetEcho" handle
 878          _ -> do
 879             rc <- CCALL(getTerminalEcho) (haFO__ handle_)  -- ConcHask: SAFE, won't block
 880             writeHandle handle handle_
 881             case (rc::Int) of
 882               1 -> return True
 883               0 -> return False
 884               _ -> constructErrorAndFail "hSetEcho"
 885
 886 hIsTerminalDevice :: Handle -> IO Bool
 887 hIsTerminalDevice handle = do
 888     withHandle handle $ \ handle_ -> do
 889     case haType__ handle_ of
 890        ErrorHandle theError ->  do
 891             writeHandle handle handle_
 892             ioError theError
 893        ClosedHandle        ->  do
 894             writeHandle handle handle_
 895             ioe_closedHandle "hIsTerminalDevice" handle
 896        _ -> do
 897           rc <- CCALL(isTerminalDevice) (haFO__ handle_)   -- ConcHask: SAFE, won't block
 898           writeHandle handle handle_
 899           case (rc::Int) of
 900             1 -> return True
 901             0 -> return False
 902             _ -> constructErrorAndFail "hIsTerminalDevice"
 903 \end{code}
 904
 905 \begin{code}
 906 hConnectTerms :: Handle -> Handle -> IO ()
 907 hConnectTerms hW hR = hConnectHdl_ hW hR 1{-check if they're both coming connected to ttys-}
 908
 909 hConnectTo :: Handle -> Handle -> IO ()
 910 hConnectTo hW hR = hConnectHdl_ hW hR 0{-connect regardless-}
 911
 912 hConnectHdl_ :: Handle -> Handle -> Int -> IO ()
 913 hConnectHdl_ hW hR is_tty =
 914   wantRWHandle "hConnectTo" hW $ \ hW_ -> do
 915   wantRWHandle "hConnectTo" hR $ \ hR_ -> do
 916   CCALL(setConnectedTo) (haFO__ hR_) (haFO__ hW_) is_tty  -- ConcHask: SAFE, won't block
 917   writeHandle hR hR_
 918   writeHandle hW hW_
 919
 920 #ifndef __PARALLEL_HASKELL__
 921 #define FILE_OBJECT     ForeignObj
 922 #else
 923 #define FILE_OBJECT     Addr
 924 #endif
 925
 926 flushConnectedBuf :: FILE_OBJECT -> IO ()
 927 flushConnectedBuf fo = CCALL(flushConnectedBuf) fo
 928 \end{code}
 929
 930 As an extension, we also allow characters to be pushed back.
 931 Like ANSI C stdio, we guarantee no more than one character of
 932 pushback. (For unbuffered channels, the (default) push-back limit is
 933 2 chars tho.)
 934
 935 \begin{code}
 936 hUngetChar :: Handle -> Char -> IO ()
 937 hUngetChar handle c =
 938     wantReadableHandle "hLookAhead" handle $ \ handle_ -> do
 939     rc      <- CCALL(ungetChar) (haFO__ handle_) c  -- ConcHask: SAFE, won't block
 940     writeHandle handle handle_
 941     if rc == ((-1)::Int)
 942      then constructErrorAndFail "hUngetChar"
 943      else return ()
 944
 945 \end{code}
 946
 947
 948 Hoisting files in in one go is sometimes useful, so we support
 949 this as an extension:
 950
 951 \begin{code}
 952 -- in one go, read file into an externally allocated buffer.
 953 slurpFile :: FilePath -> IO (Addr, Int)
 954 slurpFile fname = do
 955   handle <- openFile fname ReadMode
 956   sz     <- hFileSize handle
 957   if sz > toInteger (maxBound::Int) then
 958     ioError (userError "slurpFile: file too big")
 959    else do
 960      let sz_i = fromInteger sz
 961      chunk <- CCALL(allocMemory__) (sz_i::Int)
 962      if chunk == nullAddr
 963       then do
 964         hClose handle
 965         constructErrorAndFail "slurpFile"
 966       else
 967         withHandle handle $ \ handle_ -> do
 968         let fo = haFO__ handle_
 969         rc      <- mayBlock fo (CCALL(readChunk) fo chunk sz_i)    -- ConcHask: UNSAFE, may block.
 970         writeHandle handle handle_
 971         hClose handle
 972         if rc < (0::Int)
 973          then constructErrorAndFail "slurpFile"
 974          else return (chunk, rc)
 975
 976 #ifndef __HUGS__ /* Hugs' Prelude doesn't need this */
 977 hFillBufBA :: Handle -> ByteArray Int -> Int -> IO Int
 978 hFillBufBA handle buf sz
 979   | sz <= 0 = ioError (IOError (Just handle)
 980                             InvalidArgument
 981                             "hFillBufBA"
 982                             ("illegal buffer size " ++ showsPrec 9 sz []))  -- 9 => should be parens'ified.
 983   | otherwise =
 984     wantReadableHandle "hFillBufBA" handle $ \ handle_ -> do
 985     let fo  = haFO__ handle_
 986 #ifdef __HUGS__
 987     rc      <- mayBlock fo (CCALL(readChunkBA) fo buf sz)    -- ConcHask: UNSAFE, may block.
 988 #else
 989     rc      <- mayBlock fo (CCALL(readChunk) fo buf sz)    -- ConcHask: UNSAFE, may block.
 990 #endif
 991     writeHandle handle handle_
 992     if rc >= (0::Int)
 993      then return rc
 994      else constructErrorAndFail "hFillBufBA"
 995 #endif
 996
 997 hFillBuf :: Handle -> Addr -> Int -> IO Int
 998 hFillBuf handle buf sz
 999   | sz <= 0 = ioError (IOError (Just handle)
1000                             InvalidArgument
1001                             "hFillBuf"
1002                             ("illegal buffer size " ++ showsPrec 9 sz []))  -- 9 => should be parens'ified.
1003   | otherwise =
1004     wantReadableHandle "hFillBuf" handle $ \ handle_ -> do
1005     let fo  = haFO__ handle_
1006     rc      <- mayBlock fo (CCALL(readChunk) fo buf sz)    -- ConcHask: UNSAFE, may block.
1007     writeHandle handle handle_
1008     if rc >= 0
1009      then return rc
1010      else constructErrorAndFail "hFillBuf"
1011
1012 \end{code}
1013
1014 The @hPutBuf hdl buf len@ action writes an already packed sequence of
1015 bytes to the file/channel managed by @hdl@ - non-standard.
1016
1017 \begin{code}
1018 hPutBuf :: Handle -> Addr -> Int -> IO ()
1019 hPutBuf handle buf len =
1020     wantWriteableHandle "hPutBuf" handle $ \ handle_ -> do
1021     let fo  = haFO__ handle_
1022     rc      <- mayBlock fo (CCALL(writeBuf) fo buf len)  -- ConcHask: UNSAFE, may block.
1023     writeHandle handle handle_
1024     if rc == (0::Int)
1025      then return ()
1026      else constructErrorAndFail "hPutBuf"
1027
1028 #ifndef __HUGS__ /* An_ one Hugs doesn't provide */
1029 hPutBufBA :: Handle -> ByteArray Int -> Int -> IO ()
1030 hPutBufBA handle buf len =
1031     wantWriteableHandle "hPutBufBA" handle $ \ handle_ -> do
1032     let fo = haFO__ handle_
1033     rc      <- mayBlock fo (CCALL(writeBufBA) fo buf len)  -- ConcHask: UNSAFE, may block.
1034     writeHandle handle handle_
1035     if rc == (0::Int)
1036      then return ()
1037      else constructErrorAndFail "hPutBuf"
1038 #endif
1039 \end{code}
1040
1041 Sometimes it's useful to get at the file descriptor that
1042 the Handle contains..
1043
1044 \begin{code}
1045 getHandleFd :: Handle -> IO Int
1046 getHandleFd handle = do
1047     withHandle handle $ \ handle_ -> do
1048     case (haType__ handle_) of
1049       ErrorHandle theError -> do
1050           writeHandle handle handle_
1051           ioError theError
1052       ClosedHandle -> do
1053           writeHandle handle handle_
1054           ioe_closedHandle "getHandleFd" handle
1055       _ -> do
1056           fd <- CCALL(getFileFd) (haFO__ handle_)
1057           writeHandle handle handle_
1058           return fd
1059 \end{code}
1060
1061
1062 %*********************************************************
1063 %*                                                      *
1064 \subsection{Miscellaneous}
1065 %*                                                      *
1066 %*********************************************************
1067
1068 These three functions are meant to get things out of @IOErrors@.
1069
1070 (ToDo: improve!)
1071
1072 \begin{code}
1073 ioeGetFileName        :: IOError -> Maybe FilePath
1074 ioeGetErrorString     :: IOError -> String
1075 ioeGetHandle          :: IOError -> Maybe Handle
1076
1077 ioeGetHandle   (IOError h _ _ _)   = h
1078 ioeGetErrorString (IOError _ iot _ str) =
1079  case iot of
1080    EOF -> "end of file"
1081    _   -> str
1082
1083 ioeGetFileName (IOError _ _  _ str) =
1084  case span (/=':') str of
1085    (_,[])  -> Nothing
1086    (fs,_)  -> Just fs
1087
1088 \end{code}
1089
1090 A number of operations want to get at a readable or writeable handle, and fail
1091 if it isn't:
1092
1093 \begin{code}
1094 wantReadableHandle :: String -> Handle -> (Handle__ -> IO a) -> IO a
1095 wantReadableHandle fun handle act =
1096     withHandle handle $ \ handle_ -> do
1097     case haType__ handle_ of
1098       ErrorHandle theError -> do
1099           writeHandle handle handle_
1100           ioError theError
1101       ClosedHandle -> do
1102           writeHandle handle handle_
1103           ioe_closedHandle fun handle
1104       SemiClosedHandle -> do
1105           writeHandle handle handle_
1106           ioe_closedHandle fun handle
1107       AppendHandle -> do
1108           writeHandle handle handle_
1109           ioError not_readable_error
1110       WriteHandle -> do
1111           writeHandle handle handle_
1112           ioError not_readable_error
1113       _ -> act handle_
1114   where
1115    not_readable_error =
1116            IOError (Just handle) IllegalOperation fun
1117                    ("handle is not open for reading")
1118
1119 wantWriteableHandle :: String -> Handle -> (Handle__ -> IO a) -> IO a
1120 wantWriteableHandle fun handle act =
1121     withHandle handle $ \ handle_ -> do
1122     case haType__ handle_ of
1123       ErrorHandle theError -> do
1124           writeHandle handle handle_
1125           ioError theError
1126       ClosedHandle -> do
1127           writeHandle handle handle_
1128           ioe_closedHandle fun handle
1129       SemiClosedHandle -> do
1130           writeHandle handle handle_
1131           ioe_closedHandle fun handle
1132       ReadHandle -> do
1133           writeHandle handle handle_
1134           ioError not_writeable_error
1135       _ -> act handle_
1136   where
1137    not_writeable_error =
1138            IOError (Just handle) IllegalOperation fun
1139                    ("handle is not open for writing")
1140
1141 wantRWHandle :: String -> Handle -> (Handle__ -> IO a) -> IO a
1142 wantRWHandle fun handle act =
1143     withHandle handle $ \ handle_ -> do
1144     case haType__ handle_ of
1145       ErrorHandle theError -> do
1146           writeHandle handle handle_
1147           ioError theError
1148       ClosedHandle -> do
1149           writeHandle handle handle_
1150           ioe_closedHandle fun handle
1151       SemiClosedHandle -> do
1152           writeHandle handle handle_
1153           ioe_closedHandle fun handle
1154       _ -> act handle_
1155   where
1156    not_rw_error =
1157            IOError (Just handle) IllegalOperation fun
1158                    ("handle is not open for reading or writing")
1159
1160 wantSeekableHandle :: String -> Handle -> (Handle__ -> IO a) -> IO a
1161 wantSeekableHandle fun handle act =
1162     withHandle handle $ \ handle_ -> do
1163     case haType__ handle_ of
1164       ErrorHandle theError -> do
1165           writeHandle handle handle_
1166           ioError theError
1167       ClosedHandle -> do
1168           writeHandle handle handle_
1169           ioe_closedHandle fun handle
1170       SemiClosedHandle -> do
1171           writeHandle handle handle_
1172           ioe_closedHandle fun handle
1173       AppendHandle -> do
1174           writeHandle handle handle_
1175           ioError not_seekable_error
1176       _ -> act handle_
1177   where
1178    not_seekable_error =
1179            IOError (Just handle)
1180                    IllegalOperation fun
1181                    ("handle is not seekable")
1182
1183 \end{code}
1184
1185 Internal function for creating an @IOError@ representing the
1186 access to a closed file.
1187
1188 \begin{code}
1189 ioe_closedHandle :: String -> Handle -> IO a
1190 ioe_closedHandle fun h = ioError (IOError (Just h) IllegalOperation fun "handle is closed")
1191 \end{code}
1192
1193 Internal helper functions for Concurrent Haskell implementation
1194 of IO:
1195
1196 \begin{code}
1197 #ifndef __PARALLEL_HASKELL__
1198 mayBlock :: ForeignObj -> IO Int -> IO Int
1199 #else
1200 mayBlock :: Addr  -> IO Int -> IO Int
1201 #endif
1202
1203 #ifndef notyet /*__CONCURRENT_HASKELL__*/
1204 mayBlock  _ act = act
1205 #else
1206 mayBlock fo act = do
1207    rc <- act
1208    case rc of
1209      -5 -> do  -- (possibly blocking) read
1210         fd <- CCALL(getFileFd) fo
1211         threadWaitRead fd
1212         CCALL(clearNonBlockingIOFlag__) fo  -- force read to happen this time.
1213         mayBlock fo act  -- input available, re-try
1214      -6 -> do  -- (possibly blocking) write
1215         fd <- CCALL(getFileFd) fo
1216         threadWaitWrite fd
1217         CCALL(clearNonBlockingIOFlag__) fo  -- force write to happen this time.
1218         mayBlock fo act  -- output possible
1219      -7 -> do  -- (possibly blocking) write on connected handle
1220         fd <- CCALL(getConnFileFd) fo
1221         threadWaitWrite fd
1222         CCALL(clearConnNonBlockingIOFlag__) fo  -- force write to happen this time.
1223         mayBlock fo act  -- output possible
1224      _ -> do
1225         CCALL(setNonBlockingIOFlag__) fo      -- reset file object.
1226         CCALL(setConnNonBlockingIOFlag__) fo  -- reset (connected) file object.
1227         return rc
1228
1229 #endif
1230
1231 -- #ifdef __HUGS__
1232 #if 1
1233 threadDelay, threadWaitRead, threadWaitWrite :: Int -> IO ()
1234
1235 -- Hugs does actually have the primops needed to implement these
1236 -- but, like GHC, the primops don't actually do anything...
1237 threadDelay     _ = return ()
1238 threadWaitRead  _ = return ()
1239 threadWaitWrite _ = return ()
1240 #endif
1241
1242 \end{code}
1243
1244
1245 \begin{code}
1246 #ifdef __HUGS__
1247 type FD           = Int
1248 type Exclusive    = Int  -- really Bool
1249 type How          = Int
1250 type Binary       = Int
1251 type OpenStdFlags = Int
1252 type OpenFlags    = Int
1253 type Readable     = Int  -- really Bool
1254 type Flush        = Int  -- really Bool
1255 type RC           = Int  -- standard return code
1256
1257 type IOFileAddr   = Addr  -- as returned from functions
1258 type CString      = PrimByteArray
1259 type Bytes        = PrimMutableByteArray RealWorld
1260
1261 #ifndef __PARALLEL_HASKELL__
1262 type FILE_OBJ  = ForeignObj -- as passed into functions
1263 #else
1264 type FILE_OBJ  = Addr
1265 #endif
1266
1267 foreign import ccall "libHS_cbits.so" "setBuf"                unsafe prim_setBuf           :: FILE_OBJ -> Addr -> Int -> IO ()
1268 foreign import ccall "libHS_cbits.so" "getBufSize"            unsafe prim_getBufSize       :: FILE_OBJ -> IO Int
1269 foreign import ccall "libHS_cbits.so" "inputReady"            unsafe prim_inputReady       :: FILE_OBJ -> Int -> IO RC
1270 foreign import ccall "libHS_cbits.so" "fileGetc"              unsafe prim_fileGetc         :: FILE_OBJ -> IO Int
1271 foreign import ccall "libHS_cbits.so" "fileLookAhead"         unsafe prim_fileLookAhead    :: FILE_OBJ -> IO Int
1272 foreign import ccall "libHS_cbits.so" "readBlock"             unsafe prim_readBlock        :: FILE_OBJ -> IO Int
1273 foreign import ccall "libHS_cbits.so" "readLine"              unsafe prim_readLine         :: FILE_OBJ -> IO Int
1274 foreign import ccall "libHS_cbits.so" "readChar"              unsafe prim_readChar         :: FILE_OBJ -> IO Int
1275 foreign import ccall "libHS_cbits.so" "writeFileObject"       unsafe prim_writeFileObject  :: FILE_OBJ -> Int -> IO RC
1276 foreign import ccall "libHS_cbits.so" "filePutc"              unsafe prim_filePutc         :: FILE_OBJ -> Char -> IO RC
1277 foreign import ccall "libHS_cbits.so" "getBufStart"           unsafe prim_getBufStart      :: FILE_OBJ -> Int -> IO Addr
1278 foreign import ccall "libHS_cbits.so" "getWriteableBuf"       unsafe prim_getWriteableBuf  :: FILE_OBJ -> IO Addr
1279 foreign import ccall "libHS_cbits.so" "getBufWPtr"            unsafe prim_getBufWPtr       :: FILE_OBJ -> IO Int
1280 foreign import ccall "libHS_cbits.so" "setBufWPtr"            unsafe prim_setBufWPtr       :: FILE_OBJ -> Int -> IO ()
1281 foreign import ccall "libHS_cbits.so" "closeFile"             unsafe prim_closeFile        :: FILE_OBJ -> Flush -> IO RC
1282 foreign import ccall "libHS_cbits.so" "fileEOF"               unsafe prim_fileEOF           :: FILE_OBJ -> IO RC
1283 foreign import ccall "libHS_cbits.so" "setBuffering"          unsafe prim_setBuffering      :: FILE_OBJ -> Int -> IO RC
1284 foreign import ccall "libHS_cbits.so" "flushFile"             unsafe prim_flushFile         :: FILE_OBJ -> IO RC
1285 foreign import ccall "libHS_cbits.so" "flushConnectedBuf"     unsafe prim_flushConnectedBuf :: FILE_OBJ -> IO RC
1286 foreign import ccall "libHS_cbits.so" "getBufferMode"         unsafe prim_getBufferMode     :: FILE_OBJ -> IO RC
1287 foreign import ccall "libHS_cbits.so" "seekFile_int64"        unsafe prim_seekFile_int64    :: FILE_OBJ -> Int -> Int64 -> IO RC
1288 foreign import ccall "libHS_cbits.so" "seekFileP"             unsafe prim_seekFileP        :: FILE_OBJ -> IO RC
1289 foreign import ccall "libHS_cbits.so" "setTerminalEcho"       unsafe prim_setTerminalEcho  :: FILE_OBJ -> Int -> IO RC
1290 foreign import ccall "libHS_cbits.so" "getTerminalEcho"       unsafe prim_getTerminalEcho  :: FILE_OBJ -> IO RC
1291 foreign import ccall "libHS_cbits.so" "isTerminalDevice"      unsafe prim_isTerminalDevice :: FILE_OBJ -> IO RC
1292 foreign import ccall "libHS_cbits.so" "setConnectedTo"        unsafe prim_setConnectedTo   :: FILE_OBJ -> FILE_OBJ -> Int -> IO ()
1293 foreign import ccall "libHS_cbits.so" "ungetChar"             unsafe prim_ungetChar        :: FILE_OBJ -> Char -> IO RC
1294 foreign import ccall "libHS_cbits.so" "readChunk"             unsafe prim_readChunk        :: FILE_OBJ -> Addr          -> Int -> IO RC
1295 foreign import ccall "libHS_cbits.so" "writeBuf"              unsafe prim_writeBuf         :: FILE_OBJ -> Addr -> Int -> IO RC
1296 foreign import ccall "libHS_cbits.so" "getFileFd"             unsafe prim_getFileFd        :: FILE_OBJ -> IO FD
1297 foreign import ccall "libHS_cbits.so" "fileSize_int64"        unsafe prim_fileSize_int64   :: FILE_OBJ -> Bytes -> IO RC
1298 foreign import ccall "libHS_cbits.so" "getFilePosn"           unsafe prim_getFilePosn      :: FILE_OBJ -> IO Int
1299 foreign import ccall "libHS_cbits.so" "setFilePosn"           unsafe prim_setFilePosn      :: FILE_OBJ -> Int -> IO Int
1300 foreign import ccall "libHS_cbits.so" "getConnFileFd"         unsafe prim_getConnFileFd    :: FILE_OBJ -> IO FD
1301 foreign import ccall "libHS_cbits.so" "allocMemory__"         unsafe prim_allocMemory__    :: Int -> IO Addr
1302 foreign import ccall "libHS_cbits.so" "getLock"               unsafe prim_getLock          :: FD -> Exclusive -> IO RC
1303 foreign import ccall "libHS_cbits.so" "openStdFile"           unsafe prim_openStdFile      :: FD -> OpenStdFlags -> Readable -> IO IOFileAddr
1304 foreign import ccall "libHS_cbits.so" "openFile"              unsafe prim_openFile         :: CString -> How -> Binary -> OpenFlags -> IO IOFileAddr
1305 foreign import ccall "libHS_cbits.so" "freeFileObject"        unsafe prim_freeFileObject    :: FILE_OBJ -> IO ()
1306 foreign import ccall "libHS_cbits.so" "freeStdFileObject"     unsafe prim_freeStdFileObject :: FILE_OBJ -> IO ()
1307 foreign import ccall "libHS_cbits.so" "const_BUFSIZ"          unsafe const_BUFSIZ          :: Int
1308
1309 foreign import ccall "libHS_cbits.so" "setConnNonBlockingIOFlag__"   unsafe prim_setConnNonBlockingIOFlag__   :: FILE_OBJ -> IO ()
1310 foreign import ccall "libHS_cbits.so" "clearConnNonBlockingIOFlag__" unsafe prim_clearConnNonBlockingIOFlag__ :: FILE_OBJ -> IO ()
1311 foreign import ccall "libHS_cbits.so" "setNonBlockingIOFlag__"       unsafe prim_setNonBlockingIOFlag__       :: FILE_OBJ -> IO ()
1312 foreign import ccall "libHS_cbits.so" "clearNonBlockingIOFlag__"     unsafe prim_clearNonBlockingIOFlag__     :: FILE_OBJ -> IO ()
1313
1314 foreign import ccall "libHS_cbits.so" "getErrStr__"  unsafe prim_getErrStr__  :: IO Addr
1315 foreign import ccall "libHS_cbits.so" "getErrNo__"   unsafe prim_getErrNo__   :: IO Int
1316 foreign import ccall "libHS_cbits.so" "getErrType__" unsafe prim_getErrType__ :: IO Int
1317
1318 #endif
1319 \end{code}
1320
1321