Repository : ssh://darcs.haskell.org//srv/darcs/ghc On branch : master
http://hackage.haskell.org/trac/ghc/changeset/296388e81bd8557449a2027f8e8fa664307b5944 >--------------------------------------------------------------- commit 296388e81bd8557449a2027f8e8fa664307b5944 Author: Simon Marlow <[email protected]> Date: Wed May 4 10:58:38 2011 +0100 The fix for #4914 was wrong and broke other things (see #5149). We can't emit the ffrees before a conditional jump, because we don't want to ffree the stack registers if the jump isn't taken (d'oh). This commit fixes it properly, by moving the pass that inserts the ffrees to *before* we do the jump-shortcutting which introduces the conditional non-local jumps. >--------------------------------------------------------------- compiler/nativeGen/AsmCodeGen.lhs | 38 +++++++++++++++++++++--------------- compiler/nativeGen/X86/Instr.hs | 2 +- 2 files changed, 23 insertions(+), 17 deletions(-) diff --git a/compiler/nativeGen/AsmCodeGen.lhs b/compiler/nativeGen/AsmCodeGen.lhs index 06e6d6d..27858dc 100644 --- a/compiler/nativeGen/AsmCodeGen.lhs +++ b/compiler/nativeGen/AsmCodeGen.lhs @@ -372,10 +372,25 @@ cmmNativeGen dflags us cmm count , Nothing , mPprStats) - ---- generate jump tables + ---- x86fp_kludge. This pass inserts ffree instructions to clear + ---- the FPU stack on x86. The x86 ABI requires that the FPU stack + ---- is clear, and library functions can return odd results if it + ---- isn't. + ---- + ---- NB. must happen before shortcutBranches, because that + ---- generates JXX_GBLs which we can't fix up in x86fp_kludge. + let kludged = +#if i386_TARGET_ARCH + {-# SCC "x86fp_kludge" #-} + map x86fp_kludge alloced +#else + alloced +#endif + + ---- generate jump tables let tabled = {-# SCC "generateJumpTables" #-} - alloced ++ generateJumpTables alloced + generateJumpTables kludged ---- shortcut branches let shorted = @@ -387,27 +402,18 @@ cmmNativeGen dflags us cmm count {-# SCC "sequenceBlocks" #-} map sequenceTop shorted - ---- x86fp_kludge - let kludged = -#if i386_TARGET_ARCH - {-# SCC "x86fp_kludge" #-} - map x86fp_kludge sequenced -#else - sequenced -#endif - - ---- expansion of SPARC synthetic instrs + ---- expansion of SPARC synthetic instrs #if sparc_TARGET_ARCH let expanded = {-# SCC "sparc_expand" #-} - map expandTop kludged + map expandTop sequenced dumpIfSet_dyn dflags Opt_D_dump_asm_expanded "Synthetic instructions expanded" (vcat $ map (docToSDoc . pprNatCmmTop) expanded) #else let expanded = - kludged + sequenced #endif return ( usAlloc @@ -615,8 +621,8 @@ makeFarBranches = id generateJumpTables :: [NatCmmTop Instr] -> [NatCmmTop Instr] generateJumpTables xs = concatMap f xs - where f (CmmProc _ _ (ListGraph xs)) = concatMap g xs - f _ = [] + where f p@(CmmProc _ _ (ListGraph xs)) = p : concatMap g xs + f p = [p] g (BasicBlock _ xs) = catMaybes (map generateJumpTableForInstr xs) -- ----------------------------------------------------------------------------- diff --git a/compiler/nativeGen/X86/Instr.hs b/compiler/nativeGen/X86/Instr.hs index e934a6d..92655d1 100644 --- a/compiler/nativeGen/X86/Instr.hs +++ b/compiler/nativeGen/X86/Instr.hs @@ -746,7 +746,7 @@ i386_insert_ffrees blocks where p insn r = case insn of CALL _ _ -> GFREE : insn : r JMP _ -> GFREE : insn : r - JXX_GBL _ _ -> GFREE : insn : r + JXX_GBL _ _ -> panic "i386_insert_ffrees: cannot handle JXX_GBL" _ -> insn : r -- if you ever add a new FP insn to the fake x86 FP insn set, _______________________________________________ Cvs-ghc mailing list [email protected] http://www.haskell.org/mailman/listinfo/cvs-ghc
