diff options
Diffstat (limited to 'compiler/GHC/Utils')
| -rw-r--r-- | compiler/GHC/Utils/Binary.hs | 27 | ||||
| -rw-r--r-- | compiler/GHC/Utils/BufHandle.hs | 32 |
2 files changed, 29 insertions, 30 deletions
diff --git a/compiler/GHC/Utils/Binary.hs b/compiler/GHC/Utils/Binary.hs index 0fa1708e96..511bcdbe3b 100644 --- a/compiler/GHC/Utils/Binary.hs +++ b/compiler/GHC/Utils/Binary.hs @@ -185,16 +185,16 @@ setUserData :: BinHandle -> UserData -> BinHandle setUserData bh us = bh { bh_usr = us } getBinIndex :: BinHandle -> IO Int -getBinIndex (BinMem _ ints _) = readFastMutInt ints +getBinIndex (BinMem _ ints _) = readFirstFastMutInt ints putBinIndex :: BinHandle -> Int -> IO () -putBinIndex (BinMem _ ints _) x = writeFastMutInt ints x +putBinIndex (BinMem _ ints _) x = writeFirstFastMutInt ints x getArraySize :: BinHandle -> IO Int -getArraySize (BinMem _ ints _) = readFastMutInt2 ints +getArraySize (BinMem _ ints _) = readSecondFastMutInt ints putArraySize :: BinHandle -> Int -> IO () -putArraySize (BinMem _ ints _) x = writeFastMutInt2 ints x +putArraySize (BinMem _ ints _) x = writeSecondFastMutInt ints x -- | Get access to the underlying buffer. withBinBuffer :: BinHandle -> (ByteString -> IO a) -> IO a @@ -205,10 +205,9 @@ withBinBuffer h@(BinMem _ _ arr_r) action = do unsafeUnpackBinBuffer :: ByteString -> IO BinHandle unsafeUnpackBinBuffer (BS.BS arr len) = do - arr_r <- newIORef arr - ix_r <- newFastMutInt 0 - sz_r <- newFastMutInt len - return (BinMem noUserData ix_r sz_r arr_r) + arr_r <- newIORef arr + ix_sz_r <- newFastMutInt2 0 len + return (BinMem noUserData ix_sz_r arr_r) --------------------------------------------------------------- -- Bin @@ -264,11 +263,11 @@ seekBin h (BinPtr !p) = do -- | SeekBin but without calling expandBin seekBinNoExpand :: BinHandle -> Bin a -> IO () -seekBinNoExpand (BinMem _ ix_r sz_r _) (BinPtr !p) = do - sz <- readFastMutInt sz_r +seekBinNoExpand (BinMem _ ix_sz_r _) (BinPtr !p) = do + sz <- readSecondFastMutInt ix_sz_r if (p >= sz) then panic "seekBinNoExpand: seek out of range" - else writeFastMutInt ix_r p + else writeFirstFastMutInt ix_sz_r p writeBinMem :: BinHandle -> FilePath -> IO () writeBinMem bh@(BinMem _ _ arr_r) fn = do @@ -1175,7 +1174,7 @@ initFSTable bh = do , fs_tab_map = dict_map_ref } let put_dict = do - fs_count <- readFastMutInt dict_next_ref + fs_count <- readFirstFastMutInt dict_next_ref dict_map <- readIORef dict_map_ref putDictionary bh fs_count dict_map pure fs_count @@ -1199,8 +1198,8 @@ allocateFastString FSTable { fs_tab_next = j_r case lookupUFM_Directly out uniq of Just (j, _) -> return (fromIntegral j :: Word32) Nothing -> do - j <- readFastMutInt j_r - writeFastMutInt j_r (j + 1) + j <- readFirstFastMutInt j_r + writeFirstFastMutInt j_r (j + 1) writeIORef out_r $! addToUFM_Directly out uniq (j, f) return (fromIntegral j :: Word32) diff --git a/compiler/GHC/Utils/BufHandle.hs b/compiler/GHC/Utils/BufHandle.hs index 79d2dbed60..0cc1d015b7 100644 --- a/compiler/GHC/Utils/BufHandle.hs +++ b/compiler/GHC/Utils/BufHandle.hs @@ -59,13 +59,13 @@ buf_size = 8192 bPutChar :: BufHandle -> Char -> IO () bPutChar b@(BufHandle buf r hdl) !c = do - i <- readFastMutInt r + i <- readFirstFastMutInt r if (i >= buf_size) then do hPutBuf hdl buf buf_size - writeFastMutInt r 0 + writeFirstFastMutInt r 0 bPutChar b c else do pokeElemOff buf i (fromIntegral (ord c) :: Word8) - writeFastMutInt r (i+1) + writeFirstFastMutInt r (i+1) -- Equivalent of the text/str, text/unpackNBytes#, text/[] rules -- in GHC.Utils.Ppr. @@ -85,9 +85,9 @@ bPutChar b@(BufHandle buf r hdl) !c = do bPutStr :: BufHandle -> String -> IO () bPutStr (BufHandle buf r hdl) !str = do - i <- readFastMutInt r + i <- readFirstFastMutInt r loop str i - where loop "" !i = do writeFastMutInt r i; return () + where loop "" !i = do writeFirstFastMutInt r i; return () loop (c:cs) !i | i >= buf_size = do hPutBuf hdl buf buf_size @@ -107,46 +107,46 @@ bPutBS b bs = BS.unsafeUseAsCStringLen bs $ bPutCStringLen b bPutCStringLen :: BufHandle -> CStringLen -> IO () bPutCStringLen b@(BufHandle buf r hdl) cstr@(ptr, len) = do - i <- readFastMutInt r + i <- readFirstFastMutInt r if (i + len) >= buf_size then do hPutBuf hdl buf i - writeFastMutInt r 0 + writeFirstFastMutInt r 0 if (len >= buf_size) then hPutBuf hdl ptr len else bPutCStringLen b cstr else do copyBytes (buf `plusPtr` i) ptr len - writeFastMutInt r (i + len) + writeFirstFastMutInt r (i + len) bPutPtrString :: BufHandle -> PtrString -> IO () bPutPtrString b@(BufHandle buf r hdl) l@(PtrString a len) = l `seq` do - i <- readFastMutInt r + i <- readFirstFastMutInt r if (i+len) >= buf_size then do hPutBuf hdl buf i - writeFastMutInt r 0 + writeFirstFastMutInt r 0 if (len >= buf_size) then hPutBuf hdl a len else bPutPtrString b l else do copyBytes (buf `plusPtr` i) a len - writeFastMutInt r (i+len) + writeFirstFastMutInt r (i+len) -- | Replicate an 8-bit character bPutReplicate :: BufHandle -> Int -> Char -> IO () bPutReplicate (BufHandle buf r hdl) len c = do - i <- readFastMutInt r + i <- readFirstFastMutInt r let oc = fromIntegral (ord c) if (i+len) < buf_size then do fillBytes (buf `plusPtr` i) oc len - writeFastMutInt r (i+len) + writeFirstFastMutInt r (i+len) else do -- flush the current buffer when (i /= 0) $ hPutBuf hdl buf i if (len < buf_size) then do fillBytes buf oc len - writeFastMutInt r len + writeFirstFastMutInt r len else do -- fill a full buffer fillBytes buf oc buf_size @@ -154,12 +154,12 @@ bPutReplicate (BufHandle buf r hdl) len c = do let go n | n >= buf_size = do hPutBuf hdl buf buf_size go (n-buf_size) - | otherwise = writeFastMutInt r n + | otherwise = writeFirstFastMutInt r n go len bFlush :: BufHandle -> IO () bFlush (BufHandle buf r hdl) = do - i <- readFastMutInt r + i <- readFirstFastMutInt r when (i > 0) $ hPutBuf hdl buf i free buf return () |