Commit 4ca0c8a1 authored by Andreas Klebinger's avatar Andreas Klebinger Committed by Marge Bot

Don't variable-length encode magic iface constant.

We changed to use variable length encodings for many types by default,
including Word32. This makes sense for numbers but not when Word32 is
meant to represent four bytes.

I added a FixedLengthEncoding newtype to Binary who's instances
interpret their argument as a collection of bytes instead of a number.

We then use this when writing/reading magic numbers to the iface file.

I also took the libery to remove the dummy iface field.

This fixes #18180.
parent 1b508a9e
Pipeline #19609 passed with stages
in 794 minutes and 15 seconds
......@@ -123,20 +123,9 @@ readBinIface_ dflags checkHiWay traceBinIFaceReading hi_path ncu = do
-- (This magic number does not change when we change
-- GHC interface file format)
magic <- get bh
wantedGot "Magic" (binaryInterfaceMagic platform) magic ppr
wantedGot "Magic" (binaryInterfaceMagic platform) magic (ppr . unFixedLength)
errorOnMismatch "magic number mismatch: old/corrupt interface file?"
(binaryInterfaceMagic platform) magic
-- Note [dummy iface field]
-- read a dummy 32/64 bit value. This field used to hold the
-- dictionary pointer in old interface file formats, but now
-- the dictionary pointer is after the version (where it
-- should be). Also, the serialisation of value of type "Bin
-- a" used to depend on the word size of the machine, now they
-- are always 32 bits.
case platformWordSize platform of
PW4 -> do _ <- Binary.get bh :: IO Word32; return ()
PW8 -> do _ <- Binary.get bh :: IO Word64; return ()
(unFixedLength $ binaryInterfaceMagic platform) (unFixedLength magic)
-- Check the interface file version and ways.
check_ver <- get bh
......@@ -198,13 +187,6 @@ writeBinIface dflags hi_path mod_iface = do
let platform = targetPlatform dflags
put_ bh (binaryInterfaceMagic platform)
-- dummy 32/64-bit field before the version/way for
-- compatibility with older interface file formats.
-- See Note [dummy iface field] above.
case platformWordSize platform of
PW4 -> Binary.put_ bh (0 :: Word32)
PW8 -> Binary.put_ bh (0 :: Word64)
-- The version and way descriptor go next
put_ bh (show hiVersion)
let way_descr = getWayDescr dflags
......@@ -290,10 +272,10 @@ putWithUserData log_action bh payload = do
initBinMemSize :: Int
initBinMemSize = 1024 * 1024
binaryInterfaceMagic :: Platform -> Word32
binaryInterfaceMagic :: Platform -> FixedLengthEncoding Word32
binaryInterfaceMagic platform
| target32Bit platform = 0x1face
| otherwise = 0x1face64
| target32Bit platform = FixedLengthEncoding 0x1face
| otherwise = FixedLengthEncoding 0x1face64
-- -----------------------------------------------------------------------------
......
......@@ -52,6 +52,9 @@ module GHC.Utils.Binary
putSLEB128,
getSLEB128,
-- * Fixed length encoding
FixedLengthEncoding(..),
-- * Lazy Binary I/O
lazyGet,
lazyPut,
......@@ -314,18 +317,18 @@ putWord8 h !w = putPrim h 1 (\op -> poke op w)
getWord8 :: BinHandle -> IO Word8
getWord8 h = getPrim h 1 peek
-- putWord16 :: BinHandle -> Word16 -> IO ()
-- putWord16 h w = putPrim h 2 (\op -> do
-- pokeElemOff op 0 (fromIntegral (w `shiftR` 8))
-- pokeElemOff op 1 (fromIntegral (w .&. 0xFF))
-- )
putWord16 :: BinHandle -> Word16 -> IO ()
putWord16 h w = putPrim h 2 (\op -> do
pokeElemOff op 0 (fromIntegral (w `shiftR` 8))
pokeElemOff op 1 (fromIntegral (w .&. 0xFF))
)
-- getWord16 :: BinHandle -> IO Word16
-- getWord16 h = getPrim h 2 (\op -> do
-- w0 <- fromIntegral <$> peekElemOff op 0
-- w1 <- fromIntegral <$> peekElemOff op 1
-- return $! w0 `shiftL` 8 .|. w1
-- )
getWord16 :: BinHandle -> IO Word16
getWord16 h = getPrim h 2 (\op -> do
w0 <- fromIntegral <$> peekElemOff op 0
w1 <- fromIntegral <$> peekElemOff op 1
return $! w0 `shiftL` 8 .|. w1
)
putWord32 :: BinHandle -> Word32 -> IO ()
putWord32 h w = putPrim h 4 (\op -> do
......@@ -348,38 +351,38 @@ getWord32 h = getPrim h 4 (\op -> do
w3
)
-- putWord64 :: BinHandle -> Word64 -> IO ()
-- putWord64 h w = putPrim h 8 (\op -> do
-- pokeElemOff op 0 (fromIntegral (w `shiftR` 56))
-- pokeElemOff op 1 (fromIntegral ((w `shiftR` 48) .&. 0xFF))
-- pokeElemOff op 2 (fromIntegral ((w `shiftR` 40) .&. 0xFF))
-- pokeElemOff op 3 (fromIntegral ((w `shiftR` 32) .&. 0xFF))
-- pokeElemOff op 4 (fromIntegral ((w `shiftR` 24) .&. 0xFF))
-- pokeElemOff op 5 (fromIntegral ((w `shiftR` 16) .&. 0xFF))
-- pokeElemOff op 6 (fromIntegral ((w `shiftR` 8) .&. 0xFF))
-- pokeElemOff op 7 (fromIntegral (w .&. 0xFF))
-- )
-- getWord64 :: BinHandle -> IO Word64
-- getWord64 h = getPrim h 8 (\op -> do
-- w0 <- fromIntegral <$> peekElemOff op 0
-- w1 <- fromIntegral <$> peekElemOff op 1
-- w2 <- fromIntegral <$> peekElemOff op 2
-- w3 <- fromIntegral <$> peekElemOff op 3
-- w4 <- fromIntegral <$> peekElemOff op 4
-- w5 <- fromIntegral <$> peekElemOff op 5
-- w6 <- fromIntegral <$> peekElemOff op 6
-- w7 <- fromIntegral <$> peekElemOff op 7
-- return $! (w0 `shiftL` 56) .|.
-- (w1 `shiftL` 48) .|.
-- (w2 `shiftL` 40) .|.
-- (w3 `shiftL` 32) .|.
-- (w4 `shiftL` 24) .|.
-- (w5 `shiftL` 16) .|.
-- (w6 `shiftL` 8) .|.
-- w7
-- )
putWord64 :: BinHandle -> Word64 -> IO ()
putWord64 h w = putPrim h 8 (\op -> do
pokeElemOff op 0 (fromIntegral (w `shiftR` 56))
pokeElemOff op 1 (fromIntegral ((w `shiftR` 48) .&. 0xFF))
pokeElemOff op 2 (fromIntegral ((w `shiftR` 40) .&. 0xFF))
pokeElemOff op 3 (fromIntegral ((w `shiftR` 32) .&. 0xFF))
pokeElemOff op 4 (fromIntegral ((w `shiftR` 24) .&. 0xFF))
pokeElemOff op 5 (fromIntegral ((w `shiftR` 16) .&. 0xFF))
pokeElemOff op 6 (fromIntegral ((w `shiftR` 8) .&. 0xFF))
pokeElemOff op 7 (fromIntegral (w .&. 0xFF))
)
getWord64 :: BinHandle -> IO Word64
getWord64 h = getPrim h 8 (\op -> do
w0 <- fromIntegral <$> peekElemOff op 0
w1 <- fromIntegral <$> peekElemOff op 1
w2 <- fromIntegral <$> peekElemOff op 2
w3 <- fromIntegral <$> peekElemOff op 3
w4 <- fromIntegral <$> peekElemOff op 4
w5 <- fromIntegral <$> peekElemOff op 5
w6 <- fromIntegral <$> peekElemOff op 6
w7 <- fromIntegral <$> peekElemOff op 7
return $! (w0 `shiftL` 56) .|.
(w1 `shiftL` 48) .|.
(w2 `shiftL` 40) .|.
(w3 `shiftL` 32) .|.
(w4 `shiftL` 24) .|.
(w5 `shiftL` 16) .|.
(w6 `shiftL` 8) .|.
w7
)
putByte :: BinHandle -> Word8 -> IO ()
putByte bh !w = putWord8 bh w
......@@ -512,6 +515,35 @@ getSLEB128 bh = do
let !signed = testBit byte 6
return (val',shift',signed)
-- -----------------------------------------------------------------------------
-- Fixed length encoding instances
-- Sometimes words are used to represent a certain bit pattern instead
-- of a number. Using FixedLengthEncoding we will write the pattern as
-- is to the interface file without the variable length encoding we usually
-- apply.
-- | Encode the argument in it's full length. This is different from many default
-- binary instances which make no guarantee about the actual encoding and
-- might do things use variable length encoding.
newtype FixedLengthEncoding a = FixedLengthEncoding { unFixedLength :: a }
instance Binary (FixedLengthEncoding Word8) where
put_ h (FixedLengthEncoding x) = putByte h x
get h = FixedLengthEncoding <$> getByte h
instance Binary (FixedLengthEncoding Word16) where
put_ h (FixedLengthEncoding x) = putWord16 h x
get h = FixedLengthEncoding <$> getWord16 h
instance Binary (FixedLengthEncoding Word32) where
put_ h (FixedLengthEncoding x) = putWord32 h x
get h = FixedLengthEncoding <$> getWord32 h
instance Binary (FixedLengthEncoding Word64) where
put_ h (FixedLengthEncoding x) = putWord64 h x
get h = FixedLengthEncoding <$> getWord64 h
-- -----------------------------------------------------------------------------
-- Primitive Word writes
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment