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 newHandle (Handle__ fo WriteHandle bm "stdout")
246 _ -> do ioError <- constructError "stdout"
247 newHandle (mkErrorHandle__ ioError)
250 stdin = unsafePerformIO (do
251 rc <- CCALL(getLock) (0::Int) (0::Int) -- ConcHask: SAFE, won't block
253 0 -> newHandle (mkClosedHandle__)
255 #ifndef __CONCURRENT_HASKELL__
256 fo <- CCALL(openStdFile) (0::Int)
257 (0::Int){-don't flush on close -}
258 (1::Int){-readable-} -- ConcHask: SAFE, won't block
260 fo <- CCALL(openStdFile) (0::Int)
261 ((0{-flush on close-} {-+ 128 don't block on I/O-})::Int)
262 (1::Int){-readable-} -- ConcHask: SAFE, won't block
265 #ifndef __PARALLEL_HASKELL__
266 fo <- makeForeignObj fo
267 addForeignFinalizer fo (freeStdFileObject fo)
269 (bm, bf_size) <- getBMode__ fo
270 mkBuffer__ fo bf_size
271 hdl <- newHandle (Handle__ fo ReadHandle bm "stdin")
272 -- when stdin and stdout are both connected to a terminal, ensure
273 -- that anything buffered on stdout is flushed prior to reading from stdin.
275 hConnectTerms stdout hdl
277 _ -> do ioError <- constructError "stdin"
278 newHandle (mkErrorHandle__ ioError)
282 stderr = unsafePerformIO (do
283 rc <- CCALL(getLock) (2::Int) (1::Int){-writeable-} -- ConcHask: SAFE, won't block
285 0 -> newHandle (mkClosedHandle__)
287 #ifndef __CONCURRENT_HASKELL__
288 fo <- CCALL(openStdFile) (2::Int)
289 (1::Int){-flush on close-}
290 (0::Int){-writeable-} -- ConcHask: SAFE, won't block
292 fo <- CCALL(openStdFile) (2::Int)
293 ((1{-flush on close-} {- + 128 don't block on I/O-})::Int)
294 (0::Int){-writeable-} -- ConcHask: SAFE, won't block
297 #ifndef __PARALLEL_HASKELL__
298 fo <- makeForeignObj fo
299 addForeignFinalizer fo (freeStdFileObject fo)
301 hdl <- newHandle (Handle__ fo WriteHandle NoBuffering "stderr")
302 -- when stderr and stdout are both connected to a terminal, ensure
303 -- that anything buffered on stdout is flushed prior to writing to
305 hConnectTo stdout hdl
308 _ -> do ioError <- constructError "stderr"
309 newHandle (mkErrorHandle__ ioError)
313 %*********************************************************
315 \subsection[OpeningClosing]{Opening and Closing Files}
317 %*********************************************************
320 data IOMode = ReadMode | WriteMode | AppendMode | ReadWriteMode
321 deriving (Eq, Ord, Ix, Enum, Read, Show)
326 deriving (Eq, Read, Show)
328 openFile :: FilePath -> IOMode -> IO Handle
329 openFile fp im = openFileEx fp (TextMode im)
331 openFileEx :: FilePath -> IOModeEx -> IO Handle
334 fo <- CCALL(openFile) (primPackString f) (file_mode::Int)
336 (file_flags::Int) -- ConcHask: SAFE, won't block
337 if fo /= nullAddr then do
338 #ifndef __PARALLEL_HASKELL__
339 fo <- makeForeignObj fo
340 addForeignFinalizer fo (freeFileObject fo)
342 (bm, bf_size) <- getBMode__ fo
343 mkBuffer__ fo bf_size
344 newHandle (Handle__ fo htype bm f)
346 constructErrorAndFailWithInfo "openFile" f
350 BinaryMode bmo -> (bmo, 1)
351 TextMode tmo -> (tmo, 0)
353 #ifndef __CONCURRENT_HASKELL__
354 file_flags = file_flags'
356 -- See comment next to 'stderr' for why we leave
357 -- non-blocking off for now.
358 file_flags = file_flags' {-+ 128 Don't block on I/O-}
361 (file_flags', file_mode) =
366 ReadWriteMode -> (1, 3)
369 ReadMode -> ReadHandle
370 WriteMode -> WriteHandle
371 AppendMode -> AppendHandle
372 ReadWriteMode -> ReadWriteHandle
375 Computation $openFile file mode$ allocates and returns a new, open
376 handle to manage the file {\em file}. It manages input if {\em mode}
377 is $ReadMode$, output if {\em mode} is $WriteMode$ or $AppendMode$,
378 and both input and output if mode is $ReadWriteMode$.
380 If the file does not exist and it is opened for output, it should be
381 created as a new file. If {\em mode} is $WriteMode$ and the file
382 already exists, then it should be truncated to zero length. The
383 handle is positioned at the end of the file if {\em mode} is
384 $AppendMode$, and otherwise at the beginning (in which case its
385 internal position is 0).
387 Implementations should enforce, locally to the Haskell process,
388 multiple-reader single-writer locking on files, which is to say that
389 there may either be many handles on the same file which manage input,
390 or just one handle on the file which manages output. If any open or
391 semi-closed handle is managing a file for output, no new handle can be
392 allocated for that file. If any open or semi-closed handle is
393 managing a file for input, new handles can only be allocated if they
394 do not manage output.
396 Two files are the same if they have the same absolute name. An
397 implementation is free to impose stricter conditions.
400 hClose :: Handle -> IO ()
403 withHandle__ handle $ \ handle_ -> do
404 case haType__ handle_ of
405 ErrorHandle theError -> ioError theError
406 ClosedHandle -> return handle_
408 rc <- CCALL(closeFile) (haFO__ handle_) (1::Int){-flush if you can-} -- ConcHask: SAFE, won't block
409 {- We explicitly close a file object so that we can be told
410 if there were any errors. Note that after @hClose@
411 has been performed, the ForeignObj embedded in the Handle
412 is still lying around in the heap, so care is taken
413 to avoid closing the file object when the ForeignObj
414 is finalized. (we overwrite the file ptr in the underlying
415 FileObject with a NULL as part of closeFile())
418 then return (handle_{ haType__ = ClosedHandle,
419 haFO__ = nullFile__ })
420 else constructErrorAndFail "hClose"
424 Computation $hClose hdl$ makes handle {\em hdl} closed. Before the
425 computation finishes, any items buffered for output and not already
426 sent to the operating system are flushed as for $flush$.
428 %*********************************************************
430 \subsection[EOF]{Detecting the End of Input}
432 %*********************************************************
435 For a handle {\em hdl} which attached to a physical file, $hFileSize
436 hdl$ returns the size of {\em hdl} in terms of the number of items
437 which can be read from {\em hdl}.
440 hFileSize :: Handle -> IO Integer
442 withHandle_ handle $ \ handle_ -> do
443 case haType__ handle_ of
444 ErrorHandle theError -> ioError theError
445 ClosedHandle -> ioe_closedHandle "hFileSize" handle
446 SemiClosedHandle -> ioe_closedHandle "hFileSize" handle
449 mem <- primNewByteArray sizeof_int64
450 rc <- CCALL(fileSize_int64) (haFO__ handle_) mem -- ConcHask: SAFE, won't block
452 result <- primReadInt64Array mem 0
453 return (primInt64ToInteger result)
455 constructErrorAndFail "hFileSize"
458 -- HACK! We build a unique MP_INT of the right shape to hold
459 -- a single unsigned word, and we let the C routine
460 -- change the data bits
462 -- For some reason, this fails to typecheck if converted to a do
464 _casm_ ``%r = 1;'' >>= \(I# hack#) ->
465 case int2Integer# hack# of
467 rc <- CCALL(fileSize) (haFO__ handle_) d -- ConcHask: SAFE, won't block
468 if rc == (0::Int) then
471 constructErrorAndFail "hFileSize"
475 For a readable handle {\em hdl}, @hIsEOF hdl@ returns
476 @True@ if no further input can be taken from @hdl@ or for a
477 physical file, if the current I/O position is equal to the length of
478 the file. Otherwise, it returns @False@.
481 hIsEOF :: Handle -> IO Bool
483 wantReadableHandle "hIsEOF" handle $ \ handle_ -> do
484 let fo = haFO__ handle_
485 rc <- mayBlock fo (CCALL(fileEOF) fo) -- ConcHask: UNSAFE, may block
489 _ -> constructErrorAndFail "hIsEOF"
495 %*********************************************************
497 \subsection[Buffering]{Buffering Operations}
499 %*********************************************************
501 Three kinds of buffering are supported: line-buffering,
502 block-buffering or no-buffering. See @IOBase@ for definition
503 and further explanation of what the type represent.
505 Computation @hSetBuffering hdl mode@ sets the mode of buffering for
506 handle {\em hdl} on subsequent reads and writes.
510 If {\em mode} is @LineBuffering@, line-buffering should be
513 If {\em mode} is @BlockBuffering@ {\em size}, then block-buffering
514 should be enabled if possible. The size of the buffer is {\em n} items
515 if {\em size} is @Just@~{\em n} and is otherwise implementation-dependent.
517 If {\em mode} is @NoBuffering@, then buffering is disabled if possible.
520 If the buffer mode is changed from @BlockBuffering@ or @LineBuffering@
521 to @NoBuffering@, then any items in the output buffer are written to
522 the device, and any items in the input buffer are discarded. The
523 default buffering mode when a handle is opened is
524 implementation-dependent and may depend on the object which is
525 attached to that handle.
528 hSetBuffering :: Handle -> BufferMode -> IO ()
530 hSetBuffering handle mode =
532 BlockBuffering (Just n)
534 (IOError (Just handle)
537 ("illegal buffer size " ++ showsPrec 9 n [])) -- 9 => should be parens'ified.
539 withHandle__ handle $ \ handle_ -> do
540 case haType__ handle_ of
541 ErrorHandle theError -> ioError theError
542 ClosedHandle -> ioe_closedHandle "hSetBuffering" handle
545 - we flush the old buffer regardless of whether
546 the new buffer could fit the contents of the old buffer
548 - allow a handle's buffering to change even if IO has
549 occurred (ANSI C spec. does not allow this, nor did
550 the previous implementation of IO.hSetBuffering).
551 - a non-standard extension is to allow the buffering
552 of semi-closed handles to change [sof 6/98]
554 let fo = haFO__ handle_
555 rc <- mayBlock fo (CCALL(setBuffering) fo bsize) -- ConcHask: UNSAFE, may block
558 return (handle_{ haBufferMode__ = mode })
560 -- Note: failure to change the buffer size will cause old buffer to be flushed.
561 constructErrorAndFail "hSetBuffering"
567 BlockBuffering Nothing -> -2
568 BlockBuffering (Just n) -> n
571 The action @hFlush hdl@ causes any items buffered for output
572 in handle {\em hdl} to be sent immediately to the operating
576 hFlush :: Handle -> IO ()
578 wantWriteableHandle "hFlush" handle $ \ handle_ -> do
579 let fo = haFO__ handle_
580 rc <- mayBlock fo (CCALL(flushFile) fo) -- ConcHask: UNSAFE, may block
584 constructErrorAndFail "hFlush"
589 %*********************************************************
591 \subsection[Seeking]{Repositioning Handles}
593 %*********************************************************
598 Handle -- Q: should this be a weak or strong ref. to the handle?
601 data SeekMode = AbsoluteSeek | RelativeSeek | SeekFromEnd
602 deriving (Eq, Ord, Ix, Enum, Read, Show)
605 Computation @hGetPosn hdl@ returns the current I/O
606 position of {\em hdl} as an abstract position. Computation
607 $hSetPosn p$ sets the position of {\em hdl}
608 to a previously obtained position {\em p}.
611 hGetPosn :: Handle -> IO HandlePosn
613 wantSeekableHandle "hGetPosn" handle $ \ handle_ -> do
614 posn <- CCALL(getFilePosn) (haFO__ handle_) -- ConcHask: SAFE, won't block
615 if posn /= -1 then do
616 return (HandlePosn handle posn)
618 constructErrorAndFail "hGetPosn"
620 hSetPosn :: HandlePosn -> IO ()
621 hSetPosn (HandlePosn handle posn) =
622 wantSeekableHandle "hSetPosn" handle $ \ handle_ -> do -- not as silly as it looks: the handle may have been closed in the meantime.
623 let fo = haFO__ handle_
624 rc <- mayBlock fo (CCALL(setFilePosn) fo posn) -- ConcHask: UNSAFE, may block
628 constructErrorAndFail "hSetPosn"
631 The action @hSeek hdl mode i@ sets the position of handle
632 @hdl@ depending on @mode@. If @mode@ is
634 \item[{\bf AbsoluteSeek}] The position of @hdl@ is set to @i@.
635 \item[{\bf RelativeSeek}] The position of @hdl@ is set to offset @i@ from
636 the current position.
637 \item[{\bf SeekFromEnd}] The position of @hdl@ is set to offset @i@ from
641 Some handles may not be seekable (see @hIsSeekable@), or only support a
642 subset of the possible positioning operations (e.g. it may only be
643 possible to seek to the end of a tape, or to a positive offset from
644 the beginning or current position).
646 It is not possible to set a negative I/O position, or for a physical
647 file, an I/O position beyond the current end-of-file.
650 - when seeking using @SeekFromEnd@, positive offsets (>=0) means seeking
652 - relative seeking on buffered handles can lead to non-obvious results.
655 hSeek :: Handle -> SeekMode -> Integer -> IO ()
657 hSeek handle mode offset =
658 wantSeekableHandle "hSeek" handle $ \ handle_ -> do
659 let fo = haFO__ handle_
660 rc <- mayBlock fo (CCALL(seekFile_int64) fo whence (primIntegerToInt64 offset)) -- ConcHask: UNSAFE, may block
662 hSeek handle mode i@(S# _) = hSeek handle mode (toBig i)
663 hSeek handle mode (J# s# d#) =
664 wantSeekableHandle "hSeek" handle $ \ handle_ -> do
665 let fo = haFO__ handle_
666 rc <- mayBlock fo (CCALL(seekFile) fo whence (I# s#) d#) -- ConcHask: UNSAFE, may block
671 constructErrorAndFail "hSeek"
674 whence = case mode of
680 %*********************************************************
682 \subsection[Query]{Handle Properties}
684 %*********************************************************
686 A number of operations return information about the properties of a
687 handle. Each of these operations returns $True$ if the
688 handle has the specified property, and $False$
691 Computation $hIsBlockBuffered hdl$ returns $( False, Nothing )$ if
692 {\em hdl} is not block-buffered. Otherwise it returns
693 $( True, size )$, where {\em size} is $Nothing$ for default buffering, and
694 $( Just n )$ for block-buffering of {\em n} bytes.
697 hIsOpen :: Handle -> IO Bool
699 withHandle_ handle $ \ handle_ -> do
700 case haType__ handle_ of
701 ErrorHandle theError -> ioError theError
702 ClosedHandle -> return False
703 SemiClosedHandle -> return False
706 hIsClosed :: Handle -> IO Bool
708 withHandle_ handle $ \ handle_ -> do
709 case haType__ handle_ of
710 ErrorHandle theError -> ioError theError
711 ClosedHandle -> return True
714 {- not defined, nor exported, but mentioned
715 here for documentation purposes:
717 hSemiClosed :: Handle -> IO Bool
721 return (not (ho || hc))
724 hIsReadable :: Handle -> IO Bool
726 withHandle_ handle $ \ handle_ -> do
727 case haType__ handle_ of
728 ErrorHandle theError -> ioError theError
729 ClosedHandle -> ioe_closedHandle "hIsReadable" handle
730 SemiClosedHandle -> ioe_closedHandle "hIsReadable" handle
731 htype -> return (isReadable htype)
733 isReadable ReadHandle = True
734 isReadable ReadWriteHandle = True
737 hIsWritable :: Handle -> IO Bool
739 withHandle_ handle $ \ handle_ -> do
740 case haType__ handle_ of
741 ErrorHandle theError -> ioError theError
742 ClosedHandle -> ioe_closedHandle "hIsWritable" handle
743 SemiClosedHandle -> ioe_closedHandle "hIsWritable" handle
744 htype -> return (isWritable htype)
746 isWritable AppendHandle = True
747 isWritable WriteHandle = True
748 isWritable ReadWriteHandle = True
752 #ifndef __PARALLEL_HASKELL__
753 getBMode__ :: ForeignObj -> IO (BufferMode, Int)
755 getBMode__ :: Addr -> IO (BufferMode, Int)
758 rc <- CCALL(getBufferMode) fo -- ConcHask: SAFE, won't block
760 0 -> return (NoBuffering, 0)
761 -1 -> return (LineBuffering, default_buffer_size)
762 -2 -> return (BlockBuffering Nothing, default_buffer_size)
763 -3 -> return (NoBuffering, 0) -- only happens on un-stat()able files.
764 n -> return (BlockBuffering (Just n), n)
766 default_buffer_size :: Int
767 default_buffer_size = (const_BUFSIZ - 1)
770 Querying how a handle buffers its data:
773 hGetBuffering :: Handle -> IO BufferMode
774 hGetBuffering handle =
775 withHandle_ handle $ \ handle_ -> do
776 case haType__ handle_ of
777 ErrorHandle theError -> ioError theError
778 ClosedHandle -> ioe_closedHandle "hGetBuffering" handle
781 We're being non-standard here, and allow the buffering
782 of a semi-closed handle to be queried. -- sof 6/98
784 return (haBufferMode__ handle_) -- could be stricter..
788 hIsSeekable :: Handle -> IO Bool
790 withHandle_ handle $ \ handle_ -> do
791 case haType__ handle_ of
792 ErrorHandle theError -> ioError theError
793 ClosedHandle -> ioe_closedHandle "hIsSeekable" handle
794 SemiClosedHandle -> ioe_closedHandle "hIsSeekable" handle
795 AppendHandle -> return False
797 rc <- CCALL(seekFileP) (haFO__ handle_) -- ConcHask: SAFE, won't block
801 _ -> constructErrorAndFail "hIsSeekable"
805 %*********************************************************
807 \subsection{Changing echo status}
809 %*********************************************************
811 Non-standard GHC extension is to allow the echoing status
812 of a handles connected to terminals to be reconfigured:
815 hSetEcho :: Handle -> Bool -> IO ()
816 hSetEcho handle on = do
817 isT <- hIsTerminalDevice handle
821 withHandle_ handle $ \ handle_ -> do
822 case haType__ handle_ of
823 ErrorHandle theError -> ioError theError
824 ClosedHandle -> ioe_closedHandle "hSetEcho" handle
826 rc <- CCALL(setTerminalEcho) (haFO__ handle_) ((if on then 1 else 0)::Int) -- ConcHask: SAFE, won't block
829 else constructErrorAndFail "hSetEcho"
831 hGetEcho :: Handle -> IO Bool
833 isT <- hIsTerminalDevice handle
837 withHandle_ handle $ \ handle_ -> do
838 case haType__ handle_ of
839 ErrorHandle theError -> ioError theError
840 ClosedHandle -> ioe_closedHandle "hGetEcho" handle
842 rc <- CCALL(getTerminalEcho) (haFO__ handle_) -- ConcHask: SAFE, won't block
846 _ -> constructErrorAndFail "hSetEcho"
848 hIsTerminalDevice :: Handle -> IO Bool
849 hIsTerminalDevice handle = do
850 withHandle_ handle $ \ handle_ -> do
851 case haType__ handle_ of
852 ErrorHandle theError -> ioError theError
853 ClosedHandle -> ioe_closedHandle "hIsTerminalDevice" handle
855 rc <- CCALL(isTerminalDevice) (haFO__ handle_) -- ConcHask: SAFE, won't block
859 _ -> constructErrorAndFail "hIsTerminalDevice"
863 hConnectTerms :: Handle -> Handle -> IO ()
864 hConnectTerms hW hR = hConnectHdl_ hW hR 1{-check if they're both coming connected to ttys-}
866 hConnectTo :: Handle -> Handle -> IO ()
867 hConnectTo hW hR = hConnectHdl_ hW hR 0{-connect regardless-}
869 hConnectHdl_ :: Handle -> Handle -> Int -> IO ()
870 hConnectHdl_ hW hR is_tty =
871 wantRWHandle "hConnectTo" hW $ \ hW_ ->
872 wantRWHandle "hConnectTo" hR $ \ hR_ -> do
873 CCALL(setConnectedTo) (haFO__ hR_) (haFO__ hW_) is_tty -- ConcHask: SAFE, won't block
875 #ifndef __PARALLEL_HASKELL__
876 #define FILE_OBJECT ForeignObj
878 #define FILE_OBJECT Addr
881 flushConnectedBuf :: FILE_OBJECT -> IO ()
882 flushConnectedBuf fo = CCALL(flushConnectedBuf) fo
885 As an extension, we also allow characters to be pushed back.
886 Like ANSI C stdio, we guarantee no more than one character of
887 pushback. (For unbuffered channels, the (default) push-back limit is
891 hUngetChar :: Handle -> Char -> IO ()
892 hUngetChar handle c =
893 wantReadableHandle "hLookAhead" handle $ \ handle_ -> do
894 rc <- CCALL(ungetChar) (haFO__ handle_) c -- ConcHask: SAFE, won't block
896 then constructErrorAndFail "hUngetChar"
902 Hoisting files in in one go is sometimes useful, so we support
903 this as an extension:
906 -- in one go, read file into an externally allocated buffer.
907 slurpFile :: FilePath -> IO (Addr, Int)
909 handle <- openFile fname ReadMode
910 sz <- hFileSize handle
911 if sz > toInteger (maxBound::Int) then
912 ioError (userError "slurpFile: file too big")
914 let sz_i = fromInteger sz
915 chunk <- CCALL(allocMemory__) (sz_i::Int)
919 constructErrorAndFail "slurpFile"
921 rc <- withHandle_ handle ( \ handle_ -> do
922 let fo = haFO__ handle_
923 mayBlock fo (CCALL(readChunk) fo chunk sz_i) -- ConcHask: UNSAFE, may block.
927 then constructErrorAndFail "slurpFile"
928 else return (chunk, rc)
930 #ifndef __HUGS__ /* Hugs' Prelude doesn't need this */
931 hFillBufBA :: Handle -> ByteArray Int -> Int -> IO Int
932 hFillBufBA handle buf sz
933 | sz <= 0 = ioError (IOError (Just handle)
936 ("illegal buffer size " ++ showsPrec 9 sz [])) -- 9 => should be parens'ified.
938 wantReadableHandle "hFillBufBA" handle $ \ handle_ -> do
939 let fo = haFO__ handle_
941 rc <- mayBlock fo (CCALL(readChunkBA) fo buf sz) -- ConcHask: UNSAFE, may block.
943 rc <- mayBlock fo (CCALL(readChunk) fo buf sz) -- ConcHask: UNSAFE, may block.
947 else constructErrorAndFail "hFillBufBA"
950 hFillBuf :: Handle -> Addr -> Int -> IO Int
951 hFillBuf handle buf sz
952 | sz <= 0 = ioError (IOError (Just handle)
955 ("illegal buffer size " ++ showsPrec 9 sz [])) -- 9 => should be parens'ified.
957 wantReadableHandle "hFillBuf" handle $ \ handle_ -> do
958 let fo = haFO__ handle_
959 rc <- mayBlock fo (CCALL(readChunk) fo buf sz) -- ConcHask: UNSAFE, may block.
962 else constructErrorAndFail "hFillBuf"
966 The @hPutBuf hdl buf len@ action writes an already packed sequence of
967 bytes to the file/channel managed by @hdl@ - non-standard.
970 hPutBuf :: Handle -> Addr -> Int -> IO ()
971 hPutBuf handle buf len =
972 wantWriteableHandle "hPutBuf" handle $ \ handle_ -> do
973 let fo = haFO__ handle_
974 rc <- mayBlock fo (CCALL(writeBuf) fo buf len) -- ConcHask: UNSAFE, may block.
977 else constructErrorAndFail "hPutBuf"
979 #ifndef __HUGS__ /* An_ one Hugs doesn't provide */
980 hPutBufBA :: Handle -> ByteArray Int -> Int -> IO ()
981 hPutBufBA handle buf len =
982 wantWriteableHandle "hPutBufBA" handle $ \ handle_ -> do
983 let fo = haFO__ handle_
984 rc <- mayBlock fo (CCALL(writeBufBA) fo buf len) -- ConcHask: UNSAFE, may block.
987 else constructErrorAndFail "hPutBuf"
991 Sometimes it's useful to get at the file descriptor that
992 the Handle contains..
995 getHandleFd :: Handle -> IO Int
997 withHandle_ handle $ \ handle_ -> do
998 case (haType__ handle_) of
999 ErrorHandle theError -> ioError theError
1000 ClosedHandle -> ioe_closedHandle "getHandleFd" handle
1002 fd <- CCALL(getFileFd) (haFO__ handle_)
1007 %*********************************************************
1009 \subsection{Miscellaneous}
1011 %*********************************************************
1013 These three functions are meant to get things out of @IOErrors@.
1018 ioeGetFileName :: IOError -> Maybe FilePath
1019 ioeGetErrorString :: IOError -> String
1020 ioeGetHandle :: IOError -> Maybe Handle
1022 ioeGetHandle (IOError h _ _ _) = h
1023 ioeGetErrorString (IOError _ iot _ str) =
1025 EOF -> "end of file"
1028 ioeGetFileName (IOError _ _ _ str) =
1029 case span (/=':') str of
1035 'Top-level' IO actions want to catch exceptions (e.g., forkIO and
1036 PrelMain.mainIO) and report them - topHandler is the exception
1037 handler they should use for this:
1040 -- make sure we handle errors while reporting the error!
1041 -- (e.g. evaluating the string passed to 'error' might generate
1042 -- another error, etc.)
1043 topHandler :: Bool -> Exception -> IO ()
1044 topHandler bombOut err = catchException (real_handler bombOut err) (topHandler bombOut)
1046 real_handler :: Bool -> Exception -> IO ()
1047 real_handler bombOut ex =
1049 AsyncException StackOverflow -> reportStackOverflow bombOut
1050 ErrorCall s -> reportError bombOut s
1051 other -> reportError bombOut (showsPrec 0 other "\n")
1053 reportStackOverflow :: Bool -> IO ()
1054 reportStackOverflow bombOut = do
1055 (hFlush stdout) `catchException` (\ _ -> return ())
1056 callStackOverflowHook
1062 reportError :: Bool -> String -> IO ()
1063 reportError bombOut str = do
1064 (hFlush stdout) `catchException` (\ _ -> return ())
1065 let bs@(ByteArray (_,len) _) = packString str
1066 writeErrString addrOf_ErrorHdrHook bs len
1072 foreign label "ErrorHdrHook"
1073 addrOf_ErrorHdrHook :: Addr
1075 foreign import ccall "writeErrString__"
1076 writeErrString :: Addr -> ByteArray Int -> Int -> IO ()
1078 foreign import ccall "stackOverflow"
1079 callStackOverflowHook :: IO ()
1081 foreign import ccall "stg_exit"
1082 stg_exit :: Int -> IO ()
1086 A number of operations want to get at a readable or writeable handle, and fail
1090 wantReadableHandle :: String -> Handle -> (Handle__ -> IO a) -> IO a
1091 wantReadableHandle fun handle act =
1092 withHandle_ handle $ \ handle_ -> do
1093 case haType__ handle_ of
1094 ErrorHandle theError -> ioError theError
1095 ClosedHandle -> ioe_closedHandle fun handle
1096 SemiClosedHandle -> ioe_closedHandle fun handle
1097 AppendHandle -> ioError not_readable_error
1098 WriteHandle -> ioError not_readable_error
1101 not_readable_error =
1102 IOError (Just handle) IllegalOperation fun
1103 ("handle is not open for reading")
1105 wantWriteableHandle :: String -> Handle -> (Handle__ -> IO a) -> IO a
1106 wantWriteableHandle fun handle act =
1107 withHandle_ handle $ \ handle_ -> do
1108 case haType__ handle_ of
1109 ErrorHandle theError -> ioError theError
1110 ClosedHandle -> ioe_closedHandle fun handle
1111 SemiClosedHandle -> ioe_closedHandle fun handle
1112 ReadHandle -> ioError not_writeable_error
1115 not_writeable_error =
1116 IOError (Just handle) IllegalOperation fun
1117 ("handle is not open for writing")
1119 wantRWHandle :: String -> Handle -> (Handle__ -> IO a) -> IO a
1120 wantRWHandle fun handle act =
1121 withHandle_ handle $ \ handle_ -> do
1122 case haType__ handle_ of
1123 ErrorHandle theError -> ioError theError
1124 ClosedHandle -> ioe_closedHandle fun handle
1125 SemiClosedHandle -> ioe_closedHandle fun handle
1129 IOError (Just handle) IllegalOperation fun
1130 ("handle is not open for reading or writing")
1132 wantSeekableHandle :: String -> Handle -> (Handle__ -> IO a) -> IO a
1133 wantSeekableHandle fun handle act =
1134 withHandle_ handle $ \ handle_ -> do
1135 case haType__ handle_ of
1136 ErrorHandle theError -> ioError theError
1137 ClosedHandle -> ioe_closedHandle fun handle
1138 SemiClosedHandle -> ioe_closedHandle fun handle
1139 AppendHandle -> ioError not_seekable_error
1142 not_seekable_error =
1143 IOError (Just handle)
1144 IllegalOperation fun
1145 ("handle is not seekable")
1149 Internal function for creating an @IOError@ representing the
1150 access to a closed file.
1153 ioe_closedHandle :: String -> Handle -> IO a
1154 ioe_closedHandle fun h = ioError (IOError (Just h) IllegalOperation fun "handle is closed")
1157 Internal helper functions for Concurrent Haskell implementation
1161 #ifndef __PARALLEL_HASKELL__
1162 mayBlock :: ForeignObj -> IO Int -> IO Int
1164 mayBlock :: Addr -> IO Int -> IO Int
1167 #ifndef notyet /*__CONCURRENT_HASKELL__*/
1168 mayBlock _ act = act
1170 mayBlock fo act = do
1173 -5 -> do -- (possibly blocking) read
1174 fd <- CCALL(getFileFd) fo
1176 CCALL(clearNonBlockingIOFlag__) fo -- force read to happen this time.
1177 mayBlock fo act -- input available, re-try
1178 -6 -> do -- (possibly blocking) write
1179 fd <- CCALL(getFileFd) fo
1181 CCALL(clearNonBlockingIOFlag__) fo -- force write to happen this time.
1182 mayBlock fo act -- output possible
1183 -7 -> do -- (possibly blocking) write on connected handle
1184 fd <- CCALL(getConnFileFd) fo
1186 CCALL(clearConnNonBlockingIOFlag__) fo -- force write to happen this time.
1187 mayBlock fo act -- output possible
1189 CCALL(setNonBlockingIOFlag__) fo -- reset file object.
1190 CCALL(setConnNonBlockingIOFlag__) fo -- reset (connected) file object.
1197 threadDelay, threadWaitRead, threadWaitWrite :: Int -> IO ()
1199 -- Hugs does actually have the primops needed to implement these
1200 -- but, like GHC, the primops don't actually do anything...
1201 threadDelay _ = return ()
1202 threadWaitRead _ = return ()
1203 threadWaitWrite _ = return ()
1212 type Exclusive = Int -- really Bool
1215 type OpenStdFlags = Int
1216 type OpenFlags = Int
1217 type Readable = Int -- really Bool
1218 type Flush = Int -- really Bool
1219 type RC = Int -- standard return code
1221 type IOFileAddr = Addr -- as returned from functions
1222 type CString = PrimByteArray
1223 type Bytes = PrimMutableByteArray RealWorld
1225 #ifndef __PARALLEL_HASKELL__
1226 type FILE_OBJ = ForeignObj -- as passed into functions
1228 type FILE_OBJ = Addr
1231 foreign import ccall "libHS_cbits.so" "setBuf" unsafe prim_setBuf :: FILE_OBJ -> Addr -> Int -> IO ()
1232 foreign import ccall "libHS_cbits.so" "getBufSize" unsafe prim_getBufSize :: FILE_OBJ -> IO Int
1233 foreign import ccall "libHS_cbits.so" "inputReady" unsafe prim_inputReady :: FILE_OBJ -> Int -> IO RC
1234 foreign import ccall "libHS_cbits.so" "fileGetc" unsafe prim_fileGetc :: FILE_OBJ -> IO Int
1235 foreign import ccall "libHS_cbits.so" "fileLookAhead" unsafe prim_fileLookAhead :: FILE_OBJ -> IO Int
1236 foreign import ccall "libHS_cbits.so" "readBlock" unsafe prim_readBlock :: FILE_OBJ -> IO Int
1237 foreign import ccall "libHS_cbits.so" "readLine" unsafe prim_readLine :: FILE_OBJ -> IO Int
1238 foreign import ccall "libHS_cbits.so" "readChar" unsafe prim_readChar :: FILE_OBJ -> IO Int
1239 foreign import ccall "libHS_cbits.so" "writeFileObject" unsafe prim_writeFileObject :: FILE_OBJ -> Int -> IO RC
1240 foreign import ccall "libHS_cbits.so" "filePutc" unsafe prim_filePutc :: FILE_OBJ -> Char -> IO RC
1241 foreign import ccall "libHS_cbits.so" "getBufStart" unsafe prim_getBufStart :: FILE_OBJ -> Int -> IO Addr
1242 foreign import ccall "libHS_cbits.so" "getWriteableBuf" unsafe prim_getWriteableBuf :: FILE_OBJ -> IO Addr
1243 foreign import ccall "libHS_cbits.so" "getBufWPtr" unsafe prim_getBufWPtr :: FILE_OBJ -> IO Int
1244 foreign import ccall "libHS_cbits.so" "setBufWPtr" unsafe prim_setBufWPtr :: FILE_OBJ -> Int -> IO ()
1245 foreign import ccall "libHS_cbits.so" "closeFile" unsafe prim_closeFile :: FILE_OBJ -> Flush -> IO RC
1246 foreign import ccall "libHS_cbits.so" "fileEOF" unsafe prim_fileEOF :: FILE_OBJ -> IO RC
1247 foreign import ccall "libHS_cbits.so" "setBuffering" unsafe prim_setBuffering :: FILE_OBJ -> Int -> IO RC
1248 foreign import ccall "libHS_cbits.so" "flushFile" unsafe prim_flushFile :: FILE_OBJ -> IO RC
1249 foreign import ccall "libHS_cbits.so" "flushConnectedBuf" unsafe prim_flushConnectedBuf :: FILE_OBJ -> IO RC
1250 foreign import ccall "libHS_cbits.so" "getBufferMode" unsafe prim_getBufferMode :: FILE_OBJ -> IO RC
1251 foreign import ccall "libHS_cbits.so" "seekFile_int64" unsafe prim_seekFile_int64 :: FILE_OBJ -> Int -> Int64 -> IO RC
1252 foreign import ccall "libHS_cbits.so" "seekFileP" unsafe prim_seekFileP :: FILE_OBJ -> IO RC
1253 foreign import ccall "libHS_cbits.so" "setTerminalEcho" unsafe prim_setTerminalEcho :: FILE_OBJ -> Int -> IO RC
1254 foreign import ccall "libHS_cbits.so" "getTerminalEcho" unsafe prim_getTerminalEcho :: FILE_OBJ -> IO RC
1255 foreign import ccall "libHS_cbits.so" "isTerminalDevice" unsafe prim_isTerminalDevice :: FILE_OBJ -> IO RC
1256 foreign import ccall "libHS_cbits.so" "setConnectedTo" unsafe prim_setConnectedTo :: FILE_OBJ -> FILE_OBJ -> Int -> IO ()
1257 foreign import ccall "libHS_cbits.so" "ungetChar" unsafe prim_ungetChar :: FILE_OBJ -> Char -> IO RC
1258 foreign import ccall "libHS_cbits.so" "readChunk" unsafe prim_readChunk :: FILE_OBJ -> Addr -> Int -> IO RC
1259 foreign import ccall "libHS_cbits.so" "writeBuf" unsafe prim_writeBuf :: FILE_OBJ -> Addr -> Int -> IO RC
1260 foreign import ccall "libHS_cbits.so" "getFileFd" unsafe prim_getFileFd :: FILE_OBJ -> IO FD
1261 foreign import ccall "libHS_cbits.so" "fileSize_int64" unsafe prim_fileSize_int64 :: FILE_OBJ -> Bytes -> IO RC
1262 foreign import ccall "libHS_cbits.so" "getFilePosn" unsafe prim_getFilePosn :: FILE_OBJ -> IO Int
1263 foreign import ccall "libHS_cbits.so" "setFilePosn" unsafe prim_setFilePosn :: FILE_OBJ -> Int -> IO Int
1264 foreign import ccall "libHS_cbits.so" "getConnFileFd" unsafe prim_getConnFileFd :: FILE_OBJ -> IO FD
1265 foreign import ccall "libHS_cbits.so" "allocMemory__" unsafe prim_allocMemory__ :: Int -> IO Addr
1266 foreign import ccall "libHS_cbits.so" "getLock" unsafe prim_getLock :: FD -> Exclusive -> IO RC
1267 foreign import ccall "libHS_cbits.so" "openStdFile" unsafe prim_openStdFile :: FD -> OpenStdFlags -> Readable -> IO IOFileAddr
1268 foreign import ccall "libHS_cbits.so" "openFile" unsafe prim_openFile :: CString -> How -> Binary -> OpenFlags -> IO IOFileAddr
1269 foreign import ccall "libHS_cbits.so" "freeFileObject" unsafe prim_freeFileObject :: FILE_OBJ -> IO ()
1270 foreign import ccall "libHS_cbits.so" "freeStdFileObject" unsafe prim_freeStdFileObject :: FILE_OBJ -> IO ()
1271 foreign import ccall "libHS_cbits.so" "const_BUFSIZ" unsafe const_BUFSIZ :: Int
1273 foreign import ccall "libHS_cbits.so" "setConnNonBlockingIOFlag__" unsafe prim_setConnNonBlockingIOFlag__ :: FILE_OBJ -> IO ()
1274 foreign import ccall "libHS_cbits.so" "clearConnNonBlockingIOFlag__" unsafe prim_clearConnNonBlockingIOFlag__ :: FILE_OBJ -> IO ()
1275 foreign import ccall "libHS_cbits.so" "setNonBlockingIOFlag__" unsafe prim_setNonBlockingIOFlag__ :: FILE_OBJ -> IO ()
1276 foreign import ccall "libHS_cbits.so" "clearNonBlockingIOFlag__" unsafe prim_clearNonBlockingIOFlag__ :: FILE_OBJ -> IO ()
1278 foreign import ccall "libHS_cbits.so" "getErrStr__" unsafe prim_getErrStr__ :: IO Addr
1279 foreign import ccall "libHS_cbits.so" "getErrNo__" unsafe prim_getErrNo__ :: IO Int
1280 foreign import ccall "libHS_cbits.so" "getErrType__" unsafe prim_getErrType__ :: IO Int