From 296388e81bd8557449a2027f8e8fa664307b5944 Mon Sep 17 00:00:00 2001
From: Simon Marlow <marlowsd@gmail.com>
Date: Wed, 4 May 2011 10:58:38 +0100
Subject: [PATCH] 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,
-- 
1.7.10.4