-
+%
% (c) The AQUA Project, Glasgow University, 1994-1996
%
\begin{code}
{-# OPTIONS -fno-implicit-prelude -#include "cbits/stgio.h" #-}
-#include "cbits/error.h"
+#include "cbits/stgerror.h"
#ifndef __HUGS__ /* Hugs just includes this in PreludeBuiltin so no header needed */
module PrelHandle where
import PrelBase
import PrelAddr ( Addr, nullAddr )
-import PrelArr ( newVar, readVar, writeVar, ByteArray(..) )
+import PrelArr ( newVar, readVar, writeVar )
+import PrelByteArr ( ByteArray(..) )
import PrelRead ( Read )
import PrelList ( span )
import PrelIOBase
import PrelException
import PrelMaybe ( Maybe(..) )
import PrelEnum
-import PrelNum
+import PrelNum ( toBig, Integer(..), Num(..) )
import PrelShow
import PrelAddr ( Addr, nullAddr )
-import PrelNum ( toInteger, toBig )
+import PrelReal ( toInteger )
import PrelPack ( packString )
+#ifndef __PARALLEL_HASKELL__
import PrelWeak ( addForeignFinalizer )
+#endif
import Ix
#ifdef __CONCURRENT_HASKELL__
%*********************************************************
\begin{code}
-foreign import "libHS_cbits" "freeStdFileObject"
+foreign import "libHS_cbits" "freeStdFileObject" unsafe
freeStdFileObject :: FILE_OBJECT -> IO ()
-foreign import "libHS_cbits" "freeFileObject"
+foreign import "libHS_cbits" "freeFileObject" unsafe
freeFileObject :: FILE_OBJECT -> IO ()
\end{code}
\begin{code}
hIsEOF :: Handle -> IO Bool
-hIsEOF handle =
- wantReadableHandle "hIsEOF" handle $ \ handle_ -> do
- let fo = haFO__ handle_
- rc <- mayBlock fo (fileEOF fo) -- ConcHask: UNSAFE, may block
+hIsEOF handle = do
+ rc <- mayBlockRead "hIsEOF" handle fileEOF
case rc of
0 -> return False
1 -> return True
-- [what's the winning argument for it not being strong? --sof]
HandlePosition
+instance Eq HandlePosn where
+ (HandlePosn h1 p1) == (HandlePosn h2 p2) = p1==p2 && h1==h2
+
-- HandlePosition is the Haskell equivalent of POSIX' off_t.
-- We represent it as an Integer on the Haskell side, but
-- cheat slightly in that hGetPosn calls upon a C helper
"hFillBufBA"
("illegal buffer size " ++ showsPrec 9 sz [])) -- 9 => should be parens'ified.
| otherwise =
- wantReadableHandle "hFillBufBA" handle $ \ handle_ -> do
- let fo = haFO__ handle_
- rc <- mayBlock fo (readChunkBA fo buf sz) -- ConcHask: UNSAFE, may block.
- if rc >= (0::Int)
- then return rc
- else constructErrorAndFail "hFillBufBA"
+ mayBlockRead "hFillBufBA" handle (\fo -> readChunkBA fo buf sz)
#endif
hFillBuf :: Handle -> Addr -> Int -> IO Int
"hFillBuf"
("illegal buffer size " ++ showsPrec 9 sz [])) -- 9 => should be parens'ified.
| otherwise =
- wantReadableHandle "hFillBuf" handle $ \ handle_ -> do
- let fo = haFO__ handle_
- rc <- mayBlock fo (readChunk fo buf sz) -- ConcHask: UNSAFE, may block.
- if rc >= 0
- then return rc
- else constructErrorAndFail "hFillBuf"
-
+ mayBlockRead "hFillBuf" handle (\fo -> readChunk fo buf sz)
\end{code}
The @hPutBuf hdl buf len@ action writes an already packed sequence of
reportError :: Bool -> String -> IO ()
reportError bombOut str = do
(hFlush stdout) `catchException` (\ _ -> return ())
- let bs@(ByteArray (_,len) _) = packString str
+ let bs@(ByteArray _ len _) = packString str
writeErrString addrOf_ErrorHdrHook bs len
if bombOut then
stg_exit 1
foreign label "ErrorHdrHook"
addrOf_ErrorHdrHook :: Addr
-foreign import ccall "writeErrString__"
+foreign import ccall "writeErrString__" unsafe
writeErrString :: Addr -> ByteArray Int -> Int -> IO ()
foreign import ccall "stackOverflow"
mayBlock fo act -- output possible
_ -> do
return rc
+
+data MayBlock
+ = BlockRead Int
+ | BlockWrite Int
+ | NoBlock Int
+
+mayBlockRead :: String -> Handle -> (ForeignObj -> IO Int) -> IO Int
+mayBlockRead fname handle fn = do
+ r <- wantReadableHandle fname handle $ \ handle_ -> do
+ let fo = haFO__ handle_
+ rc <- fn fo
+ case rc of
+ -5 -> do -- (possibly blocking) read
+ fd <- getFileFd fo
+ return (BlockRead fd)
+ -6 -> do -- (possibly blocking) write
+ fd <- getFileFd fo
+ return (BlockWrite fd)
+ -7 -> do -- (possibly blocking) write on connected handle
+ fd <- getConnFileFd fo
+ return (BlockWrite fd)
+ _ ->
+ if rc >= 0
+ then return (NoBlock rc)
+ else constructErrorAndFail fname
+ case r of
+ BlockRead fd -> do
+ threadWaitRead fd
+ mayBlockRead fname handle fn
+ BlockWrite fd -> do
+ threadWaitWrite fd
+ mayBlockRead fname handle fn
+ NoBlock c -> return c
\end{code}
Foreign import declarations of helper functions: