X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;ds=sidebyside;f=compiler%2FnativeGen%2FMachInstrs.hs;h=dc7731c4dd60c42356fde2dced1e5ad178712a31;hb=dcd38ff7690eb9bdfefc3e7b5c29b7269149df87;hp=716a52148eb82cf5daee88faa26d40d6b926a851;hpb=6ee9554a738c442719ded861504acb729fd3d431;p=ghc-hetmet.git diff --git a/compiler/nativeGen/MachInstrs.hs b/compiler/nativeGen/MachInstrs.hs index 716a521..dc7731c 100644 --- a/compiler/nativeGen/MachInstrs.hs +++ b/compiler/nativeGen/MachInstrs.hs @@ -43,6 +43,7 @@ module MachInstrs ( #include "HsVersions.h" +import BlockId import MachRegs import Cmm import MachOp ( MachRep(..) ) @@ -556,19 +557,19 @@ data Operand #endif /* i386 or x86_64 */ #if i386_TARGET_ARCH -i386_insert_ffrees :: [Instr] -> [Instr] -i386_insert_ffrees insns - | any is_G_instr insns - = concatMap ffree_before_nonlocal_transfers insns +i386_insert_ffrees :: [GenBasicBlock Instr] -> [GenBasicBlock Instr] +i386_insert_ffrees blocks + | or (map (any is_G_instr) [ instrs | BasicBlock id instrs <- blocks ]) + = map ffree_before_nonlocal_transfers blocks | otherwise - = insns - -ffree_before_nonlocal_transfers insn - = case insn of - CALL _ _ -> [GFREE, insn] - JMP _ -> [GFREE, insn] - other -> [insn] - + = blocks + where + ffree_before_nonlocal_transfers (BasicBlock id insns) + = BasicBlock id (foldr p [] insns) + where p insn r = case insn of + CALL _ _ -> GFREE : insn : r + JMP _ -> GFREE : insn : r + other -> insn : r -- if you ever add a new FP insn to the fake x86 FP insn set, -- you must update this too