summaryrefslogtreecommitdiff
path: root/compiler/utils
diff options
context:
space:
mode:
authorBen Gamari <ben@smart-cactus.org>2016-05-23 15:32:12 +0200
committerBen Gamari <ben@smart-cactus.org>2016-05-23 17:23:49 +0200
commit9bb277269ec020f138fe70a65f5972466113ab61 (patch)
treea283447f9931ddd0b462dc23945cbe51127a785e /compiler/utils
parent785b38ff4326f3cd9cf2097bf9967e7fd66995cd (diff)
downloadhaskell-9bb277269ec020f138fe70a65f5972466113ab61.tar.gz
Revert "compiler/iface: compress .hi files"
This appears to cause validation issues on, TEST="T11108 T9071 T11076 T7600 T7672 T8329 T10420 T10322 T8308 T4114a T4114c T10602 T10110 T9204 T2435 T9838 T4114d T10233 T8696 T1735 T5281 T6056 T10134 T9580 T6018 T9762 T8103" With compiler panics of the form, Compile failed (status 256) errors were: ghc: panic! (the 'impossible' happened) (GHC version 8.1.20160523 for x86_64-unknown-linux): Binary.readBinMem: decompression failed CallStack (from HasCallStack): error, called at compiler/utils/Binary.hs:192:16 in ghc:Binary Please report this as a GHC bug: http://www.haskell.org/ghc/reportabug This reverts commit d9cb7a8a94daa4d20aa042cd053e20b491315633.
Diffstat (limited to 'compiler/utils')
-rw-r--r--compiler/utils/Binary.hs37
-rw-r--r--compiler/utils/LZ4.hs126
2 files changed, 19 insertions, 144 deletions
diff --git a/compiler/utils/Binary.hs b/compiler/utils/Binary.hs
index 684cdc6bc4..8800d98f9c 100644
--- a/compiler/utils/Binary.hs
+++ b/compiler/utils/Binary.hs
@@ -66,19 +66,18 @@ import FastMutInt
import Fingerprint
import BasicTypes
import SrcLoc
-import qualified LZ4 as LZ4
import Foreign
import Data.Array
import Data.ByteString (ByteString)
-import qualified Data.ByteString as B
import qualified Data.ByteString.Internal as BS
import qualified Data.ByteString.Unsafe as BS
import Data.IORef
import Data.Char ( ord, chr )
import Data.Time
import Data.Typeable
-import Control.Monad ( when, liftM )
+import Control.Monad ( when )
+import System.IO as IO
import System.IO.Unsafe ( unsafeInterleaveIO )
import System.IO.Error ( mkIOError, eofErrorType )
import GHC.Real ( Ratio(..) )
@@ -177,27 +176,29 @@ isEOFBin (BinMem _ ix_r sz_r _) = do
writeBinMem :: BinHandle -> FilePath -> IO ()
writeBinMem (BinMem _ ix_r _ arr_r) fn = do
+ h <- openBinaryFile fn WriteMode
arr <- readIORef arr_r
ix <- readFastMutInt ix_r
- let bs = LZ4.compress $ BS.fromForeignPtr arr 0 ix
- case bs of
- Nothing -> error "Binary.writeBinMem: compression failed"
- Just x -> B.writeFile fn x
+ withForeignPtr arr $ \p -> hPutBuf h p ix
+ hClose h
readBinMem :: FilePath -> IO BinHandle
-- Return a BinHandle with a totally undefined State
readBinMem filename = do
- bs <- liftM LZ4.decompress (B.readFile filename)
- case bs of
- Nothing -> error "Binary.readBinMem: decompression failed"
- Just x -> do
- let (arr, ix, size) = BS.toForeignPtr x
- arr_r <- newIORef arr
- ix_r <- newFastMutInt
- writeFastMutInt ix_r ix
- sz_r <- newFastMutInt
- writeFastMutInt sz_r size
- return (BinMem noUserData ix_r sz_r arr_r)
+ h <- openBinaryFile filename ReadMode
+ filesize' <- hFileSize h
+ let filesize = fromIntegral filesize'
+ arr <- mallocForeignPtrBytes (filesize*2)
+ count <- withForeignPtr arr $ \p -> hGetBuf h p filesize
+ when (count /= filesize) $
+ error ("Binary.readBinMem: only read " ++ show count ++ " bytes")
+ hClose h
+ arr_r <- newIORef arr
+ ix_r <- newFastMutInt
+ writeFastMutInt ix_r 0
+ sz_r <- newFastMutInt
+ writeFastMutInt sz_r filesize
+ return (BinMem noUserData ix_r sz_r arr_r)
fingerprintBinMem :: BinHandle -> IO Fingerprint
fingerprintBinMem (BinMem _ ix_r _ arr_r) = do
diff --git a/compiler/utils/LZ4.hs b/compiler/utils/LZ4.hs
deleted file mode 100644
index 2e413d79e1..0000000000
--- a/compiler/utils/LZ4.hs
+++ /dev/null
@@ -1,126 +0,0 @@
-{-# LANGUAGE CPP #-}
-{-# LANGUAGE ScopedTypeVariables #-}
--- |
--- Module : LZ4
--- Copyright : (c) Mark Wotton, Austin Seipp 2012-2015
--- License : BSD3
---
--- Compression utilities (currently utilizing @LZ4 r127@).
---
-module LZ4
- ( compress -- :: S.ByteString -> S.ByteString
- , decompress -- :: S.ByteString -> Maybe S.ByteString
- ) where
-
-import Prelude hiding (max)
-import Data.Word
-import Data.Bits
-import Foreign.Ptr
-import Foreign.C
-import System.IO.Unsafe (unsafePerformIO)
-#if __GLASGOW_HASKELL__ < 709
-import Control.Applicative
-#endif
---import Control.Monad
-import Data.Monoid ((<>))
-
-import qualified Data.ByteString as S
-import qualified Data.ByteString.Internal as SI
-import qualified Data.ByteString.Unsafe as U
-
---------------------------------------------------------------------------------
--- Compression
-
--- | Compresses the input 'ByteString'.
---
--- Will return 'Nothing' if the compression fails. Otherwise, returns
--- @Just xs@ with the compressed string.
-compress :: S.ByteString -> Maybe S.ByteString
-compress xs | S.null xs = Just S.empty
-compress xs = unsafePerformIO $
- U.unsafeUseAsCStringLen xs $ \(cstr,len) -> do
- let len' = fromIntegral len :: CInt
- let max = c_LZ4_compressBound len'
- bs <- SI.createAndTrim (fromIntegral max) $ \output ->
- fromIntegral <$> c_LZ4_compress cstr output len'
- case (S.null bs) of
- True -> return Nothing
- -- Prefix the compressed string with the uncompressed length
- False -> return $ Just (format (fromIntegral len) bs)
-{-# INLINEABLE compress #-}
-
---------------------------------------------------------------------------------
--- Decompression
-
--- | Decompress the input 'ByteString'.
-decompress :: S.ByteString -> Maybe S.ByteString
-decompress xs | S.null xs = Just S.empty
--- Get the length of the uncompressed buffer and do our thing
-decompress xs = maybe Nothing (unsafePerformIO . go) (unformat xs)
- where
- go (l, str) =
- U.unsafeUseAsCString str $ \cstr -> do
- out <- SI.createAndTrim l $ \p -> do
- r :: Int <- fromIntegral <$> c_LZ4_uncompress cstr p (fromIntegral l)
- --- NOTE: r is the count of bytes c_LZ4_uncompress read from
- --- input buffer, and NOT the count of bytes used in result
- --- buffer
- return $! if (r <= 0) then 0 else l
- return $! if (S.null out) then Nothing else (Just out)
-{-# INLINEABLE decompress #-}
-
---------------------------------------------------------------------------------
--- Utilities
-
--- | Pushes a Word32 and a ByteString into the format we use to correctly
--- encode/decode.
-format :: Word32 -> S.ByteString -> S.ByteString
-format l xs = write32LE l <> write32LE (fromIntegral $ S.length xs) <> xs
-
-write32LE :: Word32 -> S.ByteString
-write32LE w
- = S.pack [ fromIntegral (w `shiftR` 0) :: Word8
- , fromIntegral (w `shiftR` 8) :: Word8
- , fromIntegral (w `shiftR` 16) :: Word8
- , fromIntegral (w `shiftR` 24) :: Word8
- ]
-
--- | Gets a ByteString and it's length from the compressed format.
-unformat :: S.ByteString -> Maybe (Int, S.ByteString)
-unformat xs
- | S.length xs < 8 = Nothing -- Need at least 8 bytes
- | bsLen /= S.length rest = Nothing -- Header doesn't match real size
- | otherwise = Just (fromIntegral origLen, rest)
- where
- origLen = fromIntegral (read32LE l0 l1 l2 l3) :: Int
- bsLen = fromIntegral (read32LE s0 s1 s2 s3) :: Int
-
- [l0,l1,l2,l3] = S.unpack (S.take 4 xs)
- [s0,s1,s2,s3] = S.unpack (S.take 4 $ S.drop 4 xs)
- rest = S.drop 8 xs
-
-read32LE :: Word8 -> Word8 -> Word8 -> Word8 -> Word32
-read32LE x0 x1 x2 x3
- = fi x0 + (fi x1 `shiftL` 8) + (fi x2 `shiftL` 16) + (fi x3 `shiftL` 24)
- where fi = fromIntegral :: Word8 -> Word32
-
---------------------------------------------------------------------------------
--- FFI Bindings
-
--- | Worst case compression bounds on an input string.
-foreign import ccall unsafe "LZ4_compressBound"
- c_LZ4_compressBound :: CInt -> CInt
-
--- | Compresses a string.
-foreign import ccall unsafe "LZ4_compress"
- c_LZ4_compress :: Ptr a -- ^ Source
- -> Ptr b -- ^ Dest
- -> CInt -- ^ Input size
- -> IO CInt -- ^ Result
-
--- | Decompresses a string.
-foreign import ccall unsafe "LZ4_decompress_fast"
- c_LZ4_uncompress :: Ptr a -- ^ Source
- -> Ptr b -- ^ Dest
- -> CInt -- ^ Size of ORIGINAL INPUT
- -> IO CInt -- ^ Result