X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=compiler%2Futils%2FBufWrite.hs;h=306413573f322f0c9bbcf80a71d0d0b03bf4ebe9;hp=a03db3d0842d2d42e1576c7a47c2abe584c94847;hb=7b5b3b0cab463e108a0132435a28ef19d17cb32b;hpb=0065d5ab628975892cea1ec7303f968c3338cbe1 diff --git a/compiler/utils/BufWrite.hs b/compiler/utils/BufWrite.hs index a03db3d..3064135 100644 --- a/compiler/utils/BufWrite.hs +++ b/compiler/utils/BufWrite.hs @@ -2,7 +2,7 @@ -- -- Fast write-buffered Handles -- --- (c) The University of Glasgow 2005 +-- (c) The University of Glasgow 2005-2006 -- -- This is a simple abstraction over Handles that offers very fast write -- buffering, but without the thread safety that Handles provide. It's used @@ -23,19 +23,13 @@ module BufWrite ( #include "HsVersions.h" import FastString +import FastTypes import FastMutInt -import Panic ( panic ) -import Monad ( when ) -import Char ( ord ) +import Control.Monad ( when ) +import Data.Char ( ord ) import Foreign -import IO - -import GHC.IOBase ( IO(..) ) -import System.IO ( hPutBuf ) -import GHC.Ptr ( Ptr(..) ) - -import GLAEXTS ( Int(..), Int#, Addr# ) +import System.IO -- ----------------------------------------------------------------------------- @@ -50,7 +44,8 @@ newBufHandle hdl = do writeFastMutInt r 0 return (BufHandle ptr r hdl) -buf_size = 8192 :: Int +buf_size :: Int +buf_size = 8192 #define STRICT2(f) f a b | a `seq` b `seq` False = undefined #define STRICT3(f) f a b c | a `seq` b `seq` c `seq` False = undefined @@ -68,7 +63,7 @@ bPutChar b@(BufHandle buf r hdl) c = do bPutStr :: BufHandle -> String -> IO () STRICT2(bPutStr) -bPutStr b@(BufHandle buf r hdl) str = do +bPutStr (BufHandle buf r hdl) str = do i <- readFastMutInt r loop str i where loop _ i | i `seq` False = undefined @@ -95,22 +90,22 @@ bPutFS b@(BufHandle buf r hdl) fs@(FastString _ len _ fp _) = copyBytes (buf `plusPtr` i) ptr len writeFastMutInt r (i+len) -bPutLitString :: BufHandle -> Addr# -> Int# -> IO () -bPutLitString b@(BufHandle buf r hdl) a# len# = do - let len = I# len# +bPutLitString :: BufHandle -> LitString -> FastInt -> IO () +bPutLitString b@(BufHandle buf r hdl) a len_ = a `seq` do + let len = iBox len_ i <- readFastMutInt r if (i+len) >= buf_size then do hPutBuf hdl buf i writeFastMutInt r 0 if (len >= buf_size) - then hPutBuf hdl (Ptr a#) len - else bPutLitString b a# len# + then hPutBuf hdl a len + else bPutLitString b a len_ else do - copyBytes (buf `plusPtr` i) (Ptr a#) len + copyBytes (buf `plusPtr` i) a len writeFastMutInt r (i+len) bFlush :: BufHandle -> IO () -bFlush b@(BufHandle buf r hdl) = do +bFlush (BufHandle buf r hdl) = do i <- readFastMutInt r when (i > 0) $ hPutBuf hdl buf i free buf