diff options
| author | Ben Gamari <ben@smart-cactus.org> | 2016-05-23 15:32:12 +0200 |
|---|---|---|
| committer | Ben Gamari <ben@smart-cactus.org> | 2016-05-23 17:23:49 +0200 |
| commit | 9bb277269ec020f138fe70a65f5972466113ab61 (patch) | |
| tree | a283447f9931ddd0b462dc23945cbe51127a785e /compiler/utils | |
| parent | 785b38ff4326f3cd9cf2097bf9967e7fd66995cd (diff) | |
| download | haskell-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.hs | 37 | ||||
| -rw-r--r-- | compiler/utils/LZ4.hs | 126 |
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 |
