Commit dcd38ff7 authored by Simon Marlow's avatar Simon Marlow

Fix to i386_insert_ffrees (#2724, #1944)

The i386 native code generator has to arrange that the FPU stack is
clear on exit from any function that uses the FPU.  Unfortunately it
was getting this wrong (and has been ever since this code was written,
I think): it was looking for basic blocks that used the FPU and adding
the code to clear the FPU stack on any non-local exit from the block.
In fact it should be doing this on a whole-function basis, rather than
individual basic blocks.
parent e580dd58
......@@ -363,10 +363,7 @@ cmmNativeGen dflags us cmm count
x86fp_kludge :: NatCmmTop -> NatCmmTop
x86fp_kludge top@(CmmData _ _) = top
x86fp_kludge top@(CmmProc info lbl params (ListGraph code)) =
CmmProc info lbl params (ListGraph $ map bb_i386_insert_ffrees code)
where
bb_i386_insert_ffrees (BasicBlock id instrs) =
BasicBlock id (i386_insert_ffrees instrs)
CmmProc info lbl params (ListGraph $ i386_insert_ffrees code)
#endif
......
......@@ -557,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
......
Markdown is supported
0%
or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment