X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=GHC%2FIO.hs;h=6cc8aaac298d144d546d5cb5881b12308d7d0af5;hb=bb534f206682be14daf72b33c6105ab27295c6ac;hp=d494a31b70af522ab65f6ad298d30db03a8abc0e;hpb=7981661de97f5c8e746d2cb7b4c146dba33069d2;p=ghc-base.git diff --git a/GHC/IO.hs b/GHC/IO.hs index d494a31..6cc8aaa 100644 --- a/GHC/IO.hs +++ b/GHC/IO.hs @@ -1,4 +1,4 @@ -{-# OPTIONS -fno-implicit-prelude -#include "HsBase.h" #-} +{-# OPTIONS_GHC -fno-implicit-prelude -#include "HsBase.h" #-} #undef DEBUG_DUMP @@ -27,8 +27,6 @@ module GHC.IO ( memcpy_baoff_ptr, ) where -#include "config.h" - import Foreign import Foreign.C @@ -47,6 +45,10 @@ import GHC.Show import GHC.List import GHC.Exception ( ioError, catch ) +#ifdef mingw32_HOST_OS +import GHC.Conc +#endif + -- --------------------------------------------------------------------------- -- Simple input operations @@ -89,7 +91,7 @@ hWaitForInput h msecs = do (fromIntegral msecs) (haIsStream handle_) return (r /= 0) -foreign import ccall unsafe "inputReady" +foreign import ccall safe "inputReady" inputReady :: CInt -> CInt -> Bool -> IO CInt -- --------------------------------------------------------------------------- @@ -406,7 +408,7 @@ hPutChar handle c = LineBuffering -> hPutcBuffered handle_ True c BlockBuffering _ -> hPutcBuffered handle_ False c NoBuffering -> - withObject (castCharToCChar c) $ \buf -> do + with (castCharToCChar c) $ \buf -> do writeRawBufferPtr "hPutChar" (fromIntegral fd) (haIsStream handle_) buf 0 1 return () @@ -559,7 +561,7 @@ commitBuffer commitBuffer hdl raw sz@(I# _) count@(I# _) flush release = do wantWritableHandle "commitAndReleaseBuffer" hdl $ - commitBuffer' hdl raw sz count flush release + commitBuffer' raw sz count flush release -- Explicitly lambda-lift this function to subvert GHC's full laziness -- optimisations, which otherwise tends to float out subexpressions @@ -572,7 +574,7 @@ commitBuffer hdl raw sz@(I# _) count@(I# _) flush release = do -- -- This hack is a fairly big win for hPutStr performance. --SDM 18/9/2001 -- -commitBuffer' hdl raw sz@(I# _) count@(I# _) flush release +commitBuffer' raw sz@(I# _) count@(I# _) flush release handle_@Handle__{ haFD=fd, haBuffer=ref, haBuffers=spare_buf_ref } = do #ifdef DEBUG_DUMP @@ -723,7 +725,7 @@ writeChunkNonBlocking fd is_stream ptr bytes = loop 0 bytes loop :: Int -> Int -> IO Int loop off bytes | bytes <= 0 = return off loop off bytes = do -#ifndef mingw32_TARGET_OS +#ifndef mingw32_HOST_OS ssize <- c_write (fromIntegral fd) (ptr `plusPtr` off) (fromIntegral bytes) let r = fromIntegral ssize :: Int if (r == -1) @@ -897,7 +899,7 @@ bufReadNonBlocking fd ref is_stream ptr so_far count = readChunkNonBlocking :: FD -> Bool -> Ptr a -> Int -> IO Int readChunkNonBlocking fd is_stream ptr bytes = do -#ifndef mingw32_TARGET_OS +#ifndef mingw32_HOST_OS ssize <- c_read (fromIntegral fd) (castPtr ptr) (fromIntegral bytes) let r = fromIntegral ssize :: Int if (r == -1)