[project @ 2002-03-13 11:27:11 by simonmar]

[ghc-hetmet.git] / ghc / compiler / utils / Binary.hs

diff --git a/ghc/compiler/utils/Binary.hs b/ghc/compiler/utils/Binary.hs
index cea5c0f..7609ff4 100644 (file)
--- a/ghc/compiler/utils/Binary.hs
+++ b/ghc/compiler/utils/Binary.hs
@@ -53,6 +53,7 @@ module Binary
 import {-# SOURCE #-} Module
 import FastString
 import Unique
+import Panic
 import UniqFM
 
 #if __GLASGOW_HASKELL__ < 503
@@ -83,7 +84,7 @@ import Data.IORef
 import Data.Char               ( ord, chr )
 import Data.Array.Base         ( unsafeRead, unsafeWrite )
 import Control.Monad           ( when )
-import Control.Exception       ( throw )
+import Control.Exception       ( throw, throwDyn )
 import System.IO as IO
 import System.IO.Unsafe                ( unsafeInterleaveIO )
 import System.IO.Error         ( mkIOError, eofErrorType )
@@ -620,6 +621,10 @@ undef = error "Binary.BinHandleState"
 getBinFileWithDict :: Binary a => FilePath -> IO a
 getBinFileWithDict file_path = do
   bh <- Binary.readBinMem file_path
+  magic <- get bh
+  when (magic /= binaryInterfaceMagic) $
+       throwDyn (ProgramError (
+          "magic number mismatch: old/corrupt interface file?"))
   dict_p <- Binary.get bh              -- get the dictionary ptr
   data_p <- tellBin bh
   seekBin bh dict_p
@@ -630,9 +635,12 @@ getBinFileWithDict file_path = do
 
 initBinMemSize = (1024*1024) :: Int
 
+binaryInterfaceMagic = 0x1face :: Word32
+
 putBinFileWithDict :: Binary a => FilePath -> Module -> a -> IO ()
 putBinFileWithDict file_path mod a = do
   bh <- openBinMem initBinMemSize mod
+  put_ bh binaryInterfaceMagic
   p <- tellBin bh
   put_ bh p            -- placeholder for ptr to dictionary
   put_ bh a