From 4163e2a0d42200d184727892c965a59189992993 Mon Sep 17 00:00:00 2001 From: Simon Marlow Date: Mon, 8 Jan 2007 15:10:06 +0000 Subject: [PATCH] fix version checking of .hi files I broke it during my recent interface-file overhaul --- compiler/iface/BinIface.hs | 55 ++++++++++++++++++++++++++------------------ 1 file changed, 32 insertions(+), 23 deletions(-) diff --git a/compiler/iface/BinIface.hs b/compiler/iface/BinIface.hs index 782bada..f32049e 100644 --- a/compiler/iface/BinIface.hs +++ b/compiler/iface/BinIface.hs @@ -62,10 +62,36 @@ readBinIface_ hi_path nc = do throwDyn (ProgramError ( "magic number mismatch: old/corrupt interface file?")) + -- Get the dictionary pointer. We won't attempt to actually + -- read the dictionary until we've done the version checks below, + -- just in case this isn't a valid interface. In retrospect the + -- version should have come before the dictionary pointer, but this + -- is the way it was done originally, and we can't change it now. + dict_p <- Binary.get bh -- Get the dictionary ptr + + -- Check the interface file version and ways. + check_ver <- get bh + let our_ver = show opt_HiVersion + when (check_ver /= our_ver) $ + -- This will be caught by readIface which will emit an error + -- msg containing the iface module name. + throwDyn (ProgramError ( + "mismatched interface file versions: expected " + ++ our_ver ++ ", found " ++ check_ver)) + + check_way <- get bh + ignore_way <- readIORef v_IgnoreHiWay + way_descr <- getWayDescr + when (not ignore_way && check_way /= way_descr) $ + -- This will be caught by readIface + -- which will emit an error msg containing the iface module name. + throwDyn (ProgramError ( + "mismatched interface file ways: expected " + ++ way_descr ++ ", found " ++ check_way)) + -- Read the dictionary -- The next word in the file is a pointer to where the dictionary is -- (probably at the end of the file) - dict_p <- Binary.get bh -- Get the dictionary ptr data_p <- tellBin bh -- Remember where we are now seekBin bh dict_p dict <- getDictionary bh @@ -95,6 +121,11 @@ writeBinIface dflags hi_path mod_iface = do dict_p_p <- tellBin bh put_ bh dict_p_p -- Placeholder for ptr to dictionary + -- The version and way descriptor go next + put_ bh (show opt_HiVersion) + way_descr <- getWayDescr + put bh way_descr + -- Remember where the symbol table pointer will go symtab_p_p <- tellBin bh put_ bh symtab_p_p @@ -263,9 +294,6 @@ instance Binary ModIface where mi_fam_insts = fam_insts, mi_rules = rules, mi_rule_vers = rule_vers }) = do - put_ bh (show opt_HiVersion) - way_descr <- getWayDescr - put bh way_descr put_ bh mod put_ bh is_boot put_ bh mod_vers @@ -284,25 +312,6 @@ instance Binary ModIface where put_ bh rule_vers get bh = do - check_ver <- get bh - let our_ver = show opt_HiVersion - when (check_ver /= our_ver) $ - -- use userError because this will be caught by readIface - -- which will emit an error msg containing the iface module name. - throwDyn (ProgramError ( - "mismatched interface file versions: expected " - ++ our_ver ++ ", found " ++ check_ver)) - - check_way <- get bh - ignore_way <- readIORef v_IgnoreHiWay - way_descr <- getWayDescr - when (not ignore_way && check_way /= way_descr) $ - -- use userError because this will be caught by readIface - -- which will emit an error msg containing the iface module name. - throwDyn (ProgramError ( - "mismatched interface file ways: expected " - ++ way_descr ++ ", found " ++ check_way)) - mod_name <- get bh is_boot <- get bh mod_vers <- get bh -- 1.7.10.4