Matthew Pickering pushed to branch wip/bytecode-header at Glasgow Haskell Compiler / GHC

Commits:

3 changed files:

Changes:

  • compiler/GHC/ByteCode/Serialize.hs
    ... ... @@ -30,6 +30,7 @@ import GHC.Data.FastString
    30 30 
     import GHC.Driver.Env
    31 31 
     import GHC.Iface.Binary
    32 32 
     import GHC.Prelude
    33 
    +import GHC.Settings.Constants (hiVersion)
    33 34 
     import GHC.Types.Name
    34 35 
     import GHC.Types.Name.Cache
    35 36 
     import GHC.Types.SrcLoc
    ... ... @@ -49,6 +50,7 @@ import GHC.Linker.Types
    49 50 
     import System.IO.Unsafe (unsafeInterleaveIO)
    50 51 
     import GHC.Utils.Outputable
    51 52 
     import GHC.Types.Name.Env
    53 
    +import Data.Char
    52 54
    53 55 
     {- Note [Overview of persistent bytecode]
    54 56 
     ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    ... ... @@ -85,7 +87,19 @@ The ticket where bytecode objects were dicussed is #26298
    85 87
    86 88 
     See Note [-fwrite-byte-code is not the default]
    87 89 
     See Note [Recompilation avoidance with bytecode objects]
    88 
    -
    90 
    +See Note [Persistent bytecode file headers]
    91 
    +
    92 
    +Note [Persistent bytecode file headers]
    93 
    +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    94 
    +Persistent bytecode files (`.gbc`) and bytecode libraries (`.bytecodelib`)
    95 
    +are version-specific binary formats. Without a small file-level header, stale
    96 
    +or corrupt files are only discovered once we start deserialising the payload,
    97 
    +which can lead to confusing failures.
    98 
    +
    99 
    +To make these failures explicit, we write a file-kind-specific magic word and
    100 
    +the current `hiVersion` ahead of the binary payload. Readers validate this
    101 
    +header before setting up the normal `Name`/`FastString` deserialisation
    102 
    +machinery. This follows the same approach as normal interface files.
    89 103 
     -}
    90 104
    91 105 
     -- | The on-disk representation of a bytecode object for a specific module.
    ... ... @@ -162,12 +176,14 @@ writeBytecodeLib lib path = do
    162 176 
       createDirectoryIfMissing True (takeDirectory path)
    163 177 
       bh' <- openBinMem (1024 * 1024)
    164 178 
       bh <- addBinNameWriter bh'
    179 
    +  writePersistentBytecodeHeader BytecodeLibraryFile bh
    165 180 
       putWithUserData QuietBinIFace NormalCompression bh odbco
    166 181 
       writeBinMem bh path
    167 182
    168 183 
     readBytecodeLib :: HscEnv -> FilePath -> IO OnDiskBytecodeLib
    169 184 
     readBytecodeLib hsc_env path = do
    170 185 
       bh' <- readBinMem path
    186 
    +  readPersistentBytecodeHeader BytecodeLibraryFile path bh'
    171 187 
       bh <- addBinNameReader hsc_env bh'
    172 188 
       res <- getWithUserData (hsc_NC hsc_env) bh
    173 189 
       pure res
    ... ... @@ -269,6 +285,7 @@ readBinByteCode hsc_env f = do
    269 285 
     readOnDiskModuleByteCode :: HscEnv -> FilePath -> IO OnDiskModuleByteCode
    270 286 
     readOnDiskModuleByteCode hsc_env f = do
    271 287 
       bh' <- readBinMem f
    288 
    +  readPersistentBytecodeHeader ModuleByteCodeFile f bh'
    272 289 
       bh <- addBinNameReader hsc_env bh'
    273 290 
       getWithUserData (hsc_NC hsc_env) bh
    274 291
    ... ... @@ -279,9 +296,60 @@ writeBinByteCode f cbc = do
    279 296 
       bh' <- openBinMem (1024 * 1024)
    280 297 
       bh <- addBinNameWriter bh'
    281 298 
       odbco <- encodeOnDiskModuleByteCode cbc
    299 
    +  writePersistentBytecodeHeader ModuleByteCodeFile bh
    282 300 
       putWithUserData QuietBinIFace NormalCompression bh odbco
    283 301 
       writeBinMem bh f
    284 302
    303 
    +data PersistentBytecodeFile
    304 
    +  = ModuleByteCodeFile
    305 
    +  | BytecodeLibraryFile
    306 
    +
    307 
    +
    308 
    +-- See Note [Persistent bytecode file headers]
    309 
    +writePersistentBytecodeHeader :: PersistentBytecodeFile -> WriteBinHandle -> IO ()
    310 
    +writePersistentBytecodeHeader file_kind bh = do
    311 
    +  put_ bh (persistentBytecodeMagic file_kind)
    312 
    +  put_ bh (show hiVersion)
    313 
    +
    314 
    +readPersistentBytecodeHeader :: PersistentBytecodeFile -> FilePath -> ReadBinHandle -> IO ()
    315 
    +readPersistentBytecodeHeader file_kind path bh = do
    316 
    +  let mismatch what expected actual =
    317 
    +        throwGhcExceptionIO $ ProgramError $
    318 
    +          persistentBytecodeFileDescription file_kind ++ " header mismatch in " ++ path ++
    319 
    +          ": " ++ what ++ " (expected " ++ expected ++ ", got " ++ actual ++ ")"
    320 
    +
    321 
    +  magic <- get bh
    322 
    +  let expected_magic = persistentBytecodeMagic file_kind
    323 
    +  if unFixedLength magic == unFixedLength expected_magic
    324 
    +    then pure ()
    325 
    +    else mismatch "magic" (show $ unFixedLength expected_magic) (show $ unFixedLength magic)
    326 
    +
    327 
    +  version <- get bh
    328 
    +  let expected_version = show hiVersion
    329 
    +  if version == expected_version
    330 
    +    then pure ()
    331 
    +    else mismatch "version" expected_version version
    332 
    +
    333 
    +persistentBytecodeFileDescription :: PersistentBytecodeFile -> String
    334 
    +persistentBytecodeFileDescription ModuleByteCodeFile = "bytecode file"
    335 
    +persistentBytecodeFileDescription BytecodeLibraryFile = "bytecode library"
    336 
    +
    337 
    +persistentBytecodeMagic :: PersistentBytecodeFile -> FixedLengthEncoding Word32
    338 
    +persistentBytecodeMagic file_kind =
    339 
    +  case file_kind of
    340 
    +    ModuleByteCodeFile -> asciiWord32 "gbc0"
    341 
    +    BytecodeLibraryFile -> asciiWord32 "bcl0"
    342 
    +
    343 
    +-- | Encode a 4-letter word into a single Word32.
    344 
    +asciiWord32 :: String -> FixedLengthEncoding Word32
    345 
    +asciiWord32 [a, b, c, d] =
    346 
    +  FixedLengthEncoding $
    347 
    +    (fromIntegral (ord a) `shiftL` 24) .|.
    348 
    +    (fromIntegral (ord b) `shiftL` 16) .|.
    349 
    +    (fromIntegral (ord c) `shiftL` 8)  .|.
    350 
    +    fromIntegral (ord d)
    351 
    +asciiWord32 _ = error "asciiWord32: expected exactly four ASCII characters"
    352 
    +
    285 353 
     instance Binary CompiledByteCode where
    286 354 
       get bh = do
    287 355 
         bc_bcos <- get bh

  • testsuite/tests/driver/bytecode-object/Makefile
    ... ... @@ -159,3 +159,9 @@ bytecode_object25:
    159 159 
     	"$(TEST_HC)" $(TEST_HC_OPTS) -c BytecodeForeign.hs -fbyte-code -fwrite-byte-code -fwrite-interface $(ghciWayFlags)
    160 160 
     	"$(TEST_HC)" $(TEST_HC_OPTS_INTERACTIVE) -v1 -fno-hide-source-paths  -fbyte-code -fwrite-byte-code -fwrite-interface BytecodeForeign.hs -e "testForeign"
    161 161
    162 
    +# Test that corrupt bytecode file headers are rejected clearly.
    163 
    +bytecode_object26:
    164 
    +	"$(TEST_HC)" $(TEST_HC_OPTS) -c BytecodeTest.hs -fbyte-code -fwrite-byte-code
    165 
    +	@printf 'bad!' | dd of=BytecodeTest.gbc bs=1 count=4 conv=notrunc 2>/dev/null
    166 
    +	! "$(TEST_HC)" $(TEST_HC_OPTS) -c -bytecodelib -o linked.bytecode BytecodeTest.gbc 2> bytecode_object26.stderr
    167 
    +	@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'])
    26 26 
     test('bytecode_object23', bytecode_opts, makefile_test, ['bytecode_object23'])
    27 27 
     test('bytecode_object24', bytecode_opts + [copy_files], makefile_test, ['bytecode_object24'])
    28 28 
     test('bytecode_object25', [bytecode_opts, req_interp, extra_files(['BytecodeForeign.hs', 'BytecodeForeign.c'])], makefile_test, ['bytecode_object25'])
    29 
    +test('bytecode_object26', [bytecode_opts], makefile_test, ['bytecode_object26'])

    • —
    View it on GitLab.
    You're receiving this email because of your account on gitlab.haskell.org. Manage all notifications · Help