Fix to i386_insert_ffrees (#2724, #1944)
authorSimon Marlow <marlowsd@gmail.com>
Tue, 11 Nov 2008 12:56:19 +0000 (12:56 +0000)
committerSimon Marlow <marlowsd@gmail.com>
Tue, 11 Nov 2008 12:56:19 +0000 (12:56 +0000)
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.

compiler/nativeGen/AsmCodeGen.lhs
compiler/nativeGen/MachInstrs.hs

index 126d1b8..4d03a28 100644 (file)
@@ -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
 
 
index 00317ee..dc7731c 100644 (file)
@@ -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