2 % (c) The AQUA Project, Glasgow University, 1994-1996
5 \section[PrelHandle]{Module @PrelHandle@}
7 This module defines Haskell {\em handles} and the basic operations
8 which are supported for them.
11 {-# OPTIONS -fno-implicit-prelude -#include "cbits/stgio.h" #-}
12 #include "cbits/error.h"
14 #ifndef __HUGS__ /* Hugs just includes this in PreludeBuiltin so no header needed */
15 module PrelHandle where
18 import PrelAddr ( Addr, nullAddr )
19 import PrelArr ( newVar, readVar, writeVar, ByteArray(..) )
20 import PrelRead ( Read )
21 import PrelList ( span )
24 import PrelMaybe ( Maybe(..) )
28 import PrelAddr ( Addr, nullAddr )
29 import PrelNum ( toInteger, toBig )
30 import PrelPack ( packString )
31 import PrelWeak ( addForeignFinalizer )
34 #if __CONCURRENT_HASKELL__
38 #ifndef __PARALLEL_HASKELL__
39 import PrelForeign ( makeForeignObj )
42 #endif /* ndef(__HUGS__) */
45 #define cat2(x,y) x##y
46 #define CCALL(fun) cat2(prim_,fun)
47 #define __CONCURRENT_HASKELL__
49 #define sizeof_int64 8
51 #define CCALL(fun) _ccall_ fun
52 #define const_BUFSIZ ``BUFSIZ''
53 #define primPackString
56 #ifndef __PARALLEL_HASKELL__
57 #define FILE_OBJECT ForeignObj
59 #define FILE_OBJECT Addr
63 %*********************************************************
65 \subsection{Types @Handle@, @Handle__@}
67 %*********************************************************
69 The @Handle@ and @Handle__@ types are defined in @IOBase@.
72 {-# INLINE newHandle #-}
73 {-# INLINE withHandle #-}
74 newHandle :: Handle__ -> IO Handle
76 #if defined(__CONCURRENT_HASKELL__)
78 -- Use MVars for concurrent Haskell
79 newHandle hc = newMVar hc >>= \ h ->
83 -- Use ordinary MutableVars for non-concurrent Haskell
84 newHandle hc = stToIO (newVar hc >>= \ h ->
89 %*********************************************************
91 \subsection{@withHandle@ operations}
93 %*********************************************************
95 In the concurrent world, handles are locked during use. This is done
96 by wrapping an MVar around the handle which acts as a mutex over
97 operations on the handle.
99 To avoid races, we use the following bracketing operations. The idea
100 is to obtain the lock, do some operation and replace the lock again,
101 whether the operation succeeded or failed. We also want to handle the
102 case where the thread receives an exception while processing the IO
103 operation: in these cases we also want to relinquish the lock.
105 There are three versions of @withHandle@: corresponding to the three
106 possible combinations of:
108 - the operation may side-effect the handle
109 - the operation may return a result
111 If the operation generates an error or an exception is raised, the
112 orignal handle is always replaced [ this is the case at the moment,
113 but we might want to revisit this in the future --SDM ].
116 #ifdef __CONCURRENT_HASKELL__
117 withHandle :: Handle -> (Handle__ -> IO (Handle__,a)) -> IO a
118 withHandle (Handle h) act = do
120 (h',v) <- catchException (act h_) (\ ex -> putMVar h h_ >> throw ex)
124 withHandle_ :: Handle -> (Handle__ -> IO a) -> IO a
125 withHandle_ (Handle h) act = do
127 v <- catchException (act h_) (\ ex -> putMVar h h_ >> throw ex)
131 withHandle__ :: Handle -> (Handle__ -> IO Handle__) -> IO ()
132 withHandle__ (Handle h) act = do
134 h' <- catchException (act h_) (\ ex -> putMVar h h_ >> throw ex)
139 -- of questionable value to install this exception
140 -- handler, but let's do it in the non-concurrent
141 -- case too, for now.
142 withHandle (Handle h) act = do
143 h_ <- stToIO (readVar h)
144 v <- catchException (act h_) (\ ex -> stToIO (writeVar h h_) >> throw ex)
150 nullFile__ is only used for closed handles, plugging it in as a null
151 file object reference.
154 nullFile__ :: FILE_OBJECT
156 #ifndef __PARALLEL_HASKELL__
157 unsafePerformIO (makeForeignObj nullAddr)
163 mkClosedHandle__ :: Handle__
171 mkErrorHandle__ :: IOError -> Handle__
172 mkErrorHandle__ ioe =
180 %*********************************************************
182 \subsection{Handle Finalizers}
184 %*********************************************************
188 freeStdFileObject :: ForeignObj -> IO ()
189 freeStdFileObject fo = CCALL(freeStdFileObject) fo
191 freeFileObject :: ForeignObj -> IO ()
192 freeFileObject fo = CCALL(freeFileObject) fo
194 foreign import stdcall "libHS_cbits.so" "freeStdFileObject" freeStdFileObject :: ForeignObj -> IO ()
195 foreign import stdcall "libHS_cbits.so" "freeFileObject" freeFileObject :: ForeignObj -> IO ()
199 %*********************************************************
201 \subsection[StdHandles]{Standard handles}
203 %*********************************************************
205 Three handles are allocated during program initialisation. The first
206 two manage input or output from the Haskell program's standard input
207 or output channel respectively. The third manages output to the
208 standard error channel. These handles are initially open.
212 stdin, stdout, stderr :: Handle
214 stdout = unsafePerformIO (do
215 rc <- CCALL(getLock) (1::Int) (1::Int) -- ConcHask: SAFE, won't block
217 0 -> newHandle (mkClosedHandle__)
219 #ifndef __CONCURRENT_HASKELL__
220 fo <- CCALL(openStdFile) (1::Int)
221 (1::Int){-flush on close-}
222 (0::Int){-writeable-} -- ConcHask: SAFE, won't block
224 fo <- CCALL(openStdFile) (1::Int)
225 ((1{-flush on close-} {-+ 128 don't block on I/O-})::Int)
226 (0::Int){-writeable-} -- ConcHask: SAFE, won't block
228 -- NOTE: turn off non-blocking I/O until
229 -- we've got proper support for threadWait{Read,Write}
231 #ifndef __PARALLEL_HASKELL__
232 fo <- makeForeignObj fo
233 addForeignFinalizer fo (freeStdFileObject fo)
237 /* I dont care what the Haskell report says, in an interactive system,
238 * stdout should be unbuffered by default.
242 (bm, bf_size) <- getBMode__ fo
243 mkBuffer__ fo bf_size
245 hdl <- newHandle (Handle__ fo WriteHandle bm "stdout")
246 -- when stdin and stdout are both connected to a terminal, ensure
247 -- that anything buffered on stdout is flushed prior to reading from stdin.
249 hConnectTerms hdl stdin
250 -- when stderr and stdout are both connected to a terminal, ensure
251 -- that anything buffered on stdout is flushed prior to writing to
253 hConnectTo hdl stderr
255 _ -> do ioError <- constructError "stdout"
256 newHandle (mkErrorHandle__ ioError)
259 stdin = unsafePerformIO (do
260 rc <- CCALL(getLock) (0::Int) (0::Int) -- ConcHask: SAFE, won't block
262 0 -> newHandle (mkClosedHandle__)
264 #ifndef __CONCURRENT_HASKELL__
265 fo <- CCALL(openStdFile) (0::Int)
266 (0::Int){-don't flush on close -}
267 (1::Int){-readable-} -- ConcHask: SAFE, won't block
269 fo <- CCALL(openStdFile) (0::Int)
270 ((0{-flush on close-} {-+ 128 don't block on I/O-})::Int)
271 (1::Int){-readable-} -- ConcHask: SAFE, won't block
274 #ifndef __PARALLEL_HASKELL__
275 fo <- makeForeignObj fo
276 addForeignFinalizer fo (freeStdFileObject fo)
278 (bm, bf_size) <- getBMode__ fo
279 mkBuffer__ fo bf_size
280 newHandle (Handle__ fo ReadHandle bm "stdin")
281 _ -> do ioError <- constructError "stdin"
282 newHandle (mkErrorHandle__ ioError)
286 stderr = unsafePerformIO (do
287 rc <- CCALL(getLock) (2::Int) (1::Int){-writeable-} -- ConcHask: SAFE, won't block
289 0 -> newHandle (mkClosedHandle__)
291 #ifndef __CONCURRENT_HASKELL__
292 fo <- CCALL(openStdFile) (2::Int)
293 (1::Int){-flush on close-}
294 (0::Int){-writeable-} -- ConcHask: SAFE, won't block
296 fo <- CCALL(openStdFile) (2::Int)
297 ((1{-flush on close-} {- + 128 don't block on I/O-})::Int)
298 (0::Int){-writeable-} -- ConcHask: SAFE, won't block
301 #ifndef __PARALLEL_HASKELL__
302 fo <- makeForeignObj fo
303 addForeignFinalizer fo (freeStdFileObject fo)
305 newHandle (Handle__ fo WriteHandle NoBuffering "stderr")
307 _ -> do ioError <- constructError "stderr"
308 newHandle (mkErrorHandle__ ioError)
312 %*********************************************************
314 \subsection[OpeningClosing]{Opening and Closing Files}
316 %*********************************************************
319 data IOMode = ReadMode | WriteMode | AppendMode | ReadWriteMode
320 deriving (Eq, Ord, Ix, Enum, Read, Show)
325 deriving (Eq, Read, Show)
327 openFile :: FilePath -> IOMode -> IO Handle
328 openFile fp im = openFileEx fp (TextMode im)
330 openFileEx :: FilePath -> IOModeEx -> IO Handle
333 fo <- CCALL(openFile) (primPackString f) (file_mode::Int)
335 (file_flags::Int) -- ConcHask: SAFE, won't block
336 if fo /= nullAddr then do
337 #ifndef __PARALLEL_HASKELL__
338 fo <- makeForeignObj fo
339 addForeignFinalizer fo (freeFileObject fo)
341 (bm, bf_size) <- getBMode__ fo
342 mkBuffer__ fo bf_size
343 newHandle (Handle__ fo htype bm f)
345 constructErrorAndFailWithInfo "openFile" f
349 BinaryMode bmo -> (bmo, 1)
350 TextMode tmo -> (tmo, 0)
352 #ifndef __CONCURRENT_HASKELL__
353 file_flags = file_flags'
355 -- See comment next to 'stderr' for why we leave
356 -- non-blocking off for now.
357 file_flags = file_flags' {-+ 128 Don't block on I/O-}
360 (file_flags', file_mode) =
365 ReadWriteMode -> (1, 3)
368 ReadMode -> ReadHandle
369 WriteMode -> WriteHandle
370 AppendMode -> AppendHandle
371 ReadWriteMode -> ReadWriteHandle
374 Computation $openFile file mode$ allocates and returns a new, open
375 handle to manage the file {\em file}. It manages input if {\em mode}
376 is $ReadMode$, output if {\em mode} is $WriteMode$ or $AppendMode$,
377 and both input and output if mode is $ReadWriteMode$.
379 If the file does not exist and it is opened for output, it should be
380 created as a new file. If {\em mode} is $WriteMode$ and the file
381 already exists, then it should be truncated to zero length. The
382 handle is positioned at the end of the file if {\em mode} is
383 $AppendMode$, and otherwise at the beginning (in which case its
384 internal position is 0).
386 Implementations should enforce, locally to the Haskell process,
387 multiple-reader single-writer locking on files, which is to say that
388 there may either be many handles on the same file which manage input,
389 or just one handle on the file which manages output. If any open or
390 semi-closed handle is managing a file for output, no new handle can be
391 allocated for that file. If any open or semi-closed handle is
392 managing a file for input, new handles can only be allocated if they
393 do not manage output.
395 Two files are the same if they have the same absolute name. An
396 implementation is free to impose stricter conditions.
399 hClose :: Handle -> IO ()
402 withHandle__ handle $ \ handle_ -> do
403 case haType__ handle_ of
404 ErrorHandle theError -> ioError theError
405 ClosedHandle -> return handle_
407 rc <- CCALL(closeFile) (haFO__ handle_) (1::Int){-flush if you can-} -- ConcHask: SAFE, won't block
408 {- We explicitly close a file object so that we can be told
409 if there were any errors. Note that after @hClose@
410 has been performed, the ForeignObj embedded in the Handle
411 is still lying around in the heap, so care is taken
412 to avoid closing the file object when the ForeignObj
413 is finalized. (we overwrite the file ptr in the underlying
414 FileObject with a NULL as part of closeFile())
417 then return (handle_{ haType__ = ClosedHandle,
418 haFO__ = nullFile__ })
419 else constructErrorAndFail "hClose"
423 Computation $hClose hdl$ makes handle {\em hdl} closed. Before the
424 computation finishes, any items buffered for output and not already
425 sent to the operating system are flushed as for $flush$.
427 %*********************************************************
429 \subsection[EOF]{Detecting the End of Input}
431 %*********************************************************
434 For a handle {\em hdl} which attached to a physical file, $hFileSize
435 hdl$ returns the size of {\em hdl} in terms of the number of items
436 which can be read from {\em hdl}.
439 hFileSize :: Handle -> IO Integer
441 withHandle_ handle $ \ handle_ -> do
442 case haType__ handle_ of
443 ErrorHandle theError -> ioError theError
444 ClosedHandle -> ioe_closedHandle "hFileSize" handle
445 SemiClosedHandle -> ioe_closedHandle "hFileSize" handle
448 mem <- primNewByteArray sizeof_int64
449 rc <- CCALL(fileSize_int64) (haFO__ handle_) mem -- ConcHask: SAFE, won't block
451 result <- primReadInt64Array mem 0
452 return (primInt64ToInteger result)
454 constructErrorAndFail "hFileSize"
457 -- HACK! We build a unique MP_INT of the right shape to hold
458 -- a single unsigned word, and we let the C routine
459 -- change the data bits
461 -- For some reason, this fails to typecheck if converted to a do
463 _casm_ ``%r = 1;'' >>= \(I# hack#) ->
464 case int2Integer# hack# of
466 rc <- CCALL(fileSize) (haFO__ handle_) d -- ConcHask: SAFE, won't block
467 if rc == (0::Int) then
470 constructErrorAndFail "hFileSize"
474 For a readable handle {\em hdl}, @hIsEOF hdl@ returns
475 @True@ if no further input can be taken from @hdl@ or for a
476 physical file, if the current I/O position is equal to the length of
477 the file. Otherwise, it returns @False@.
480 hIsEOF :: Handle -> IO Bool
482 wantReadableHandle "hIsEOF" handle $ \ handle_ -> do
483 let fo = haFO__ handle_
484 rc <- mayBlock fo (CCALL(fileEOF) fo) -- ConcHask: UNSAFE, may block
488 _ -> constructErrorAndFail "hIsEOF"
494 %*********************************************************
496 \subsection[Buffering]{Buffering Operations}
498 %*********************************************************
500 Three kinds of buffering are supported: line-buffering,
501 block-buffering or no-buffering. See @IOBase@ for definition
502 and further explanation of what the type represent.
504 Computation @hSetBuffering hdl mode@ sets the mode of buffering for
505 handle {\em hdl} on subsequent reads and writes.
509 If {\em mode} is @LineBuffering@, line-buffering should be
512 If {\em mode} is @BlockBuffering@ {\em size}, then block-buffering
513 should be enabled if possible. The size of the buffer is {\em n} items
514 if {\em size} is @Just@~{\em n} and is otherwise implementation-dependent.
516 If {\em mode} is @NoBuffering@, then buffering is disabled if possible.
519 If the buffer mode is changed from @BlockBuffering@ or @LineBuffering@
520 to @NoBuffering@, then any items in the output buffer are written to
521 the device, and any items in the input buffer are discarded. The
522 default buffering mode when a handle is opened is
523 implementation-dependent and may depend on the object which is
524 attached to that handle.
527 hSetBuffering :: Handle -> BufferMode -> IO ()
529 hSetBuffering handle mode =
531 BlockBuffering (Just n)
533 (IOError (Just handle)
536 ("illegal buffer size " ++ showsPrec 9 n [])) -- 9 => should be parens'ified.
538 withHandle__ handle $ \ handle_ -> do
539 case haType__ handle_ of
540 ErrorHandle theError -> ioError theError
541 ClosedHandle -> ioe_closedHandle "hSetBuffering" handle
544 - we flush the old buffer regardless of whether
545 the new buffer could fit the contents of the old buffer
547 - allow a handle's buffering to change even if IO has
548 occurred (ANSI C spec. does not allow this, nor did
549 the previous implementation of IO.hSetBuffering).
550 - a non-standard extension is to allow the buffering
551 of semi-closed handles to change [sof 6/98]
553 let fo = haFO__ handle_
554 rc <- mayBlock fo (CCALL(setBuffering) fo bsize) -- ConcHask: UNSAFE, may block
557 return (handle_{ haBufferMode__ = mode })
559 -- Note: failure to change the buffer size will cause old buffer to be flushed.
560 constructErrorAndFail "hSetBuffering"
566 BlockBuffering Nothing -> -2
567 BlockBuffering (Just n) -> n
570 The action @hFlush hdl@ causes any items buffered for output
571 in handle {\em hdl} to be sent immediately to the operating
575 hFlush :: Handle -> IO ()
577 wantWriteableHandle "hFlush" handle $ \ handle_ -> do
578 let fo = haFO__ handle_
579 rc <- mayBlock fo (CCALL(flushFile) fo) -- ConcHask: UNSAFE, may block
583 constructErrorAndFail "hFlush"
588 %*********************************************************
590 \subsection[Seeking]{Repositioning Handles}
592 %*********************************************************
597 Handle -- Q: should this be a weak or strong ref. to the handle?
600 data SeekMode = AbsoluteSeek | RelativeSeek | SeekFromEnd
601 deriving (Eq, Ord, Ix, Enum, Read, Show)
604 Computation @hGetPosn hdl@ returns the current I/O
605 position of {\em hdl} as an abstract position. Computation
606 $hSetPosn p$ sets the position of {\em hdl}
607 to a previously obtained position {\em p}.
610 hGetPosn :: Handle -> IO HandlePosn
612 wantSeekableHandle "hGetPosn" handle $ \ handle_ -> do
613 posn <- CCALL(getFilePosn) (haFO__ handle_) -- ConcHask: SAFE, won't block
614 if posn /= -1 then do
615 return (HandlePosn handle posn)
617 constructErrorAndFail "hGetPosn"
619 hSetPosn :: HandlePosn -> IO ()
620 hSetPosn (HandlePosn handle posn) =
621 wantSeekableHandle "hSetPosn" handle $ \ handle_ -> do -- not as silly as it looks: the handle may have been closed in the meantime.
622 let fo = haFO__ handle_
623 rc <- mayBlock fo (CCALL(setFilePosn) fo posn) -- ConcHask: UNSAFE, may block
627 constructErrorAndFail "hSetPosn"
630 The action @hSeek hdl mode i@ sets the position of handle
631 @hdl@ depending on @mode@. If @mode@ is
633 \item[{\bf AbsoluteSeek}] The position of @hdl@ is set to @i@.
634 \item[{\bf RelativeSeek}] The position of @hdl@ is set to offset @i@ from
635 the current position.
636 \item[{\bf SeekFromEnd}] The position of @hdl@ is set to offset @i@ from
640 Some handles may not be seekable (see @hIsSeekable@), or only support a
641 subset of the possible positioning operations (e.g. it may only be
642 possible to seek to the end of a tape, or to a positive offset from
643 the beginning or current position).
645 It is not possible to set a negative I/O position, or for a physical
646 file, an I/O position beyond the current end-of-file.
649 - when seeking using @SeekFromEnd@, positive offsets (>=0) means seeking
651 - relative seeking on buffered handles can lead to non-obvious results.
654 hSeek :: Handle -> SeekMode -> Integer -> IO ()
656 hSeek handle mode offset =
657 wantSeekableHandle "hSeek" handle $ \ handle_ -> do
658 let fo = haFO__ handle_
659 rc <- mayBlock fo (CCALL(seekFile_int64) fo whence (primIntegerToInt64 offset)) -- ConcHask: UNSAFE, may block
661 hSeek handle mode i@(S# _) = hSeek handle mode (toBig i)
662 hSeek handle mode (J# s# d#) =
663 wantSeekableHandle "hSeek" handle $ \ handle_ -> do
664 let fo = haFO__ handle_
665 rc <- mayBlock fo (CCALL(seekFile) fo whence (I# s#) d#) -- ConcHask: UNSAFE, may block
670 constructErrorAndFail "hSeek"
673 whence = case mode of
679 %*********************************************************
681 \subsection[Query]{Handle Properties}
683 %*********************************************************
685 A number of operations return information about the properties of a
686 handle. Each of these operations returns $True$ if the
687 handle has the specified property, and $False$
690 Computation $hIsBlockBuffered hdl$ returns $( False, Nothing )$ if
691 {\em hdl} is not block-buffered. Otherwise it returns
692 $( True, size )$, where {\em size} is $Nothing$ for default buffering, and
693 $( Just n )$ for block-buffering of {\em n} bytes.
696 hIsOpen :: Handle -> IO Bool
698 withHandle_ handle $ \ handle_ -> do
699 case haType__ handle_ of
700 ErrorHandle theError -> ioError theError
701 ClosedHandle -> return False
702 SemiClosedHandle -> return False
705 hIsClosed :: Handle -> IO Bool
707 withHandle_ handle $ \ handle_ -> do
708 case haType__ handle_ of
709 ErrorHandle theError -> ioError theError
710 ClosedHandle -> return True
713 {- not defined, nor exported, but mentioned
714 here for documentation purposes:
716 hSemiClosed :: Handle -> IO Bool
720 return (not (ho || hc))
723 hIsReadable :: Handle -> IO Bool
725 withHandle_ handle $ \ handle_ -> do
726 case haType__ handle_ of
727 ErrorHandle theError -> ioError theError
728 ClosedHandle -> ioe_closedHandle "hIsReadable" handle
729 SemiClosedHandle -> ioe_closedHandle "hIsReadable" handle
730 htype -> return (isReadable htype)
732 isReadable ReadHandle = True
733 isReadable ReadWriteHandle = True
736 hIsWritable :: Handle -> IO Bool
738 withHandle_ handle $ \ handle_ -> do
739 case haType__ handle_ of
740 ErrorHandle theError -> ioError theError
741 ClosedHandle -> ioe_closedHandle "hIsWritable" handle
742 SemiClosedHandle -> ioe_closedHandle "hIsWritable" handle
743 htype -> return (isWritable htype)
745 isWritable AppendHandle = True
746 isWritable WriteHandle = True
747 isWritable ReadWriteHandle = True
751 #ifndef __PARALLEL_HASKELL__
752 getBMode__ :: ForeignObj -> IO (BufferMode, Int)
754 getBMode__ :: Addr -> IO (BufferMode, Int)
757 rc <- CCALL(getBufferMode) fo -- ConcHask: SAFE, won't block
759 0 -> return (NoBuffering, 0)
760 -1 -> return (LineBuffering, default_buffer_size)
761 -2 -> return (BlockBuffering Nothing, default_buffer_size)
762 -3 -> return (NoBuffering, 0) -- only happens on un-stat()able files.
763 n -> return (BlockBuffering (Just n), n)
765 default_buffer_size :: Int
766 default_buffer_size = (const_BUFSIZ - 1)
769 Querying how a handle buffers its data:
772 hGetBuffering :: Handle -> IO BufferMode
773 hGetBuffering handle =
774 withHandle_ handle $ \ handle_ -> do
775 case haType__ handle_ of
776 ErrorHandle theError -> ioError theError
777 ClosedHandle -> ioe_closedHandle "hGetBuffering" handle
780 We're being non-standard here, and allow the buffering
781 of a semi-closed handle to be queried. -- sof 6/98
783 return (haBufferMode__ handle_) -- could be stricter..
787 hIsSeekable :: Handle -> IO Bool
789 withHandle_ handle $ \ handle_ -> do
790 case haType__ handle_ of
791 ErrorHandle theError -> ioError theError
792 ClosedHandle -> ioe_closedHandle "hIsSeekable" handle
793 SemiClosedHandle -> ioe_closedHandle "hIsSeekable" handle
794 AppendHandle -> return False
796 rc <- CCALL(seekFileP) (haFO__ handle_) -- ConcHask: SAFE, won't block
800 _ -> constructErrorAndFail "hIsSeekable"
804 %*********************************************************
806 \subsection{Changing echo status}
808 %*********************************************************
810 Non-standard GHC extension is to allow the echoing status
811 of a handles connected to terminals to be reconfigured:
814 hSetEcho :: Handle -> Bool -> IO ()
815 hSetEcho handle on = do
816 isT <- hIsTerminalDevice handle
820 withHandle_ handle $ \ handle_ -> do
821 case haType__ handle_ of
822 ErrorHandle theError -> ioError theError
823 ClosedHandle -> ioe_closedHandle "hSetEcho" handle
825 rc <- CCALL(setTerminalEcho) (haFO__ handle_) ((if on then 1 else 0)::Int) -- ConcHask: SAFE, won't block
828 else constructErrorAndFail "hSetEcho"
830 hGetEcho :: Handle -> IO Bool
832 isT <- hIsTerminalDevice handle
836 withHandle_ handle $ \ handle_ -> do
837 case haType__ handle_ of
838 ErrorHandle theError -> ioError theError
839 ClosedHandle -> ioe_closedHandle "hGetEcho" handle
841 rc <- CCALL(getTerminalEcho) (haFO__ handle_) -- ConcHask: SAFE, won't block
845 _ -> constructErrorAndFail "hSetEcho"
847 hIsTerminalDevice :: Handle -> IO Bool
848 hIsTerminalDevice handle = do
849 withHandle_ handle $ \ handle_ -> do
850 case haType__ handle_ of
851 ErrorHandle theError -> ioError theError
852 ClosedHandle -> ioe_closedHandle "hIsTerminalDevice" handle
854 rc <- CCALL(isTerminalDevice) (haFO__ handle_) -- ConcHask: SAFE, won't block
858 _ -> constructErrorAndFail "hIsTerminalDevice"
862 hConnectTerms :: Handle -> Handle -> IO ()
863 hConnectTerms hW hR = hConnectHdl_ hW hR 1{-check if they're both coming connected to ttys-}
865 hConnectTo :: Handle -> Handle -> IO ()
866 hConnectTo hW hR = hConnectHdl_ hW hR 0{-connect regardless-}
868 hConnectHdl_ :: Handle -> Handle -> Int -> IO ()
869 hConnectHdl_ hW hR is_tty =
870 wantRWHandle "hConnectTo" hW $ \ hW_ ->
871 wantRWHandle "hConnectTo" hR $ \ hR_ -> do
872 CCALL(setConnectedTo) (haFO__ hR_) (haFO__ hW_) is_tty -- ConcHask: SAFE, won't block
874 #ifndef __PARALLEL_HASKELL__
875 #define FILE_OBJECT ForeignObj
877 #define FILE_OBJECT Addr
880 flushConnectedBuf :: FILE_OBJECT -> IO ()
881 flushConnectedBuf fo = CCALL(flushConnectedBuf) fo
884 As an extension, we also allow characters to be pushed back.
885 Like ANSI C stdio, we guarantee no more than one character of
886 pushback. (For unbuffered channels, the (default) push-back limit is
890 hUngetChar :: Handle -> Char -> IO ()
891 hUngetChar handle c =
892 wantReadableHandle "hLookAhead" handle $ \ handle_ -> do
893 rc <- CCALL(ungetChar) (haFO__ handle_) c -- ConcHask: SAFE, won't block
895 then constructErrorAndFail "hUngetChar"
901 Hoisting files in in one go is sometimes useful, so we support
902 this as an extension:
905 -- in one go, read file into an externally allocated buffer.
906 slurpFile :: FilePath -> IO (Addr, Int)
908 handle <- openFile fname ReadMode
909 sz <- hFileSize handle
910 if sz > toInteger (maxBound::Int) then
911 ioError (userError "slurpFile: file too big")
913 let sz_i = fromInteger sz
914 chunk <- CCALL(allocMemory__) (sz_i::Int)
918 constructErrorAndFail "slurpFile"
920 rc <- withHandle_ handle ( \ handle_ -> do
921 let fo = haFO__ handle_
922 mayBlock fo (CCALL(readChunk) fo chunk sz_i) -- ConcHask: UNSAFE, may block.
926 then constructErrorAndFail "slurpFile"
927 else return (chunk, rc)
929 #ifndef __HUGS__ /* Hugs' Prelude doesn't need this */
930 hFillBufBA :: Handle -> ByteArray Int -> Int -> IO Int
931 hFillBufBA handle buf sz
932 | sz <= 0 = ioError (IOError (Just handle)
935 ("illegal buffer size " ++ showsPrec 9 sz [])) -- 9 => should be parens'ified.
937 wantReadableHandle "hFillBufBA" handle $ \ handle_ -> do
938 let fo = haFO__ handle_
940 rc <- mayBlock fo (CCALL(readChunkBA) fo buf sz) -- ConcHask: UNSAFE, may block.
942 rc <- mayBlock fo (CCALL(readChunk) fo buf sz) -- ConcHask: UNSAFE, may block.
946 else constructErrorAndFail "hFillBufBA"
949 hFillBuf :: Handle -> Addr -> Int -> IO Int
950 hFillBuf handle buf sz
951 | sz <= 0 = ioError (IOError (Just handle)
954 ("illegal buffer size " ++ showsPrec 9 sz [])) -- 9 => should be parens'ified.
956 wantReadableHandle "hFillBuf" handle $ \ handle_ -> do
957 let fo = haFO__ handle_
958 rc <- mayBlock fo (CCALL(readChunk) fo buf sz) -- ConcHask: UNSAFE, may block.
961 else constructErrorAndFail "hFillBuf"
965 The @hPutBuf hdl buf len@ action writes an already packed sequence of
966 bytes to the file/channel managed by @hdl@ - non-standard.
969 hPutBuf :: Handle -> Addr -> Int -> IO ()
970 hPutBuf handle buf len =
971 wantWriteableHandle "hPutBuf" handle $ \ handle_ -> do
972 let fo = haFO__ handle_
973 rc <- mayBlock fo (CCALL(writeBuf) fo buf len) -- ConcHask: UNSAFE, may block.
976 else constructErrorAndFail "hPutBuf"
978 #ifndef __HUGS__ /* An_ one Hugs doesn't provide */
979 hPutBufBA :: Handle -> ByteArray Int -> Int -> IO ()
980 hPutBufBA handle buf len =
981 wantWriteableHandle "hPutBufBA" handle $ \ handle_ -> do
982 let fo = haFO__ handle_
983 rc <- mayBlock fo (CCALL(writeBufBA) fo buf len) -- ConcHask: UNSAFE, may block.
986 else constructErrorAndFail "hPutBuf"
990 Sometimes it's useful to get at the file descriptor that
991 the Handle contains..
994 getHandleFd :: Handle -> IO Int
996 withHandle_ handle $ \ handle_ -> do
997 case (haType__ handle_) of
998 ErrorHandle theError -> ioError theError
999 ClosedHandle -> ioe_closedHandle "getHandleFd" handle
1001 fd <- CCALL(getFileFd) (haFO__ handle_)
1006 %*********************************************************
1008 \subsection{Miscellaneous}
1010 %*********************************************************
1012 These three functions are meant to get things out of @IOErrors@.
1017 ioeGetFileName :: IOError -> Maybe FilePath
1018 ioeGetErrorString :: IOError -> String
1019 ioeGetHandle :: IOError -> Maybe Handle
1021 ioeGetHandle (IOError h _ _ _) = h
1022 ioeGetErrorString (IOError _ iot _ str) =
1024 EOF -> "end of file"
1027 ioeGetFileName (IOError _ _ _ str) =
1028 case span (/=':') str of
1034 'Top-level' IO actions want to catch exceptions (e.g., forkIO and
1035 PrelMain.mainIO) and report them - topHandler is the exception
1036 handler they should use for this:
1039 -- make sure we handle errors while reporting the error!
1040 -- (e.g. evaluating the string passed to 'error' might generate
1041 -- another error, etc.)
1042 topHandler :: Bool -> Exception -> IO ()
1043 topHandler bombOut err = catchException (real_handler bombOut err) (topHandler bombOut)
1045 real_handler :: Bool -> Exception -> IO ()
1046 real_handler bombOut ex =
1048 AsyncException StackOverflow -> reportStackOverflow bombOut
1049 ErrorCall s -> reportError bombOut s
1050 other -> reportError bombOut (showsPrec 0 other "\n")
1052 reportStackOverflow :: Bool -> IO ()
1053 reportStackOverflow bombOut = do
1054 (hFlush stdout) `catchException` (\ _ -> return ())
1055 callStackOverflowHook
1061 reportError :: Bool -> String -> IO ()
1062 reportError bombOut str = do
1063 (hFlush stdout) `catchException` (\ _ -> return ())
1064 let bs@(ByteArray (_,len) _) = packString str
1065 writeErrString addrOf_ErrorHdrHook bs len
1071 foreign label "ErrorHdrHook"
1072 addrOf_ErrorHdrHook :: Addr
1074 foreign import ccall "writeErrString__"
1075 writeErrString :: Addr -> ByteArray Int -> Int -> IO ()
1077 foreign import ccall "stackOverflow"
1078 callStackOverflowHook :: IO ()
1080 foreign import ccall "stg_exit"
1081 stg_exit :: Int -> IO ()
1085 A number of operations want to get at a readable or writeable handle, and fail
1089 wantReadableHandle :: String -> Handle -> (Handle__ -> IO a) -> IO a
1090 wantReadableHandle fun handle act =
1091 withHandle_ handle $ \ handle_ -> do
1092 case haType__ handle_ of
1093 ErrorHandle theError -> ioError theError
1094 ClosedHandle -> ioe_closedHandle fun handle
1095 SemiClosedHandle -> ioe_closedHandle fun handle
1096 AppendHandle -> ioError not_readable_error
1097 WriteHandle -> ioError not_readable_error
1100 not_readable_error =
1101 IOError (Just handle) IllegalOperation fun
1102 ("handle is not open for reading")
1104 wantWriteableHandle :: String -> Handle -> (Handle__ -> IO a) -> IO a
1105 wantWriteableHandle fun handle act =
1106 withHandle_ handle $ \ handle_ -> do
1107 case haType__ handle_ of
1108 ErrorHandle theError -> ioError theError
1109 ClosedHandle -> ioe_closedHandle fun handle
1110 SemiClosedHandle -> ioe_closedHandle fun handle
1111 ReadHandle -> ioError not_writeable_error
1114 not_writeable_error =
1115 IOError (Just handle) IllegalOperation fun
1116 ("handle is not open for writing")
1118 wantRWHandle :: String -> Handle -> (Handle__ -> IO a) -> IO a
1119 wantRWHandle fun handle act =
1120 withHandle_ handle $ \ handle_ -> do
1121 case haType__ handle_ of
1122 ErrorHandle theError -> ioError theError
1123 ClosedHandle -> ioe_closedHandle fun handle
1124 SemiClosedHandle -> ioe_closedHandle fun handle
1127 wantSeekableHandle :: String -> Handle -> (Handle__ -> IO a) -> IO a
1128 wantSeekableHandle fun handle act =
1129 withHandle_ handle $ \ handle_ -> do
1130 case haType__ handle_ of
1131 ErrorHandle theError -> ioError theError
1132 ClosedHandle -> ioe_closedHandle fun handle
1133 SemiClosedHandle -> ioe_closedHandle fun handle
1134 AppendHandle -> ioError not_seekable_error
1137 not_seekable_error =
1138 IOError (Just handle)
1139 IllegalOperation fun
1140 ("handle is not seekable")
1144 Internal function for creating an @IOError@ representing the
1145 access to a closed file.
1148 ioe_closedHandle :: String -> Handle -> IO a
1149 ioe_closedHandle fun h = ioError (IOError (Just h) IllegalOperation fun "handle is closed")
1152 Internal helper functions for Concurrent Haskell implementation
1156 #ifndef __PARALLEL_HASKELL__
1157 mayBlock :: ForeignObj -> IO Int -> IO Int
1159 mayBlock :: Addr -> IO Int -> IO Int
1162 #ifndef notyet /*__CONCURRENT_HASKELL__*/
1163 mayBlock _ act = act
1165 mayBlock fo act = do
1168 -5 -> do -- (possibly blocking) read
1169 fd <- CCALL(getFileFd) fo
1171 CCALL(clearNonBlockingIOFlag__) fo -- force read to happen this time.
1172 mayBlock fo act -- input available, re-try
1173 -6 -> do -- (possibly blocking) write
1174 fd <- CCALL(getFileFd) fo
1176 CCALL(clearNonBlockingIOFlag__) fo -- force write to happen this time.
1177 mayBlock fo act -- output possible
1178 -7 -> do -- (possibly blocking) write on connected handle
1179 fd <- CCALL(getConnFileFd) fo
1181 CCALL(clearConnNonBlockingIOFlag__) fo -- force write to happen this time.
1182 mayBlock fo act -- output possible
1184 CCALL(setNonBlockingIOFlag__) fo -- reset file object.
1185 CCALL(setConnNonBlockingIOFlag__) fo -- reset (connected) file object.
1192 threadDelay, threadWaitRead, threadWaitWrite :: Int -> IO ()
1194 -- Hugs does actually have the primops needed to implement these
1195 -- but, like GHC, the primops don't actually do anything...
1196 threadDelay _ = return ()
1197 threadWaitRead _ = return ()
1198 threadWaitWrite _ = return ()
1207 type Exclusive = Int -- really Bool
1210 type OpenStdFlags = Int
1211 type OpenFlags = Int
1212 type Readable = Int -- really Bool
1213 type Flush = Int -- really Bool
1214 type RC = Int -- standard return code
1216 type IOFileAddr = Addr -- as returned from functions
1217 type CString = PrimByteArray
1218 type Bytes = PrimMutableByteArray RealWorld
1220 #ifndef __PARALLEL_HASKELL__
1221 type FILE_OBJ = ForeignObj -- as passed into functions
1223 type FILE_OBJ = Addr
1226 foreign import ccall "libHS_cbits.so" "setBuf" unsafe prim_setBuf :: FILE_OBJ -> Addr -> Int -> IO ()
1227 foreign import ccall "libHS_cbits.so" "getBufSize" unsafe prim_getBufSize :: FILE_OBJ -> IO Int
1228 foreign import ccall "libHS_cbits.so" "inputReady" unsafe prim_inputReady :: FILE_OBJ -> Int -> IO RC
1229 foreign import ccall "libHS_cbits.so" "fileGetc" unsafe prim_fileGetc :: FILE_OBJ -> IO Int
1230 foreign import ccall "libHS_cbits.so" "fileLookAhead" unsafe prim_fileLookAhead :: FILE_OBJ -> IO Int
1231 foreign import ccall "libHS_cbits.so" "readBlock" unsafe prim_readBlock :: FILE_OBJ -> IO Int
1232 foreign import ccall "libHS_cbits.so" "readLine" unsafe prim_readLine :: FILE_OBJ -> IO Int
1233 foreign import ccall "libHS_cbits.so" "readChar" unsafe prim_readChar :: FILE_OBJ -> IO Int
1234 foreign import ccall "libHS_cbits.so" "writeFileObject" unsafe prim_writeFileObject :: FILE_OBJ -> Int -> IO RC
1235 foreign import ccall "libHS_cbits.so" "filePutc" unsafe prim_filePutc :: FILE_OBJ -> Char -> IO RC
1236 foreign import ccall "libHS_cbits.so" "getBufStart" unsafe prim_getBufStart :: FILE_OBJ -> Int -> IO Addr
1237 foreign import ccall "libHS_cbits.so" "getWriteableBuf" unsafe prim_getWriteableBuf :: FILE_OBJ -> IO Addr
1238 foreign import ccall "libHS_cbits.so" "getBufWPtr" unsafe prim_getBufWPtr :: FILE_OBJ -> IO Int
1239 foreign import ccall "libHS_cbits.so" "setBufWPtr" unsafe prim_setBufWPtr :: FILE_OBJ -> Int -> IO ()
1240 foreign import ccall "libHS_cbits.so" "closeFile" unsafe prim_closeFile :: FILE_OBJ -> Flush -> IO RC
1241 foreign import ccall "libHS_cbits.so" "fileEOF" unsafe prim_fileEOF :: FILE_OBJ -> IO RC
1242 foreign import ccall "libHS_cbits.so" "setBuffering" unsafe prim_setBuffering :: FILE_OBJ -> Int -> IO RC
1243 foreign import ccall "libHS_cbits.so" "flushFile" unsafe prim_flushFile :: FILE_OBJ -> IO RC
1244 foreign import ccall "libHS_cbits.so" "flushConnectedBuf" unsafe prim_flushConnectedBuf :: FILE_OBJ -> IO RC
1245 foreign import ccall "libHS_cbits.so" "getBufferMode" unsafe prim_getBufferMode :: FILE_OBJ -> IO RC
1246 foreign import ccall "libHS_cbits.so" "seekFile_int64" unsafe prim_seekFile_int64 :: FILE_OBJ -> Int -> Int64 -> IO RC
1247 foreign import ccall "libHS_cbits.so" "seekFileP" unsafe prim_seekFileP :: FILE_OBJ -> IO RC
1248 foreign import ccall "libHS_cbits.so" "setTerminalEcho" unsafe prim_setTerminalEcho :: FILE_OBJ -> Int -> IO RC
1249 foreign import ccall "libHS_cbits.so" "getTerminalEcho" unsafe prim_getTerminalEcho :: FILE_OBJ -> IO RC
1250 foreign import ccall "libHS_cbits.so" "isTerminalDevice" unsafe prim_isTerminalDevice :: FILE_OBJ -> IO RC
1251 foreign import ccall "libHS_cbits.so" "setConnectedTo" unsafe prim_setConnectedTo :: FILE_OBJ -> FILE_OBJ -> Int -> IO ()
1252 foreign import ccall "libHS_cbits.so" "ungetChar" unsafe prim_ungetChar :: FILE_OBJ -> Char -> IO RC
1253 foreign import ccall "libHS_cbits.so" "readChunk" unsafe prim_readChunk :: FILE_OBJ -> Addr -> Int -> IO RC
1254 foreign import ccall "libHS_cbits.so" "writeBuf" unsafe prim_writeBuf :: FILE_OBJ -> Addr -> Int -> IO RC
1255 foreign import ccall "libHS_cbits.so" "getFileFd" unsafe prim_getFileFd :: FILE_OBJ -> IO FD
1256 foreign import ccall "libHS_cbits.so" "fileSize_int64" unsafe prim_fileSize_int64 :: FILE_OBJ -> Bytes -> IO RC
1257 foreign import ccall "libHS_cbits.so" "getFilePosn" unsafe prim_getFilePosn :: FILE_OBJ -> IO Int
1258 foreign import ccall "libHS_cbits.so" "setFilePosn" unsafe prim_setFilePosn :: FILE_OBJ -> Int -> IO Int
1259 foreign import ccall "libHS_cbits.so" "getConnFileFd" unsafe prim_getConnFileFd :: FILE_OBJ -> IO FD
1260 foreign import ccall "libHS_cbits.so" "allocMemory__" unsafe prim_allocMemory__ :: Int -> IO Addr
1261 foreign import ccall "libHS_cbits.so" "getLock" unsafe prim_getLock :: FD -> Exclusive -> IO RC
1262 foreign import ccall "libHS_cbits.so" "openStdFile" unsafe prim_openStdFile :: FD -> OpenStdFlags -> Readable -> IO IOFileAddr
1263 foreign import ccall "libHS_cbits.so" "openFile" unsafe prim_openFile :: CString -> How -> Binary -> OpenFlags -> IO IOFileAddr
1264 foreign import ccall "libHS_cbits.so" "freeFileObject" unsafe prim_freeFileObject :: FILE_OBJ -> IO ()
1265 foreign import ccall "libHS_cbits.so" "freeStdFileObject" unsafe prim_freeStdFileObject :: FILE_OBJ -> IO ()
1266 foreign import ccall "libHS_cbits.so" "const_BUFSIZ" unsafe const_BUFSIZ :: Int
1268 foreign import ccall "libHS_cbits.so" "setConnNonBlockingIOFlag__" unsafe prim_setConnNonBlockingIOFlag__ :: FILE_OBJ -> IO ()
1269 foreign import ccall "libHS_cbits.so" "clearConnNonBlockingIOFlag__" unsafe prim_clearConnNonBlockingIOFlag__ :: FILE_OBJ -> IO ()
1270 foreign import ccall "libHS_cbits.so" "setNonBlockingIOFlag__" unsafe prim_setNonBlockingIOFlag__ :: FILE_OBJ -> IO ()
1271 foreign import ccall "libHS_cbits.so" "clearNonBlockingIOFlag__" unsafe prim_clearNonBlockingIOFlag__ :: FILE_OBJ -> IO ()
1273 foreign import ccall "libHS_cbits.so" "getErrStr__" unsafe prim_getErrStr__ :: IO Addr
1274 foreign import ccall "libHS_cbits.so" "getErrNo__" unsafe prim_getErrNo__ :: IO Int
1275 foreign import ccall "libHS_cbits.so" "getErrType__" unsafe prim_getErrType__ :: IO Int