% -----------------------------------------------------------------------------
-% $Id: PrelIOBase.lhs,v 1.8 1999/03/31 09:52:05 sof Exp $
+% $Id: PrelIOBase.lhs,v 1.13 1999/09/19 19:12:41 sof Exp $
%
% (c) The AQUA Project, Glasgow University, 1994-1998
%
import PrelMaybe ( Maybe(..) )
import PrelAddr ( Addr(..), nullAddr )
import PrelPack ( unpackCString )
+import PrelShow
#if !defined(__CONCURRENT_HASKELL__)
import PrelArr ( MutableVar, readVar )
#endif
#ifdef __HUGS__
-#define cat2(x,y) x/**/y
-#define CCALL(fun) cat2(prim_,fun)
#define __CONCURRENT_HASKELL__
#define stToIO id
#define unpackCString primUnpackString
-#else
-#define CCALL(fun) _ccall_ fun
-#define ref_freeStdFileObject (``&freeStdFileObject''::Addr)
#endif
#ifndef __PARALLEL_HASKELL__
| EOF
#ifdef _WIN32
| ComError Int -- HRESULT
- (Maybe Addr) -- Pointer to 'exception' object. (IExceptionInfo..)
#endif
deriving (Eq)
UserError -> "failed"
UnsupportedOperation -> "unsupported operation"
EOF -> "end of file"
+#ifdef _WIN32
+ ComError _ -> "COM error"
+#endif
constructErrorMsg :: String -> Maybe String -> IO IOError
constructErrorMsg call_site reason =
- CCALL(getErrType__) >>= \ errtype ->
- CCALL(getErrStr__) >>= \ str ->
+ getErrType__ >>= \ errtype ->
+ getErrStr__ >>= \ str ->
let
iot =
case (errtype::Int) of
BlockBuffering Nothing -> showString "block " . showParen True (showsPrec p def)
where
def :: Int
- def = unsafePerformIO (CCALL(getBufSize) fo)
+ def = unsafePerformIO (getBufSize fo)
mkBuffer__ :: FILE_OBJECT -> Int -> IO ()
mkBuffer__ fo sz_in_bytes = do
case sz_in_bytes of
0 -> return nullAddr -- this has the effect of overwriting the pointer to the old buffer.
_ -> do
- chunk <- CCALL(allocMemory__) sz_in_bytes
+ chunk <- allocMemory__ sz_in_bytes
if chunk == nullAddr
then ioError (IOError Nothing ResourceExhausted "mkBuffer__" "not enough virtual memory")
else return chunk
- CCALL(setBuf) fo chunk sz_in_bytes
+ setBuf fo chunk sz_in_bytes
\end{code}
{- Read instance defined in IO. -}
\end{code}
+
+Foreign import declarations to helper routines:
+
+\begin{code}
+foreign import "libHS_cbits" "getErrStr__" unsafe getErrStr__ :: IO Addr
+foreign import "libHS_cbits" "getErrNo__" unsafe getErrNo__ :: IO Int
+foreign import "libHS_cbits" "getErrType__" unsafe getErrType__ :: IO Int
+
+foreign import "libHS_cbits" "allocMemory__" unsafe
+ allocMemory__ :: Int -> IO Addr
+foreign import "libHS_cbits" "getBufSize" unsafe
+ getBufSize :: FILE_OBJECT -> IO Int
+foreign import "libHS_cbits" "setBuf" unsafe
+ setBuf :: FILE_OBJECT -> Addr -> Int -> IO ()
+
+\end{code}