X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2Futils%2FBinary.hs;h=7609ff46d855d91a5ab97e1825c4427e20759b79;hb=950c1ecaffcb6e8d7cefb20b8372691182c6c304;hp=207394b88ffd9a2132eebd35a430f60a9d7f089d;hpb=354f17ec86e2e11f2e77a159916b2e7be74979c9;p=ghc-hetmet.git

diff --git a/ghc/compiler/utils/Binary.hs b/ghc/compiler/utils/Binary.hs
index 207394b..7609ff4 100644
--- 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 )
@@ -91,6 +92,7 @@ import GHC.Real			( Ratio(..) )
 import GHC.Exts
 import GHC.IOBase	 	( IO(..) )
 import GHC.Word			( Word8(..) )
+import GHC.Handle		( openFileEx, IOModeEx(..) )
 #endif
 
 #if __GLASGOW_HASKELL__ < 503
@@ -619,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
@@ -629,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