[project @ 2000-01-26 13:40:54 by sewardj]

Observe the C conventions for use of the FP register stack.  In particular,
free up any live fp registers prior to non-local control transfers.  Sigh.

This is not good.  The FP situation needs to be reviewed once the rest
of x86 nativeGen is stable.

3 files changed, 53 insertions, 12 deletions

diff --git a/ghc/compiler/nativeGen/AsmCodeGen.lhs b/ghc/compiler/nativeGen/AsmCodeGen.lhs
index 13a59ef22b..7da3a0b884 100644
--- a/ghc/compiler/nativeGen/AsmCodeGen.lhs
+++ b/ghc/compiler/nativeGen/AsmCodeGen.lhs
@@ -6,6 +6,7 @@
 module AsmCodeGen ( nativeCodeGen ) where
 
 #include "HsVersions.h"
+#include "nativeGen/NCG.h"
 
 import IO		( Handle )
 import List		( intersperse )
@@ -26,10 +27,10 @@ import PrimRep		( isFloatingRep )
 import UniqSupply	( returnUs, thenUs, mapUs, initUs, 
                           initUs_, UniqSM, UniqSupply )
 import UniqFM		( UniqFM, emptyUFM, addToUFM, lookupUFM )
+import MachMisc		( IF_ARCH_i386(i386_insert_ffrees,) )
+
 import Outputable	
 
-import GlaExts (trace) --tmp
-#include "nativeGen/NCG.h"
 \end{code}
 
 The 96/03 native-code generator has machine-independent and
@@ -97,7 +98,11 @@ codeGen :: [[StixTree]] -> UniqSM SDoc
 codeGen stixFinal
   = mapUs genMachCode stixFinal	`thenUs` \ dynamic_codes ->
     let
-	static_instrss = scheduleMachCode dynamic_codes
+        fp_kludge :: [Instr] -> [Instr]
+        fp_kludge = IF_ARCH_i386(i386_insert_ffrees,id)
+
+        static_instrss :: [[Instr]]
+	static_instrss = map fp_kludge (scheduleMachCode dynamic_codes)
         docs           = map (vcat . map pprInstr) static_instrss       
     in
     returnUs (vcat (intersperse (char ' ' 
diff --git a/ghc/compiler/nativeGen/MachMisc.lhs b/ghc/compiler/nativeGen/MachMisc.lhs
index 0487b7249b..867495b9b8 100644
--- a/ghc/compiler/nativeGen/MachMisc.lhs
+++ b/ghc/compiler/nativeGen/MachMisc.lhs
@@ -24,8 +24,9 @@ module MachMisc (
 
 	Instr(..),  IF_ARCH_i386(Operand(..) COMMA,)
 	Cond(..),
-	Size(..)
-	
+	Size(..),
+        IF_ARCH_i386(i386_insert_ffrees COMMA,)	
+
 #if alpha_TARGET_ARCH
 	, RI(..)
 #endif
@@ -41,7 +42,7 @@ module MachMisc (
 
 import AbsCSyn		( MagicId(..) ) 
 import AbsCUtils	( magicIdPrimRep )
-import CLabel           ( CLabel )
+import CLabel           ( CLabel, isAsmTemp )
 import Const		( mkMachInt, Literal(..) )
 import MachRegs		( stgReg, callerSaves, RegLoc(..),
 			  Imm(..), Reg(..), 
@@ -76,7 +77,7 @@ fmtAsmLbl s
      -}
      '$' : s
      ,{-otherwise-}
-     s
+     '.':'L':s
      )
 
 ---------------------------
@@ -514,6 +515,7 @@ current translation.
 
               -- all the 3-operand fake fp insns are src1 src2 dst
               -- and furthermore are constrained to be fp regs only.
+              -- IMPORTANT: keep is_G_insn up to date with any changes here
     	      | GMOV	      Reg Reg -- src(fpreg), dst(fpreg)
               | GLD           Size MachRegsAddr Reg -- src, dst(fpreg)
               | GST           Size Reg MachRegsAddr -- src(fpreg), dst
@@ -538,6 +540,7 @@ current translation.
     	      | GNEG	      Size Reg Reg -- src, dst
     	      | GSQRT	      Size Reg Reg -- src, dst
 
+              | GFREE         -- do ffree on all x86 regs; an ugly hack
 -- Comparison
 
 	      | TEST          Size Operand Operand
@@ -566,6 +569,38 @@ data Operand
   | OpImm  Imm	        -- immediate value
   | OpAddr MachRegsAddr	-- memory reference
 
+
+i386_insert_ffrees :: [Instr] -> [Instr]
+i386_insert_ffrees insns
+   | any is_G_instr insns
+   = concatMap ffree_before_nonlocal_transfers insns
+   | otherwise
+   = insns
+
+ffree_before_nonlocal_transfers insn
+   = case insn of
+        CALL _                                      -> [GFREE, insn]
+        JMP (OpImm (ImmCLbl clbl)) | isAsmTemp clbl -> [insn]
+        JMP _                                       -> [GFREE, insn]
+        other                                       -> [insn]
+
+
+-- if you ever add a new FP insn to the fake x86 FP insn set,
+-- you must update this too
+is_G_instr :: Instr -> Bool
+is_G_instr instr
+   = case instr of
+        GMOV _ _ -> True; GLD _ _ _ -> True; GST _ _ _ -> True;
+        GFTOD _ _ -> True; GFTOI _ _ -> True;
+        GDTOF _ _ -> True; GDTOI _ _ -> True;
+        GITOF _ _ -> True; GITOD _ _ -> True;
+	GADD _ _ _ _ -> True; GDIV _ _ _ _ -> True
+	GSUB _ _ _ _ -> True; GMUL _ _ _ _ -> True
+    	GCMP _ _ _ -> True; GABS _ _ _ -> True
+    	GNEG _ _ _ -> True; GSQRT _ _ _ -> True
+        GFREE -> panic "is_G_instr: GFREE (!)"
+        other -> False
+
 #endif {- i386_TARGET_ARCH -}
 \end{code}
 
diff --git a/ghc/compiler/nativeGen/PprMach.lhs b/ghc/compiler/nativeGen/PprMach.lhs
index 13d8dfb770..7f72f4d0ca 100644
--- a/ghc/compiler/nativeGen/PprMach.lhs
+++ b/ghc/compiler/nativeGen/PprMach.lhs
@@ -998,12 +998,8 @@ pprInstr (JXX cond lab) = pprCondInstr SLIT("j") cond (pprCLabel_asm lab)
 
 pprInstr (JMP (OpImm imm)) = (<>) (ptext SLIT("\tjmp ")) (pprImm imm)
 pprInstr (JMP op) = (<>) (ptext SLIT("\tjmp *")) (pprOperand L op)
-
 pprInstr (CALL imm)
-   = vcat [ ptext SLIT("\tffree %st(0) ;ffree %st(1) ;ffree %st(2) ;ffree %st(3)"),
-            ptext SLIT("\tffree %st(4) ;ffree %st(5) ;ffree %st(6) ;ffree %st(7)"),
-            hcat [ ptext SLIT("\tcall "), pprImm imm ]
-          ]
+   = (<>) (ptext SLIT("\tcall ")) (pprImm imm)
 
 
 -- Simulating a flat register set on the x86 FP stack is tricky.
@@ -1070,6 +1066,11 @@ pprInstr g@(GDIV sz src1 src2 dst)
                    text " ; fdiv ", greg src2 1, text ",%st(0)",
                    gsemi, gpop dst 1])
 
+pprInstr GFREE 
+   = vcat [ ptext SLIT("\tffree %st(0) ;ffree %st(1) ;ffree %st(2) ;ffree %st(3)"),
+            ptext SLIT("\tffree %st(4) ;ffree %st(5) ;ffree %st(6) ;ffree %st(7)") 
+          ]
+
 --------------------------
 gpush reg offset
    = hcat [text "ffree %st(7) ; fld ", greg reg offset]