Matthew Pickering pushed to branch wip/bytecode-header at Glasgow Haskell Compiler / GHC Commits: 026705c8 by Matthew Pickering at 2026-03-23T14:04:01+00:00 bytecode: Add magic header/version to bytecode files In order to avoid confusing errors when using stale interface files (ie from an older compiler version), we add a simple header/version check like the one for interface files. Fixes #27068 - - - - - 3 changed files: - compiler/GHC/ByteCode/Serialize.hs - testsuite/tests/driver/bytecode-object/Makefile - testsuite/tests/driver/bytecode-object/all.T Changes: ===================================== compiler/GHC/ByteCode/Serialize.hs ===================================== @@ -30,6 +30,7 @@ import GHC.Data.FastString import GHC.Driver.Env import GHC.Iface.Binary import GHC.Prelude +import GHC.Settings.Constants (hiVersion) import GHC.Types.Name import GHC.Types.Name.Cache import GHC.Types.SrcLoc @@ -49,6 +50,7 @@ import GHC.Linker.Types import System.IO.Unsafe (unsafeInterleaveIO) import GHC.Utils.Outputable import GHC.Types.Name.Env +import Data.Char {- Note [Overview of persistent bytecode] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -85,7 +87,19 @@ The ticket where bytecode objects were dicussed is #26298 See Note [-fwrite-byte-code is not the default] See Note [Recompilation avoidance with bytecode objects] - +See Note [Persistent bytecode file headers] + +Note [Persistent bytecode file headers] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Persistent bytecode files (`.gbc`) and bytecode libraries (`.bytecodelib`) +are version-specific binary formats. Without a small file-level header, stale +or corrupt files are only discovered once we start deserialising the payload, +which can lead to confusing failures. + +To make these failures explicit, we write a file-kind-specific magic word and +the current `hiVersion` ahead of the binary payload. Readers validate this +header before setting up the normal `Name`/`FastString` deserialisation +machinery. This follows the same approach as normal interface files. -} -- | The on-disk representation of a bytecode object for a specific module. @@ -162,12 +176,14 @@ writeBytecodeLib lib path = do createDirectoryIfMissing True (takeDirectory path) bh' <- openBinMem (1024 * 1024) bh <- addBinNameWriter bh' + writePersistentBytecodeHeader BytecodeLibraryFile bh putWithUserData QuietBinIFace NormalCompression bh odbco writeBinMem bh path readBytecodeLib :: HscEnv -> FilePath -> IO OnDiskBytecodeLib readBytecodeLib hsc_env path = do bh' <- readBinMem path + readPersistentBytecodeHeader BytecodeLibraryFile path bh' bh <- addBinNameReader hsc_env bh' res <- getWithUserData (hsc_NC hsc_env) bh pure res @@ -269,6 +285,7 @@ readBinByteCode hsc_env f = do readOnDiskModuleByteCode :: HscEnv -> FilePath -> IO OnDiskModuleByteCode readOnDiskModuleByteCode hsc_env f = do bh' <- readBinMem f + readPersistentBytecodeHeader ModuleByteCodeFile f bh' bh <- addBinNameReader hsc_env bh' getWithUserData (hsc_NC hsc_env) bh @@ -279,9 +296,60 @@ writeBinByteCode f cbc = do bh' <- openBinMem (1024 * 1024) bh <- addBinNameWriter bh' odbco <- encodeOnDiskModuleByteCode cbc + writePersistentBytecodeHeader ModuleByteCodeFile bh putWithUserData QuietBinIFace NormalCompression bh odbco writeBinMem bh f +data PersistentBytecodeFile + = ModuleByteCodeFile + | BytecodeLibraryFile + + +-- See Note [Persistent bytecode file headers] +writePersistentBytecodeHeader :: PersistentBytecodeFile -> WriteBinHandle -> IO () +writePersistentBytecodeHeader file_kind bh = do + put_ bh (persistentBytecodeMagic file_kind) + put_ bh (show hiVersion) + +readPersistentBytecodeHeader :: PersistentBytecodeFile -> FilePath -> ReadBinHandle -> IO () +readPersistentBytecodeHeader file_kind path bh = do + let mismatch what expected actual = + throwGhcExceptionIO $ ProgramError $ + persistentBytecodeFileDescription file_kind ++ " header mismatch in " ++ path ++ + ": " ++ what ++ " (expected " ++ expected ++ ", got " ++ actual ++ ")" + + magic <- get bh + let expected_magic = persistentBytecodeMagic file_kind + if unFixedLength magic == unFixedLength expected_magic + then pure () + else mismatch "magic" (show $ unFixedLength expected_magic) (show $ unFixedLength magic) + + version <- get bh + let expected_version = show hiVersion + if version == expected_version + then pure () + else mismatch "version" expected_version version + +persistentBytecodeFileDescription :: PersistentBytecodeFile -> String +persistentBytecodeFileDescription ModuleByteCodeFile = "bytecode file" +persistentBytecodeFileDescription BytecodeLibraryFile = "bytecode library" + +persistentBytecodeMagic :: PersistentBytecodeFile -> FixedLengthEncoding Word32 +persistentBytecodeMagic file_kind = + case file_kind of + ModuleByteCodeFile -> asciiWord32 "gbc0" + BytecodeLibraryFile -> asciiWord32 "bcl0" + +-- | Encode a 4-letter word into a single Word32. +asciiWord32 :: String -> FixedLengthEncoding Word32 +asciiWord32 [a, b, c, d] = + FixedLengthEncoding $ + (fromIntegral (ord a) `shiftL` 24) .|. + (fromIntegral (ord b) `shiftL` 16) .|. + (fromIntegral (ord c) `shiftL` 8) .|. + fromIntegral (ord d) +asciiWord32 _ = error "asciiWord32: expected exactly four ASCII characters" + instance Binary CompiledByteCode where get bh = do bc_bcos <- get bh ===================================== testsuite/tests/driver/bytecode-object/Makefile ===================================== @@ -159,3 +159,9 @@ bytecode_object25: "$(TEST_HC)" $(TEST_HC_OPTS) -c BytecodeForeign.hs -fbyte-code -fwrite-byte-code -fwrite-interface $(ghciWayFlags) "$(TEST_HC)" $(TEST_HC_OPTS_INTERACTIVE) -v1 -fno-hide-source-paths -fbyte-code -fwrite-byte-code -fwrite-interface BytecodeForeign.hs -e "testForeign" +# Test that corrupt bytecode file headers are rejected clearly. +bytecode_object26: + "$(TEST_HC)" $(TEST_HC_OPTS) -c BytecodeTest.hs -fbyte-code -fwrite-byte-code + @printf 'bad!' | dd of=BytecodeTest.gbc bs=1 count=4 conv=notrunc 2>/dev/null + ! "$(TEST_HC)" $(TEST_HC_OPTS) -c -bytecodelib -o linked.bytecode BytecodeTest.gbc 2> bytecode_object26.stderr + @grep -F "bytecode file header mismatch" bytecode_object26.stderr >/dev/null ===================================== testsuite/tests/driver/bytecode-object/all.T ===================================== @@ -26,3 +26,4 @@ test('bytecode_object22', bytecode_opts, makefile_test, ['bytecode_object22']) test('bytecode_object23', bytecode_opts, makefile_test, ['bytecode_object23']) test('bytecode_object24', bytecode_opts + [copy_files], makefile_test, ['bytecode_object24']) test('bytecode_object25', [bytecode_opts, req_interp, extra_files(['BytecodeForeign.hs', 'BytecodeForeign.c'])], makefile_test, ['bytecode_object25']) +test('bytecode_object26', [bytecode_opts], makefile_test, ['bytecode_object26']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/026705c82ccc68c82c6e9ede735a6fa1... -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/026705c82ccc68c82c6e9ede735a6fa1... You're receiving this email because of your account on gitlab.haskell.org.