[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.

diff --git a/ghc/compiler/nativeGen/AsmCodeGen.lhs b/ghc/compiler/nativeGen/AsmCodeGen.lhs
index 13a59ef..7da3a0b 100644 (file)
--- 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 0487b72..867495b 100644 (file)
--- 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 13d8dfb..7f72f4d 100644 (file)
--- 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]