diff --git a/ghc/compiler/nativeGen/AsmCodeGen.lhs b/ghc/compiler/nativeGen/AsmCodeGen.lhs
index 9309d475db021d0dbc2d337f39713db1fce505e0..13a59ef22be04b135aa6f5569be55910bca39461 100644
--- a/ghc/compiler/nativeGen/AsmCodeGen.lhs
+++ b/ghc/compiler/nativeGen/AsmCodeGen.lhs
@@ -84,18 +84,10 @@ nativeCodeGen :: AbstractC -> UniqSupply -> (SDoc, SDoc)
 nativeCodeGen absC us
    = let (stixRaw, us1) = initUs us (genCodeAbstractC absC)
          stixOpt        = map (map genericOpt) stixRaw
-         stixFinal      = map x86floatFix stixOpt
-         insns          = initUs_ us1 (codeGen stixFinal)
-         debug_stix     = vcat (map pprStixTrees stixFinal)
+         insns          = initUs_ us1 (codeGen stixOpt)
+         debug_stix     = vcat (map pprStixTrees stixOpt)
      in 
          (debug_stix, insns)
-
-#if i386_TARGET_ARCH
-x86floatFix = floatFix
-#else
-x86floatFix = id
-#endif
-
 \end{code}
 
 @codeGen@ is the top-level code-generation function:
@@ -108,7 +100,10 @@ codeGen stixFinal
 	static_instrss = scheduleMachCode dynamic_codes
         docs           = map (vcat . map pprInstr) static_instrss       
     in
-    returnUs (vcat (intersperse (char ' ' $$ char ' ') docs))
+    returnUs (vcat (intersperse (char ' ' 
+                                 $$ text "# ___stg_split_marker" 
+                                 $$ char ' ') 
+                    docs))
 \end{code}
 
 Top level code generator for a chunk of stix code:
@@ -292,64 +287,3 @@ Anything else is just too hard.
 \begin{code}
 primOpt op args = StPrim op args
 \end{code}
-
------------------------------------------------------------------------------
-Fix up floating point operations for x86.
-
-The problem is that the code generator can't handle the weird register
-naming scheme for floating point registers on the x86, so we have to
-deal with memory-resident floating point values wherever possible.
-
-We therefore can't stand references to floating-point kinded temporary
-variables, and try to translate them into memory addresses wherever
-possible.
-
-\begin{code}
-floatFix :: [StixTree] -> [StixTree]
-floatFix trees = fltFix emptyUFM trees
-
-fltFix 	:: UniqFM StixTree	-- mapping tmp vars to memory locations
-      	-> [StixTree]
-	-> [StixTree]
-fltFix locs [] = []
-
--- The case we're interested in: loading a temporary from a memory
--- address.  Eliminate the instruction and replace all future references
--- to the temporary with the memory address.
-fltFix locs ((StAssign rep (StReg (StixTemp uq _)) loc) : trees)
-  | isFloatingRep rep  = fltFix (addToUFM locs uq loc) trees
-
-fltFix locs ((StAssign rep src dst) : trees)
-  = StAssign rep (fltFix1 locs src) (fltFix1 locs dst) : fltFix locs trees
-  
-fltFix locs (tree : trees)
-  = fltFix1 locs tree : fltFix locs trees
-
-
-fltFix1 :: UniqFM StixTree -> StixTree -> StixTree
-fltFix1 locs r@(StReg (StixTemp uq rep))
-  | isFloatingRep rep = case lookupUFM locs uq of
-			 	Nothing   -> panic "fltFix1"
-				Just tree -> tree
-
-fltFix1 locs (StIndex rep l r) =
-  StIndex rep (fltFix1 locs l) (fltFix1 locs r)
-
-fltFix1 locs (StInd rep tree) =
-  StInd rep (fltFix1 locs tree)
-
-fltFix1 locs (StAssign rep dst src) = panic "fltFix1: StAssign"
-
-fltFix1 locs (StJump tree) = StJump (fltFix1 locs tree)
-
-fltFix1 locs (StCondJump lbl tree) =
-  StCondJump lbl (fltFix1 locs tree)
-
-fltFix1 locs (StPrim op trees) = 
-  StPrim op (map (fltFix1 locs) trees)
-
-fltFix1 locs (StCall f conv rep trees) =
-  StCall f conv rep (map (fltFix1 locs) trees)
- 
-fltFix1 locs tree = tree
-\end{code}
diff --git a/ghc/compiler/nativeGen/MachCode.lhs b/ghc/compiler/nativeGen/MachCode.lhs
index 86d3c319848033260a0cefe39b92de5dae088587..7ba0869e08bf76a13184ae4bfaab93052575588d 100644
--- a/ghc/compiler/nativeGen/MachCode.lhs
+++ b/ghc/compiler/nativeGen/MachCode.lhs
@@ -247,7 +247,7 @@ getRegister (StCall fn cconv kind args)
     returnUs (Fixed kind reg call)
   where
     reg = if isFloatingRep kind
-	  then IF_ARCH_alpha( f0, IF_ARCH_i386( st0, IF_ARCH_sparc( f0,)))
+	  then IF_ARCH_alpha( f0, IF_ARCH_i386( fake0, IF_ARCH_sparc( f0,)))
 	  else IF_ARCH_alpha( v0, IF_ARCH_i386( eax, IF_ARCH_sparc( o0,)))
 
 getRegister (StString s)
@@ -505,42 +505,32 @@ getRegister leaf
 -- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
 #if i386_TARGET_ARCH
 
-getRegister (StDouble 0.0)
-  = let
-    	code dst = mkSeqInstrs [FLDZ]
-    in
-    returnUs (Any DoubleRep code)
-
-getRegister (StDouble 1.0)
-  = let
-    	code dst = mkSeqInstrs [FLD1]
-    in
-    returnUs (Any DoubleRep code)
-
 getRegister (StDouble d)
   = getUniqLabelNCG 	    	    `thenUs` \ lbl ->
-    --getNewRegNCG PtrRep    	    `thenUs` \ tmp ->
     let code dst = mkSeqInstrs [
     	    SEGMENT DataSegment,
 	    LABEL lbl,
 	    DATA DF [ImmDouble d],
 	    SEGMENT TextSegment,
-	    FLD DF (OpImm (ImmCLbl lbl))
+	    GLD DF (ImmAddr (ImmCLbl lbl) 0) dst
 	    ]
     in
     returnUs (Any DoubleRep code)
 
+
 getRegister (StPrim primop [x]) -- unary PrimOps
   = case primop of
       IntNegOp  -> trivialUCode (NEGI L) x
-
       NotOp	-> trivialUCode (NOT L) x
 
-      FloatNegOp  -> trivialUFCode FloatRep FCHS x
-      FloatSqrtOp -> trivialUFCode FloatRep FSQRT x
-      DoubleNegOp -> trivialUFCode DoubleRep FCHS x
+      FloatNegOp  -> trivialUFCode FloatRep  (GNEG F) x
+      DoubleNegOp -> trivialUFCode DoubleRep (GNEG DF) x
+
+      FloatSqrtOp  -> trivialUFCode FloatRep  (GSQRT F) x
+      DoubleSqrtOp -> trivialUFCode DoubleRep (GSQRT DF) x
 
-      DoubleSqrtOp -> trivialUFCode DoubleRep FSQRT x
+      Double2FloatOp -> trivialUFCode FloatRep  GDTOF x
+      Float2DoubleOp -> trivialUFCode DoubleRep GFTOD x
 
       OrdOp -> coerceIntCode IntRep x
       ChrOp -> chrCode x
@@ -550,14 +540,11 @@ getRegister (StPrim primop [x]) -- unary PrimOps
       Double2IntOp -> coerceFP2Int x
       Int2DoubleOp -> coerceInt2FP DoubleRep x
 
-      Double2FloatOp -> coerceFltCode x
-      Float2DoubleOp -> coerceFltCode x
-
       other_op ->
         let
-	    fixed_x = if is_float_op  -- promote to double
-			  then StPrim Float2DoubleOp [x]
-			  else x
+	    fixed_x = if   is_float_op  -- promote to double
+		      then StPrim Float2DoubleOp [x]
+		      else x
 	in
 	getRegister (StCall fn cCallConv DoubleRep [x])
        where
@@ -651,15 +638,15 @@ getRegister (StPrim primop [x, y]) -- dyadic PrimOps
       IntRemOp  -> quot_code L x y False{-remainder-}
       IntMulOp  -> trivialCode (IMUL L) x y {-True-}
 
-      FloatAddOp -> trivialFCode  FloatRep  FADD FADD  FADDP FADDP  x y
-      FloatSubOp -> trivialFCode  FloatRep  FSUB FSUBR FSUBP FSUBRP x y
-      FloatMulOp -> trivialFCode  FloatRep  FMUL FMUL  FMULP FMULP  x y
-      FloatDivOp -> trivialFCode  FloatRep  FDIV FDIVR FDIVP FDIVRP x y
+      FloatAddOp -> trivialFCode  FloatRep  GADD x y
+      FloatSubOp -> trivialFCode  FloatRep  GSUB x y
+      FloatMulOp -> trivialFCode  FloatRep  GMUL x y
+      FloatDivOp -> trivialFCode  FloatRep  GDIV x y
 
-      DoubleAddOp -> trivialFCode DoubleRep FADD FADD  FADDP FADDP  x y
-      DoubleSubOp -> trivialFCode DoubleRep FSUB FSUBR FSUBP FSUBRP x y
-      DoubleMulOp -> trivialFCode DoubleRep FMUL FMUL  FMULP FMULP  x y
-      DoubleDivOp -> trivialFCode DoubleRep FDIV FDIVR FDIVP FDIVRP x y
+      DoubleAddOp -> trivialFCode DoubleRep GADD x y
+      DoubleSubOp -> trivialFCode DoubleRep GSUB x y
+      DoubleMulOp -> trivialFCode DoubleRep GMUL x y
+      DoubleDivOp -> trivialFCode DoubleRep GDIV x y
 
       AndOp -> trivialCode (AND L) x y {-True-}
       OrOp  -> trivialCode (OR L)  x y {-True-}
@@ -673,18 +660,23 @@ getRegister (StPrim primop [x, y]) -- dyadic PrimOps
       SllOp -> shift_code (SHL L) x y {-False-}
       SrlOp -> shift_code (SHR L) x y {-False-}
 
-      ISllOp -> shift_code (SHL L) x y {-False-}  --was:panic "I386Gen:isll"
-      ISraOp -> shift_code (SAR L) x y {-False-}  --was:panic "I386Gen:isra"
-      ISrlOp -> shift_code (SHR L) x y {-False-}  --was:panic "I386Gen:isrl"
+      ISllOp -> shift_code (SHL L) x y {-False-}
+      ISraOp -> shift_code (SAR L) x y {-False-}
+      ISrlOp -> shift_code (SHR L) x y {-False-}
 
-      FloatPowerOp  -> getRegister (StCall SLIT("pow") cCallConv DoubleRep [promote x, promote y])
+      FloatPowerOp  -> getRegister (StCall SLIT("pow") cCallConv DoubleRep 
+                                           [promote x, promote y])
 		       where promote x = StPrim Float2DoubleOp [x]
-      DoublePowerOp -> getRegister (StCall SLIT("pow") cCallConv DoubleRep [x, y])
+      DoublePowerOp -> getRegister (StCall SLIT("pow") cCallConv DoubleRep 
+                                           [x, y])
   where
+
+    --------------------
     shift_code :: (Operand -> Operand -> Instr)
 	       -> StixTree
 	       -> StixTree
 	       -> UniqSM Register
+
       {- Case1: shift length as immediate -}
       -- Code is the same as the first eq. for trivialCode -- sigh.
     shift_code instr x y{-amount-}
@@ -715,7 +707,6 @@ getRegister (StPrim primop [x, y]) -- dyadic PrimOps
     shift_code instr x y{-amount-}
      = getRegister y		`thenUs` \ register1 ->  
        getRegister x		`thenUs` \ register2 ->
---       getNewRegNCG IntRep	`thenUs` \ dst ->
        let
 	-- Note: we force the shift length to be loaded
 	-- into ECX, so that we can use CL when shifting.
@@ -740,6 +731,7 @@ getRegister (StPrim primop [x, y]) -- dyadic PrimOps
        in
        returnUs (Fixed IntRep eax code__2)
 
+    --------------------
     add_code :: Size -> StixTree -> StixTree -> UniqSM Register
 
     add_code sz x (StInt y)
@@ -749,51 +741,13 @@ getRegister (StPrim primop [x, y]) -- dyadic PrimOps
 	    code = registerCode register tmp
 	    src1 = registerName register tmp
 	    src2 = ImmInt (fromInteger y)
-	    code__2 dst = code .
-			  mkSeqInstr (LEA sz (OpAddr (AddrBaseIndex (Just src1) Nothing src2)) (OpReg dst))
-	in
-	returnUs (Any IntRep code__2)
-{-
-    add_code sz x (StInd _ mem)
-      = getRegister x		`thenUs` \ register1 ->
-	--getNewRegNCG (registerRep register1)
-	--			`thenUs` \ tmp1 ->
-	getAmode mem		`thenUs` \ amode ->
-	let
-	    code2 = amodeCode amode
-	    src2  = amodeAddr amode
-
-	    code__2 dst = let code1 = registerCode register1 dst
-			      src1  = registerName register1 dst
-			  in asmParThen [code2 asmVoid,code1 asmVoid] .
-			     if isFixed register1 && src1 /= dst
-			     then mkSeqInstrs [MOV L (OpReg src1) (OpReg dst),
-					       ADD sz (OpAddr src2)  (OpReg dst)]
-			     else
-				    mkSeqInstrs [ADD sz (OpAddr src2) (OpReg src1)]
+	    code__2 dst 
+               = code .
+		 mkSeqInstr (LEA sz (OpAddr (AddrBaseIndex (Just src1) Nothing src2)) 
+                                    (OpReg dst))
 	in
 	returnUs (Any IntRep code__2)
 
-    add_code sz (StInd _ mem) y
-      = getRegister y		`thenUs` \ register2 ->
-	--getNewRegNCG (registerRep register2)
-	--			`thenUs` \ tmp2 ->
-	getAmode mem		`thenUs` \ amode ->
-	let
-	    code1 = amodeCode amode
-	    src1  = amodeAddr amode
-
-	    code__2 dst = let code2 = registerCode register2 dst
-			      src2  = registerName register2 dst
-			  in asmParThen [code1 asmVoid,code2 asmVoid] .
-			     if isFixed register2 && src2 /= dst
-			     then mkSeqInstrs [MOV L (OpReg src2) (OpReg dst),
-					       ADD sz (OpAddr src1)  (OpReg dst)]
-			     else
-				    mkSeqInstrs [ADD sz (OpAddr src1) (OpReg src2)]
-	in
-	returnUs (Any IntRep code__2)
--}
     add_code sz x y
       = getRegister x		`thenUs` \ register1 ->
 	getRegister y		`thenUs` \ register2 ->
@@ -804,8 +758,11 @@ getRegister (StPrim primop [x, y]) -- dyadic PrimOps
 	    src1  = registerName register1 tmp1
 	    code2 = registerCode register2 tmp2 asmVoid
 	    src2  = registerName register2 tmp2
-	    code__2 dst = asmParThen [code1, code2] .
-			  mkSeqInstr (LEA sz (OpAddr (AddrBaseIndex (Just src1) (Just (src2,1)) (ImmInt 0))) (OpReg dst))
+	    code__2 dst 
+               = asmParThen [code1, code2] .
+		 mkSeqInstr (LEA sz (OpAddr (AddrBaseIndex (Just src1) (Just (src2,1)) 
+                                                           (ImmInt 0))) 
+                                    (OpReg dst))
 	in
 	returnUs (Any IntRep code__2)
 
@@ -819,8 +776,10 @@ getRegister (StPrim primop [x, y]) -- dyadic PrimOps
 	    code = registerCode register tmp
 	    src1 = registerName register tmp
 	    src2 = ImmInt (-(fromInteger y))
-	    code__2 dst = code .
-			  mkSeqInstr (LEA sz (OpAddr (AddrBaseIndex (Just src1) Nothing src2)) (OpReg dst))
+	    code__2 dst 
+               = code .
+		 mkSeqInstr (LEA sz (OpAddr (AddrBaseIndex (Just src1) Nothing src2))
+                                    (OpReg dst))
 	in
 	returnUs (Any IntRep code__2)
 
@@ -863,10 +822,14 @@ getRegister (StPrim primop [x, y]) -- dyadic PrimOps
 	    src2    = ImmInt (fromInteger i)
 	    code__2 = asmParThen [code1] .
 		      mkSeqInstrs [-- we put src2 in (ebx)
-				   MOV L (OpImm src2) (OpAddr (AddrBaseIndex (Just ebx) Nothing (ImmInt OFFSET_R1))),
-				   MOV L (OpReg src1) (OpReg eax),
-				   CLTD,
-				   IDIV sz (OpAddr (AddrBaseIndex (Just ebx) Nothing (ImmInt OFFSET_R1)))]
+		         MOV L (OpImm src2) 
+                               (OpAddr (AddrBaseIndex (Just ebx) Nothing 
+                                                      (ImmInt OFFSET_R1))),
+			 MOV L (OpReg src1) (OpReg eax),
+			 CLTD,
+			 IDIV sz (OpAddr (AddrBaseIndex (Just ebx) Nothing 
+                                         (ImmInt OFFSET_R1)))
+                      ]
 	in
 	returnUs (Fixed IntRep (if is_division then eax else edx) code__2)
 
@@ -882,14 +845,20 @@ getRegister (StPrim primop [x, y]) -- dyadic PrimOps
 	    src2    = registerName register2 tmp2
 	    code__2 = asmParThen [code1, code2] .
 		      if src2 == ecx || src2 == esi
-		      then mkSeqInstrs [ MOV L (OpReg src1) (OpReg eax),
-					 CLTD,
-					 IDIV sz (OpReg src2)]
+		      then mkSeqInstrs [ 
+                              MOV L (OpReg src1) (OpReg eax),
+			      CLTD,
+			      IDIV sz (OpReg src2)
+                           ]
 		      else mkSeqInstrs [ -- we put src2 in (ebx)
-					 MOV L (OpReg src2) (OpAddr (AddrBaseIndex (Just ebx) Nothing (ImmInt OFFSET_R1))),
-					 MOV L (OpReg src1) (OpReg eax),
-					 CLTD,
-					 IDIV sz (OpAddr (AddrBaseIndex (Just ebx) Nothing (ImmInt OFFSET_R1)))]
+			      MOV L (OpReg src2) 
+                                    (OpAddr (AddrBaseIndex (Just ebx) Nothing 
+                                                           (ImmInt OFFSET_R1))),
+			      MOV L (OpReg src1) (OpReg eax),
+			      CLTD,
+			      IDIV sz (OpAddr (AddrBaseIndex (Just ebx) Nothing 
+                                                             (ImmInt OFFSET_R1)))
+                           ]
 	in
 	returnUs (Fixed IntRep (if is_division then eax else edx) code__2)
 	-----------------------
@@ -898,16 +867,15 @@ getRegister (StInd pk mem)
   = getAmode mem    	    	    `thenUs` \ amode ->
     let
     	code = amodeCode amode
-    	src   = amodeAddr amode
+    	src  = amodeAddr amode
     	size = primRepToSize pk
     	code__2 dst = code .
 		      if pk == DoubleRep || pk == FloatRep
-		      then mkSeqInstr (FLD {-DF-} size (OpAddr src))
+		      then mkSeqInstr (GLD size src dst)
 		      else mkSeqInstr (MOV size (OpAddr src) (OpReg dst))
     in
     	returnUs (Any pk code__2)
 
-
 getRegister (StInt i)
   = let
     	src = ImmInt (fromInteger i)
@@ -1485,26 +1453,6 @@ condIntCode cond x y
     returnUs (CondCode False cond code__2)
 
 -----------
-
-condFltCode cond x (StDouble 0.0)
-  = getRegister x		`thenUs` \ register1 ->
-    getNewRegNCG (registerRep register1)
-      	    	        	`thenUs` \ tmp1 ->
-    let
-    	pk1   = registerRep register1
-    	code1 = registerCode register1 tmp1
-    	src1  = registerName register1 tmp1
-
-    	code__2 = asmParThen [code1 asmVoid] .
-    	    	  mkSeqInstrs [FTST, FSTP DF (OpReg st0), -- or FLDZ, FUCOMPP ?
-			       FNSTSW,
-			       --AND HB (OpImm (ImmInt 68)) (OpReg eax),
-			       --XOR HB (OpImm (ImmInt 64)) (OpReg eax)
-			       SAHF
-			      ]
-    in
-    returnUs (CondCode True (fix_FP_cond cond) code__2)
-
 condFltCode cond x y
   = getRegister x		`thenUs` \ register1 ->
     getRegister y		`thenUs` \ register2 ->
@@ -1512,35 +1460,33 @@ condFltCode cond x y
       	    	        	`thenUs` \ tmp1 ->
     getNewRegNCG (registerRep register2)
      	    	        	`thenUs` \ tmp2 ->
+    getNewRegNCG DoubleRep	`thenUs` \ tmp ->
     let
     	pk1   = registerRep register1
     	code1 = registerCode register1 tmp1
     	src1  = registerName register1 tmp1
 
+    	pk2   = registerRep register2
     	code2 = registerCode register2 tmp2
     	src2  = registerName register2 tmp2
 
-    	code__2 = asmParThen [code2 asmVoid, code1 asmVoid] .
-    	    	  mkSeqInstrs [FUCOMPP,
-			       FNSTSW,
-			       --AND HB (OpImm (ImmInt 68)) (OpReg eax),
-			       --XOR HB (OpImm (ImmInt 64)) (OpReg eax)
-			       SAHF
-			      ]
+    	code__2 =   asmParThen [code1 asmVoid, code2 asmVoid] .
+    	    	    mkSeqInstr (GCMP (primRepToSize pk1) src1 src2)
+
+        {- On the 486, the flags set by FP compare are the unsigned ones!
+           (This looks like a HACK to me.  WDP 96/03)
+        -}
+        fix_FP_cond :: Cond -> Cond
+
+        fix_FP_cond GE  = GEU
+        fix_FP_cond GTT  = GU
+        fix_FP_cond LTT  = LU
+        fix_FP_cond LE  = LEU
+        fix_FP_cond any = any
     in
     returnUs (CondCode True (fix_FP_cond cond) code__2)
 
-{- On the 486, the flags set by FP compare are the unsigned ones!
-   (This looks like a HACK to me.  WDP 96/03)
--}
-
-fix_FP_cond :: Cond -> Cond
 
-fix_FP_cond GE  = GEU
-fix_FP_cond GTT  = GU
-fix_FP_cond LTT  = LU
-fix_FP_cond LE  = LEU
-fix_FP_cond any = any
 
 #endif {- i386_TARGET_ARCH -}
 -- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
@@ -1798,7 +1744,6 @@ assignFltCode pk (StInd pk_dst dst) (StInd pk_src src)
   = getNewRegNCG IntRep       	    `thenUs` \ tmp ->
     getAmode src    	    	    `thenUs` \ amodesrc ->
     getAmode dst    	    	    `thenUs` \ amodedst ->
-    --getRegister src	    	    	    `thenUs` \ register ->
     let
     	codesrc1 = amodeCode amodesrc asmVoid
     	addrsrc1 = amodeAddr amodesrc
@@ -1819,38 +1764,38 @@ assignFltCode pk (StInd pk_dst dst) (StInd pk_src src)
     returnUs code__2
 
 assignFltCode pk (StInd _ dst) src
-  = --getNewRegNCG pk        	    `thenUs` \ tmp ->
+  = getNewRegNCG pk        	    `thenUs` \ tmp ->
     getAmode dst    	    	    `thenUs` \ amode ->
-    getRegister src	    	    	    `thenUs` \ register ->
+    getRegister src	    	    `thenUs` \ register ->
     let
     	sz      = primRepToSize pk
     	dst__2  = amodeAddr amode
 
     	code1   = amodeCode amode asmVoid
-    	code2   = registerCode register {-tmp-}st0 asmVoid
+    	code2   = registerCode register tmp asmVoid
 
-    	--src__2= registerName register tmp
-    	pk__2   = registerRep register
-    	sz__2   = primRepToSize pk__2
+    	src__2  = registerName register tmp
 
     	code__2 = asmParThen [code1, code2] .
-		  mkSeqInstr (FSTP sz (OpAddr dst__2))
+		  mkSeqInstr (GST sz src__2 dst__2)
     in
     returnUs code__2
 
 assignFltCode pk dst src
   = getRegister dst	    	    	    `thenUs` \ register1 ->
     getRegister src	    	    	    `thenUs` \ register2 ->
-    --getNewRegNCG (registerRep register2)
-    --	    	        	    `thenUs` \ tmp ->
+    getNewRegNCG pk                         `thenUs` \ tmp ->
     let
-    	sz      = primRepToSize pk
-    	dst__2  = registerName register1 st0 --tmp
-
-    	code    = registerCode register2 dst__2
+        -- the register which is dst
+    	dst__2  = registerName register1 tmp
+        -- the register into which src is computed, preferably dst__2
     	src__2  = registerName register2 dst__2
+        -- code to compute src into src__2
+    	code    = registerCode register2 dst__2
 
-    	code__2 = code
+    	code__2 = if isFixed register2
+                  then code . mkSeqInstr (GMOV src__2 dst__2)
+                  else code
     in
     returnUs code__2
 
@@ -2345,22 +2290,23 @@ genCCall fn cconv kind args
     get_call_arg arg
       = get_op arg		`thenUs` \ (code, op, sz) ->
         case sz of
-           DF -> returnUs (sz,
+           DF -> --getNewRegNCG DoubleRep `thenUs` \ tmp ->
+                 returnUs (sz,
                            code .
-                           mkSeqInstr (FLD L op) .
+                           --mkSeqInstr (GLD DF op tmp) .
                            mkSeqInstr (SUB L (OpImm (ImmInt 8)) (OpReg esp)) .
-                           mkSeqInstr (FSTP DF (OpAddr (AddrBaseIndex 
+                           mkSeqInstr (GST DF {-tmp-}op (AddrBaseIndex 
                                                           (Just esp) 
-                                                          Nothing (ImmInt 0))))
+                                                          Nothing (ImmInt 0)))
                           )
 	   _  -> returnUs (sz,
-                           code . mkSeqInstr (PUSH sz op))
+                           code . mkSeqInstr (PUSH sz (OpReg op)))
 
     ------------
     get_op
 	:: StixTree
-	-> UniqSM (InstrBlock,Operand, Size)	-- code, operator, size
-
+	-> UniqSM (InstrBlock, {-Operand-}Reg, Size)	-- code, operator, size
+{-
     get_op (StInt i)
       = returnUs (asmParThen [], OpImm (ImmInt (fromInteger i)), L)
 
@@ -2372,7 +2318,7 @@ genCCall fn cconv kind args
 	    sz	 = primRepToSize pk
 	in
 	returnUs (code, OpAddr addr, sz)
-
+-}
     get_op op
       = getRegister op		`thenUs` \ register ->
 	getNewRegNCG (registerRep register)
@@ -2383,7 +2329,7 @@ genCCall fn cconv kind args
 	    pk   = registerRep  register
 	    sz   = primRepToSize pk
 	in
-	returnUs (code, OpReg reg, sz)
+	returnUs (code, {-OpReg-} reg, sz)
 
 #endif {- i386_TARGET_ARCH -}
 -- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
@@ -2665,12 +2611,7 @@ trivialFCode
     :: PrimRep
     -> IF_ARCH_alpha((Reg -> Reg -> Reg -> Instr)
       ,IF_ARCH_sparc((Size -> Reg -> Reg -> Reg -> Instr)
-      ,IF_ARCH_i386 (
-	      {-this bizarre type for i386 seems a little too weird (WDP 96/03)-}
-	       (Size -> Operand -> Instr)
-	    -> (Size -> Operand -> Instr) {-reversed instr-}
-	    -> Instr {-pop-}
-	    -> Instr {-reversed instr: pop-}
+      ,IF_ARCH_i386 ((Size -> Reg -> Reg -> Reg -> Instr)
       ,)))
     -> StixTree -> StixTree -- the two arguments
     -> UniqSM Register
@@ -2686,7 +2627,7 @@ trivialUCode
 trivialUFCode
     :: PrimRep
     -> IF_ARCH_alpha((Reg -> Reg -> Instr)
-      ,IF_ARCH_i386 (Instr
+      ,IF_ARCH_i386 ((Reg -> Reg -> Instr)
       ,IF_ARCH_sparc((Reg -> Reg -> Instr)
       ,)))
     -> StixTree -- the one argument
@@ -2767,7 +2708,6 @@ trivialUFCode _ instr x
 trivialCode instr x y
   | maybeToBool imm
   = getRegister x		`thenUs` \ register1 ->
-    --getNewRegNCG IntRep	`thenUs` \ tmp1 ->
     let
     	code__2 dst = let code1 = registerCode register1 dst
     	                  src1  = registerName register1 dst
@@ -2786,7 +2726,6 @@ trivialCode instr x y
 trivialCode instr x y
   | maybeToBool imm
   = getRegister y		`thenUs` \ register1 ->
-    --getNewRegNCG IntRep	`thenUs` \ tmp1 ->
     let
     	code__2 dst = let code1 = registerCode register1 dst
 			  src1  = registerName register1 dst
@@ -2801,48 +2740,10 @@ trivialCode instr x y
   where
     imm = maybeImm x
     imm__2 = case imm of Just x -> x
-{-
-trivialCode instr x (StInd pk mem)
-  = getRegister x		`thenUs` \ register ->
-    --getNewRegNCG IntRep	`thenUs` \ tmp ->
-    getAmode mem		`thenUs` \ amode ->
-    let
-    	code2 = amodeCode amode asmVoid
-    	src2  = amodeAddr amode
-    	code__2 dst = let code1 = registerCode register dst asmVoid
-			  src1  = registerName register dst
-		      in asmParThen [code1, code2] .
-			 if isFixed register && src1 /= dst
-			 then mkSeqInstrs [MOV L (OpReg src1) (OpReg dst),
-					   instr (OpAddr src2)  (OpReg dst)]
-			 else
-				mkSeqInstr (instr (OpAddr src2) (OpReg src1))
-    in
-    returnUs (Any pk code__2)
 
-trivialCode instr (StInd pk mem) y
-  = getRegister y		`thenUs` \ register ->
-    --getNewRegNCG IntRep	`thenUs` \ tmp ->
-    getAmode mem		`thenUs` \ amode ->
-    let
-    	code2 = amodeCode amode asmVoid
-    	src2  = amodeAddr amode
-    	code__2 dst = let
-    	                  code1 = registerCode register dst asmVoid
-    	                  src1  = registerName register dst
-		      in asmParThen [code1, code2] .
-			 if isFixed register && src1 /= dst
-			 then mkSeqInstrs [MOV L (OpReg src1) (OpReg dst),
-					   instr (OpAddr src2)  (OpReg dst)]
-			 else
-				mkSeqInstr (instr (OpAddr src2) (OpReg src1))
-    in
-    returnUs (Any pk code__2)
--}
 trivialCode instr x y
   = getRegister x		`thenUs` \ register1 ->
     getRegister y		`thenUs` \ register2 ->
-    --getNewRegNCG IntRep	`thenUs` \ tmp1 ->
     getNewRegNCG IntRep		`thenUs` \ tmp2 ->
     let
     	code2 = registerCode register2 tmp2 asmVoid
@@ -2862,7 +2763,6 @@ trivialCode instr x y
 -----------
 trivialUCode instr x
   = getRegister x		`thenUs` \ register ->
---    getNewRegNCG IntRep	`thenUs` \ tmp ->
     let
     	code__2 dst = let
     	                  code = registerCode register dst
@@ -2875,10 +2775,9 @@ trivialUCode instr x
     returnUs (Any IntRep code__2)
 
 -----------
+{-
 trivialFCode pk _ instrr _ _ (StInd pk' mem) y
   = getRegister y		`thenUs` \ register2 ->
-    --getNewRegNCG (registerRep register2)
-    --				`thenUs` \ tmp2 ->
     getAmode mem		`thenUs` \ amode ->
     let
     	code1 = amodeCode amode
@@ -2894,8 +2793,6 @@ trivialFCode pk _ instrr _ _ (StInd pk' mem) y
 
 trivialFCode pk instr _ _ _ x (StInd pk' mem)
   = getRegister x		`thenUs` \ register1 ->
-    --getNewRegNCG (registerRep register1)
-    --				`thenUs` \ tmp1 ->
     getAmode mem		`thenUs` \ amode ->
     let
     	code2 = amodeCode amode
@@ -2912,10 +2809,6 @@ trivialFCode pk instr _ _ _ x (StInd pk' mem)
 trivialFCode pk _ _ _ instrpr x y
   = getRegister x		`thenUs` \ register1 ->
     getRegister y		`thenUs` \ register2 ->
-    --getNewRegNCG (registerRep register1)
-    --				`thenUs` \ tmp1 ->
-    --getNewRegNCG (registerRep register2)
-    --				`thenUs` \ tmp2 ->
     getNewRegNCG DoubleRep	`thenUs` \ tmp ->
     let
     	pk1   = registerRep register1
@@ -2931,8 +2824,38 @@ trivialFCode pk _ _ _ instrpr x y
     	    	         mkSeqInstr instrpr
     in
     returnUs (Any pk1 code__2)
+-}
+
+trivialFCode pk instr x y
+  = getRegister x		`thenUs` \ register1 ->
+    getRegister y		`thenUs` \ register2 ->
+    getNewRegNCG DoubleRep	`thenUs` \ tmp1 ->
+    getNewRegNCG DoubleRep	`thenUs` \ tmp2 ->
+    let
+    	code1 = registerCode register1 tmp1
+    	src1  = registerName register1 tmp1
+
+    	code2 = registerCode register2 tmp2
+    	src2  = registerName register2 tmp2
+
+    	code__2 dst = asmParThen [code1 asmVoid, code2 asmVoid] .
+    	    	      mkSeqInstr (instr (primRepToSize pk) src1 src2 dst)
+    in
+    returnUs (Any DoubleRep code__2)
+
 
 -------------
+trivialUFCode pk instr x
+  = getRegister x		`thenUs` \ register ->
+    getNewRegNCG pk		`thenUs` \ tmp ->
+    let
+    	code = registerCode register tmp
+    	src  = registerName register tmp
+    	code__2 dst = code . mkSeqInstr (instr src dst)
+    in
+    returnUs (Any pk code__2)
+
+{-
 trivialUFCode pk instr (StInd pk' mem)
   = getAmode mem		`thenUs` \ amode ->
     let
@@ -2945,7 +2868,6 @@ trivialUFCode pk instr (StInd pk' mem)
 
 trivialUFCode pk instr x
   = getRegister x		`thenUs` \ register ->
-    --getNewRegNCG pk		`thenUs` \ tmp ->
     let
     	code__2 dst = let
     	                  code = registerCode register dst
@@ -2953,7 +2875,7 @@ trivialUFCode pk instr x
 		      in code . mkSeqInstrs [instr]
     in
     returnUs (Any pk code__2)
-
+-}
 #endif {- i386_TARGET_ARCH -}
 -- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
 #if sparc_TARGET_ARCH
@@ -3124,11 +3046,9 @@ coerceInt2FP pk x
     let
     	code = registerCode register reg
     	src  = registerName register reg
-
-    	code__2 dst = code . mkSeqInstrs [
-	-- to fix: should spill instead of using R1
-    	              MOV L (OpReg src) (OpAddr (AddrBaseIndex (Just ebx) Nothing (ImmInt OFFSET_R1))),
-    	              FILD (primRepToSize pk) (AddrBaseIndex (Just ebx) Nothing (ImmInt OFFSET_R1)) dst]
+        opc  = case pk of FloatRep -> GITOF ; DoubleRep -> GITOD
+        code__2 dst = code . 
+                      mkSeqInstr (opc src dst)
     in
     returnUs (Any pk code__2)
 
@@ -3141,10 +3061,9 @@ coerceFP2Int x
     	src  = registerName register tmp
     	pk   = registerRep register
 
-    	code__2 dst = code . mkSeqInstrs [
-    	                        FRNDINT,
-    	                        FIST L (AddrBaseIndex (Just ebx) Nothing (ImmInt OFFSET_R1)),
-    	                        MOV L (OpAddr (AddrBaseIndex (Just ebx) Nothing (ImmInt OFFSET_R1))) (OpReg dst)]
+        opc  = case pk of FloatRep -> GFTOI ; DoubleRep -> GDTOI
+        code__2 dst = code . 
+                      mkSeqInstr (opc src dst)
     in
     returnUs (Any IntRep code__2)
 
diff --git a/ghc/compiler/nativeGen/MachMisc.lhs b/ghc/compiler/nativeGen/MachMisc.lhs
index 3c593e0567c51d6522c88fb668a2ef84ab1e61e5..d72de134ed9d792d27f6eca67dd62404b04bfe60 100644
--- a/ghc/compiler/nativeGen/MachMisc.lhs
+++ b/ghc/compiler/nativeGen/MachMisc.lhs
@@ -475,49 +475,34 @@ data RI
 
 -- Float Arithmetic. -- ToDo for 386
 
--- Note that we cheat by treating F{ABS,MOV,NEG} of doubles as single instructions
+-- Note that we cheat by treating G{ABS,MOV,NEG} of doubles as single instructions
 -- right up until we spit them out.
 
-	      | SAHF	      -- stores ah into flags
-    	      | FABS
-	      | FADD	      Size Operand -- src
-	      | FADDP
-	      | FIADD	      Size MachRegsAddr -- src
-    	      | FCHS
-    	      | FCOM	      Size Operand -- src
-    	      | FCOS
-	      | FDIV	      Size Operand -- src
-	      | FDIVP
-	      | FIDIV	      Size MachRegsAddr -- src
-	      | FDIVR	      Size Operand -- src
-	      | FDIVRP
-	      | FIDIVR	      Size MachRegsAddr -- src
-    	      | FICOM	      Size MachRegsAddr -- src
-    	      | FILD	      Size MachRegsAddr Reg -- src, dst
-    	      | FIST	      Size MachRegsAddr -- dst
-    	      | FLD	      Size Operand -- src
-    	      | FLD1
-    	      | FLDZ
-    	      | FMUL	      Size Operand -- src
-    	      | FMULP
-    	      | FIMUL	      Size MachRegsAddr -- src
-    	      | FRNDINT
-    	      | FSIN
-    	      | FSQRT
-    	      | FST	      Size Operand -- dst
-    	      | FSTP	      Size Operand -- dst
-	      | FSUB	      Size Operand -- src
-	      | FSUBP
-	      | FISUB	      Size MachRegsAddr -- src
-	      | FSUBR	      Size Operand -- src
-	      | FSUBRP
-	      | FISUBR	      Size MachRegsAddr -- src
-	      | FTST
-    	      | FCOMP	      Size Operand -- src
-    	      | FUCOMPP
-	      | FXCH
-	      | FNSTSW
-	      | FNOP
+              -- all the 3-operand fake fp insns are src1 src2 dst
+              -- and furthermore are constrained to be fp regs only.
+    	      | GMOV	      Reg Reg -- src(fpreg), dst(fpreg)
+              | GLD           Size MachRegsAddr Reg -- src, dst(fpreg)
+              | GST           Size Reg MachRegsAddr -- src(fpreg), dst
+
+    	      | GFTOD	      Reg Reg -- src(fpreg), dst(fpreg)
+              | GFTOI         Reg Reg -- src(fpreg), dst(intreg)
+
+    	      | GDTOF	      Reg Reg -- src(fpreg), dst(fpreg)
+              | GDTOI         Reg Reg -- src(fpreg), dst(intreg)
+
+              | GITOF         Reg Reg -- src(intreg), dst(fpreg)
+              | GITOD         Reg Reg -- src(intreg), dst(fpreg)
+
+	      | GADD	      Size Reg Reg Reg -- src1, src2, dst
+	      | GDIV	      Size Reg Reg Reg -- src1, src2, dst
+	      | GSUB	      Size Reg Reg Reg -- src1, src2, dst
+	      | GMUL	      Size Reg Reg Reg -- src1, src2, dst
+
+    	      | GCMP	      Size Reg Reg -- src1, src2
+
+     	      | GABS	      Size Reg Reg -- src, dst
+    	      | GNEG	      Size Reg Reg -- src, dst
+    	      | GSQRT	      Size Reg Reg -- src, dst
 
 -- Comparison
 
diff --git a/ghc/compiler/nativeGen/MachRegs.lhs b/ghc/compiler/nativeGen/MachRegs.lhs
index f5e02cb8546eb5eefaeab49f379bdd17e698c77f..7bafa78a5224ebf96860bdaef4d1a72bc9e15155 100644
--- a/ghc/compiler/nativeGen/MachRegs.lhs
+++ b/ghc/compiler/nativeGen/MachRegs.lhs
@@ -46,7 +46,7 @@ module MachRegs (
 #endif
 #if i386_TARGET_ARCH
 	, eax, ebx, ecx, edx, esi, esp
-	, st0, st1, st2, st3, st4, st5, st6, st7
+	, fake0, fake1, fake2, fake3, fake4, fake5
 #endif
 #if sparc_TARGET_ARCH
 	, allArgRegs
@@ -370,7 +370,10 @@ Intel x86 architecture:
 - Only ebx, esi, edi and esp are available across a C call (they are callee-saves).
 - Registers 0-7 have 16-bit counterparts (ax, bx etc.)
 - Registers 0-3 have 8 bit counterparts (ah, bh etc.)
-- Registers 8-15 hold extended floating point values.
+- Registers 8-13 are fakes; we pretend x86 has 6 conventionally-addressable
+  fp registers, and 3-operand insns for them, and we translate this into
+  real stack-based x86 fp code after register allocation.
+
 \begin{code}
 #if i386_TARGET_ARCH
 
@@ -378,7 +381,7 @@ gReg,fReg :: Int -> Int
 gReg x = x
 fReg x = (8 + x)
 
-st0, st1, st2, st3, st4, st5, st6, st7, eax, ebx, ecx, edx, esp :: Reg
+fake0, fake1, fake2, fake3, fake4, fake5, eax, ebx, ecx, edx, esp :: Reg
 eax = realReg (gReg 0)
 ebx = realReg (gReg 1)
 ecx = realReg (gReg 2)
@@ -387,15 +390,12 @@ esi = realReg (gReg 4)
 edi = realReg (gReg 5)
 ebp = realReg (gReg 6)
 esp = realReg (gReg 7)
-st0 = realReg (fReg 0)
-st1 = realReg (fReg 1)
-st2 = realReg (fReg 2)
-st3 = realReg (fReg 3)
-st4 = realReg (fReg 4)
-st5 = realReg (fReg 5)
-st6 = realReg (fReg 6)
-st7 = realReg (fReg 7)
-
+fake0 = realReg (fReg 0)
+fake1 = realReg (fReg 1)
+fake2 = realReg (fReg 2)
+fake3 = realReg (fReg 3)
+fake4 = realReg (fReg 4)
+fake5 = realReg (fReg 5)
 #endif
 \end{code}
 
@@ -474,14 +474,12 @@ names in the header files.  Gag me with a spoon, eh?
 #define edi 5
 #define ebp 6
 #define esp 7
-#define st0 8
-#define st1 9
-#define st2 10
-#define st3 11
-#define st4 12
-#define st5 13
-#define st6 14
-#define st7 15
+#define fake0 8
+#define fake1 9
+#define fake2 10
+#define fake3 11
+#define fake4 12
+#define fake5 13
 #endif
 #if sparc_TARGET_ARCH
 #define g0 0
@@ -765,7 +763,7 @@ reservedRegs
 freeRegs :: [Reg]
 freeRegs
   = freeMappedRegs IF_ARCH_alpha( [0..63],
-		   IF_ARCH_i386(  [0..15],
+		   IF_ARCH_i386(  [0..13],
 		   IF_ARCH_sparc( [0..63],)))
 
 -------------------------------
diff --git a/ghc/compiler/nativeGen/PprMach.lhs b/ghc/compiler/nativeGen/PprMach.lhs
index 304a4a2de4552b1570edaa778ce91aededd95b15..eddbe80d8f57739cd6d4888db4500c4ff9b57d76 100644
--- a/ghc/compiler/nativeGen/PprMach.lhs
+++ b/ghc/compiler/nativeGen/PprMach.lhs
@@ -94,14 +94,14 @@ pprReg IF_ARCH_i386(s,) r
 	_ -> SLIT("very naughty I386 byte register")
       })
 
-    {- UNUSED:
+{- UNUSED:
     ppr_reg_no HB i = ptext
       (case i of {
 	ILIT( 0) -> SLIT("%ah");  ILIT( 1) -> SLIT("%bh");
 	ILIT( 2) -> SLIT("%ch");  ILIT( 3) -> SLIT("%dh");
 	_ -> SLIT("very naughty I386 high byte register")
       })
-    -}
+-}
 
 {- UNUSED:
     ppr_reg_no S i = ptext
@@ -125,21 +125,17 @@ pprReg IF_ARCH_i386(s,) r
 
     ppr_reg_no F i = ptext
       (case i of {
-	--ToDo: rm these (???)
-	ILIT( 8) -> SLIT("%st(0)");  ILIT( 9) -> SLIT("%st(1)");
-	ILIT(10) -> SLIT("%st(2)");  ILIT(11) -> SLIT("%st(3)");
-	ILIT(12) -> SLIT("%st(4)");  ILIT(13) -> SLIT("%st(5)");
-	ILIT(14) -> SLIT("%st(6)");  ILIT(15) -> SLIT("%st(7)");
+	ILIT( 8) -> SLIT("%fake0");  ILIT( 9) -> SLIT("%fake1");
+	ILIT(10) -> SLIT("%fake2");  ILIT(11) -> SLIT("%fake3");
+	ILIT(12) -> SLIT("%fake4");  ILIT(13) -> SLIT("%fake5");
 	_ -> SLIT("very naughty I386 float register")
       })
 
     ppr_reg_no DF i = ptext
       (case i of {
-	--ToDo: rm these (???)
-	ILIT( 8) -> SLIT("%st(0)");  ILIT( 9) -> SLIT("%st(1)");
-	ILIT(10) -> SLIT("%st(2)");  ILIT(11) -> SLIT("%st(3)");
-	ILIT(12) -> SLIT("%st(4)");  ILIT(13) -> SLIT("%st(5)");
-	ILIT(14) -> SLIT("%st(6)");  ILIT(15) -> SLIT("%st(7)");
+	ILIT( 8) -> SLIT("%fake0");  ILIT( 9) -> SLIT("%fake1");
+	ILIT(10) -> SLIT("%fake2");  ILIT(11) -> SLIT("%fake3");
+	ILIT(12) -> SLIT("%fake4");  ILIT(13) -> SLIT("%fake5");
 	_ -> SLIT("very naughty I386 float register")
       })
 #endif
@@ -405,7 +401,7 @@ pprInstr (SEGMENT TextSegment)
     = ptext
 	 IF_ARCH_alpha(SLIT("\t.text\n\t.align 3") {-word boundary-}
 	,IF_ARCH_sparc(SLIT("\t.text\n\t.align 4") {-word boundary-}
-	,IF_ARCH_i386(SLIT(".text\n\t.align 4") {-needs per-OS variation!-}
+	,IF_ARCH_i386(SLIT(".text\n\t.align 4,0x90") {-needs per-OS variation!-}
 	,)))
 
 pprInstr (SEGMENT DataSegment)
@@ -998,70 +994,111 @@ pprInstr (JMP (OpImm imm)) = (<>) (ptext SLIT("\tjmp ")) (pprImm imm)
 pprInstr (JMP op) = (<>) (ptext SLIT("\tjmp *")) (pprOperand L op)
 
 pprInstr (CALL imm)
-  = hcat [ ptext SLIT("\tcall "), pprImm imm ]
-
-pprInstr SAHF = ptext SLIT("\tsahf")
-pprInstr FABS = ptext SLIT("\tfabs")
-
-pprInstr (FADD sz src@(OpAddr _))
-  = hcat [ptext SLIT("\tfadd"), pprSize sz, space, pprOperand sz src]
-pprInstr (FADD sz src)
-  = ptext SLIT("\tfadd")
-pprInstr FADDP
-  = ptext SLIT("\tfaddp")
-pprInstr (FMUL sz src)
-  = hcat [ptext SLIT("\tfmul"), pprSize sz, space, pprOperand sz src]
-pprInstr FMULP
-  = ptext SLIT("\tfmulp")
-pprInstr (FIADD size op) = pprSizeAddr SLIT("fiadd") size op
-pprInstr FCHS = ptext SLIT("\tfchs")
-pprInstr (FCOM size op) = pprSizeOp SLIT("fcom") size op
-pprInstr FCOS = ptext SLIT("\tfcos")
-pprInstr (FIDIV size op) = pprSizeAddr SLIT("fidiv") size op
-pprInstr (FDIV sz src)
-  = hcat [ptext SLIT("\tfdiv"), pprSize sz, space, pprOperand sz src]
-pprInstr FDIVP
-  = ptext SLIT("\tfdivp")
-pprInstr (FDIVR sz src)
-  = hcat [ptext SLIT("\tfdivr"), pprSize sz, space, pprOperand sz src]
-pprInstr FDIVRP
-  = ptext SLIT("\tfdivpr")
-pprInstr (FIDIVR size op) = pprSizeAddr SLIT("fidivr") size op
-pprInstr (FICOM size op) = pprSizeAddr SLIT("ficom") size op
-pprInstr (FILD sz op reg) = pprSizeAddrReg SLIT("fild") sz op reg
-pprInstr (FIST size op) = pprSizeAddr SLIT("fist") size op
-pprInstr (FLD sz (OpImm (ImmCLbl src)))
-  = hcat [ptext SLIT("\tfld"),pprSize sz,space,pprCLabel_asm src]
-pprInstr (FLD sz src)
-  = hcat [ptext SLIT("\tfld"),pprSize sz,space,pprOperand sz src]
-pprInstr FLD1 = ptext SLIT("\tfld1")
-pprInstr FLDZ = ptext SLIT("\tfldz")
-pprInstr (FIMUL size op) = pprSizeAddr SLIT("fimul") size op
-pprInstr FRNDINT = ptext SLIT("\tfrndint")
-pprInstr FSIN = ptext SLIT("\tfsin")
-pprInstr FSQRT = ptext SLIT("\tfsqrt")
-pprInstr (FST sz dst)
-  = hcat [ptext SLIT("\tfst"), pprSize sz, space, pprOperand sz dst]
-pprInstr (FSTP sz dst)
-  = hcat [ptext SLIT("\tfstp"), pprSize sz, space, pprOperand sz dst]
-pprInstr (FISUB size op) = pprSizeAddr SLIT("fisub") size op
-pprInstr (FSUB sz src)
-  = hcat [ptext SLIT("\tfsub"), pprSize sz, space, pprOperand sz src]
-pprInstr FSUBP
-  = ptext SLIT("\tfsubp")
-pprInstr (FSUBR size src)
-  = pprSizeOp SLIT("fsubr") size src
-pprInstr FSUBRP
-  = ptext SLIT("\tfsubpr")
-pprInstr (FISUBR size op)
-  = pprSizeAddr SLIT("fisubr") size op
-pprInstr FTST = ptext SLIT("\tftst")
-pprInstr (FCOMP sz op)
-  = hcat [ptext SLIT("\tfcomp"), pprSize sz, space, pprOperand sz op]
-pprInstr FUCOMPP = ptext SLIT("\tfucompp")
-pprInstr FXCH = ptext SLIT("\tfxch")
-pprInstr FNSTSW = ptext SLIT("\tfnstsw %ax")
-pprInstr FNOP = ptext SLIT("")
+   = hcat [ ptext SLIT("\tffree %st(0) ; call "), pprImm imm ]
+
+
+-- Simulating a flat register set on the x86 FP stack is tricky.
+-- you have to free %st(7) before pushing anything on the FP reg stack
+-- so as to preclude the possibility of a FP stack overflow exception.
+-- ToDo: make gpop into a single instruction, FST
+pprInstr g@(GMOV src dst) 
+   = pprG g (hcat [gtab, gpush src 0, gsemi, gpop dst 1])
+
+-- GLD sz addr dst ==> FFREE %st(7) ; FLDsz addr ; FXCH (dst+1) ; FINCSTP
+pprInstr g@(GLD sz addr dst)
+ = pprG g (hcat [gtab, text "ffree %st(7) ; fld", pprSize sz, gsp, 
+                 pprAddr addr, gsemi, gpop dst 1])
+
+-- GST sz src addr ==> FFREE %st(7) ; FLD dst ; FSTPsz addr
+pprInstr g@(GST sz src addr)
+ = pprG g (hcat [gtab, gpush src 0, gsemi, 
+                 text "fstp", pprSize sz, gsp, pprAddr addr])
+
+pprInstr g@(GFTOD src dst) 
+   = pprG g bogus
+pprInstr g@(GFTOI src dst) 
+   = pprG g bogus
+
+pprInstr g@(GDTOF src dst) 
+   = pprG g bogus
+pprInstr g@(GDTOI src dst) 
+   = pprG g bogus
+
+pprInstr g@(GITOF src dst) 
+   = pprG g bogus
+pprInstr g@(GITOD src dst) 
+   = pprG g bogus
+
+pprInstr g@(GCMP sz src1 src2) 
+   = pprG g (hcat [gtab, text "pushl %eax ; ",
+                   gpush src2 0, gsemi, gpush src1 1]
+             $$
+             hcat [gtab, text "fcompp ; fstsw %ax ; sahf ; popl %eax"])
+
+pprInstr g@(GABS sz src dst)
+   = pprG g bogus
+pprInstr g@(GNEG sz src dst)
+   = pprG g bogus
+pprInstr g@(GSQRT sz src dst)
+   = pprG g bogus
+
+pprInstr g@(GADD sz src1 src2 dst)
+   = pprG g (hcat [gtab, gpush src1 0, 
+                   text " ; fadd ", greg src2 1, text ",%st(0)",
+                   gsemi, gpop dst 1])
+pprInstr g@(GSUB sz src1 src2 dst)
+   = pprG g (hcat [gtab, gpush src1 0, 
+                   text " ; fsub ", greg src2 1, text ",%st(0)",
+                   gsemi, gpop dst 1])
+pprInstr g@(GMUL sz src1 src2 dst)
+   = pprG g (hcat [gtab, gpush src1 0, 
+                   text " ; fmul ", greg src2 1, text ",%st(0)",
+                   gsemi, gpop dst 1])
+pprInstr g@(GDIV sz src1 src2 dst)
+   = pprG g (hcat [gtab, gpush src1 0, 
+                   text " ; fdiv ", greg src2 1, text ",%st(0)",
+                   gsemi, gpop dst 1])
+
+--------------------------
+gpush reg offset
+   = hcat [text "ffree %st(7) ; fld ", greg reg offset]
+gpop reg offset
+   = hcat [text "fxch ", greg reg offset, gsemi, text "fincstp"]
+
+bogus = text "\tbogus"
+greg reg offset = text "%st(" <> int (gregno reg - 8+offset) <> char ')'
+gsemi = text " ; "
+gtab  = char '\t'
+gsp   = char ' '
+gregno (FixedReg i) = I# i
+gregno (MappedReg i) = I# i
+
+pprG :: Instr -> SDoc -> SDoc
+pprG fake actual
+   = (char '#' <> pprGInstr fake) $$ actual
+
+pprGInstr (GMOV src dst)   = pprSizeRegReg SLIT("gmov") DF src dst
+pprGInstr (GLD sz src dst) = pprSizeAddrReg SLIT("gld") sz src dst
+pprGInstr (GST sz src dst) = pprSizeRegAddr SLIT("gst") sz src dst
+
+pprGInstr (GFTOD src dst) = pprSizeSizeRegReg SLIT("gftod") F DF src dst
+pprGInstr (GFTOI src dst) = pprSizeSizeRegReg SLIT("gftoi") F L  src dst
+
+pprGInstr (GDTOF src dst) = pprSizeSizeRegReg SLIT("gdtof") DF F src dst
+pprGInstr (GDTOI src dst) = pprSizeSizeRegReg SLIT("gdtoi") DF L src dst
+
+pprGInstr (GITOF src dst) = pprSizeSizeRegReg SLIT("gitof") L F  src dst
+pprGInstr (GITOD src dst) = pprSizeSizeRegReg SLIT("gitod") L DF src dst
+
+pprGInstr (GCMP sz src dst) = pprSizeRegReg SLIT("gcmp") sz src dst
+pprGInstr (GABS sz src dst) = pprSizeRegReg SLIT("gabs") sz src dst
+pprGInstr (GNEG sz src dst) = pprSizeRegReg SLIT("gneg") sz src dst
+pprGInstr (GSQRT sz src dst) = pprSizeRegReg SLIT("gsqrt") sz src dst
+
+pprGInstr (GADD sz src1 src2 dst) = pprSizeRegRegReg SLIT("gadd") sz src1 src2 dst
+pprGInstr (GSUB sz src1 src2 dst) = pprSizeRegRegReg SLIT("gsub") sz src1 src2 dst
+pprGInstr (GMUL sz src1 src2 dst) = pprSizeRegRegReg SLIT("gmul") sz src1 src2 dst
+pprGInstr (GDIV sz src1 src2 dst) = pprSizeRegRegReg SLIT("gdiv") sz src1 src2 dst
 \end{code}
 
 Continue with I386-only printing bits and bobs:
@@ -1121,6 +1158,45 @@ pprSizeOpReg name size op1 reg
 	pprReg size reg
     ]
 
+pprSizeRegReg :: FAST_STRING -> Size -> Reg -> Reg -> SDoc
+pprSizeRegReg name size reg1 reg2
+  = hcat [
+    	char '\t',
+	ptext name,
+    	pprSize size,
+	space,
+	pprReg size reg1,
+        comma,
+        pprReg size reg2
+    ]
+
+pprSizeSizeRegReg :: FAST_STRING -> Size -> Size -> Reg -> Reg -> SDoc
+pprSizeSizeRegReg name size1 size2 reg1 reg2
+  = hcat [
+    	char '\t',
+	ptext name,
+    	pprSize size1,
+        pprSize size2,
+	space,
+	pprReg size1 reg1,
+        comma,
+        pprReg size2 reg2
+    ]
+
+pprSizeRegRegReg :: FAST_STRING -> Size -> Reg -> Reg -> Reg -> SDoc
+pprSizeRegRegReg name size reg1 reg2 reg3
+  = hcat [
+    	char '\t',
+	ptext name,
+    	pprSize size,
+	space,
+	pprReg size reg1,
+        comma,
+        pprReg size reg2,
+        comma,
+        pprReg size reg3
+    ]
+
 pprSizeAddr :: FAST_STRING -> Size -> MachRegsAddr -> SDoc
 pprSizeAddr name size op
   = hcat [
@@ -1143,6 +1219,18 @@ pprSizeAddrReg name size op dst
 	pprReg size dst
     ]
 
+pprSizeRegAddr :: FAST_STRING -> Size -> Reg -> MachRegsAddr -> SDoc
+pprSizeRegAddr name size src op
+  = hcat [
+    	char '\t',
+	ptext name,
+    	pprSize size,
+	space,
+	pprReg size src,
+	comma,
+	pprAddr op
+    ]
+
 pprOpOp :: FAST_STRING -> Size -> Operand -> Operand -> SDoc
 pprOpOp name size op1 op2
   = hcat [
diff --git a/ghc/compiler/nativeGen/RegAllocInfo.lhs b/ghc/compiler/nativeGen/RegAllocInfo.lhs
index 811a39a0eece3dbb021043dd2a00a8721dbfa8d9..e3965e8af366407f504256cc164e693c4495c8bd 100644
--- a/ghc/compiler/nativeGen/RegAllocInfo.lhs
+++ b/ghc/compiler/nativeGen/RegAllocInfo.lhs
@@ -64,6 +64,7 @@ import OrdList		( mkUnitList )
 import PrimRep		( PrimRep(..) )
 import UniqSet		-- quite a bit of it
 import Outputable
+import PprMach		( pprInstr )
 \end{code}
 
 %************************************************************************
@@ -379,48 +380,36 @@ regUsage instr = case instr of
     CALL imm		-> usage [] callClobberedRegs
     CLTD		-> usage [eax] [edx]
     NOP			-> usage [] []
-    SAHF 		-> usage [eax] []
-    FABS 		-> usage [st0] [st0]
-    FADD sz src		-> usage (st0:opToReg src) [st0] -- allFPRegs
-    FADDP 		-> usage [st0,st1] [st0] -- allFPRegs
-    FIADD sz asrc	-> usage (addrToRegs asrc) [st0]
-    FCHS 		-> usage [st0] [st0]
-    FCOM sz src		-> usage (st0:opToReg src) []
-    FCOS 		-> usage [st0] [st0]
-    FDIV sz src 	-> usage (st0:opToReg src) [st0]
-    FDIVP  		-> usage [st0,st1] [st0]
-    FDIVRP 		-> usage [st0,st1] [st0]
-    FIDIV sz asrc	-> usage (addrToRegs asrc) [st0]
-    FDIVR sz src 	-> usage (st0:opToReg src) [st0]
-    FIDIVR sz asrc	-> usage (addrToRegs asrc) [st0]
-    FICOM sz asrc	-> usage (addrToRegs asrc) []
-    FILD sz asrc dst	-> usage (addrToRegs asrc) [dst] -- allFPRegs
-    FIST sz adst	-> usage (st0:addrToRegs adst) []
-    FLD	 sz src 	-> usage (opToReg src) [st0] -- allFPRegs
-    FLD1 		-> usage [] [st0] -- allFPRegs
-    FLDZ 		-> usage [] [st0] -- allFPRegs
-    FMUL sz src 	-> usage (st0:opToReg src) [st0]
-    FMULP 	 	-> usage [st0,st1] [st0]
-    FIMUL sz asrc	-> usage (addrToRegs asrc) [st0]
-    FRNDINT 		-> usage [st0] [st0]
-    FSIN 		-> usage [st0] [st0]
-    FSQRT 		-> usage [st0] [st0]
-    FST sz (OpReg r)	-> usage [st0] [r]
-    FST sz dst		-> usage (st0:opToReg dst) []
-    FSTP sz (OpReg r)	-> usage [st0] [r] -- allFPRegs
-    FSTP sz dst		-> usage (st0:opToReg dst) [] -- allFPRegs
-    FSUB sz src		-> usage (st0:opToReg src) [st0] -- allFPRegs
-    FSUBR sz src	-> usage (st0:opToReg src) [st0] -- allFPRegs
-    FISUB sz asrc	-> usage (addrToRegs asrc) [st0]
-    FSUBP 		-> usage [st0,st1] [st0] -- allFPRegs
-    FSUBRP 		-> usage [st0,st1] [st0] -- allFPRegs
-    FISUBR sz asrc	-> usage (addrToRegs asrc) [st0]
-    FTST 		-> usage [st0] []
-    FCOMP sz op		-> usage (st0:opToReg op) [st0] -- allFPRegs
-    FUCOMPP 		-> usage [st0, st1] [st0, st1] --  allFPRegs
-    FXCH		-> usage [st0, st1] [st0, st1]
-    FNSTSW		-> usage [] [eax]
-    _			-> noUsage
+
+    GMOV src dst	-> usage [src] [dst]
+    GLD sz src dst	-> usage (addrToRegs src) [dst]
+    GST sz src dst	-> usage [src] (addrToRegs dst)
+
+    GFTOD src dst	-> usage [src] [dst]
+    GFTOI src dst	-> usage [src] [dst]
+
+    GDTOF src dst	-> usage [src] [dst]
+    GDTOI src dst	-> usage [src] [dst]
+
+    GITOF src dst	-> usage [src] [dst]
+    GITOD src dst	-> usage [src] [dst]
+
+    GADD sz s1 s2 dst	-> usage [s1,s2] [dst]
+    GSUB sz s1 s2 dst	-> usage [s1,s2] [dst]
+    GMUL sz s1 s2 dst	-> usage [s1,s2] [dst]
+    GDIV sz s1 s2 dst	-> usage [s1,s2] [dst]
+
+    GCMP sz src1 src2	-> usage [src1,src2] []
+    GABS sz src dst	-> usage [src] [dst]
+    GNEG sz src dst	-> usage [src] [dst]
+    GSQRT sz src dst	-> usage [src] [dst]
+
+    COMMENT _		-> noUsage
+    SEGMENT _ 		-> noUsage
+    LABEL _		-> noUsage
+    ASCII _ _		-> noUsage
+    DATA _ _		-> noUsage
+    _			-> error ("regUsage: " ++ showSDoc (pprInstr instr)) --noUsage
  where
     usage2 :: Operand -> Operand -> RegUsage
     usage2 op (OpReg reg) = usage (opToReg op) [reg]
@@ -429,10 +418,10 @@ regUsage instr = case instr of
     usage1 :: Operand -> RegUsage
     usage1 (OpReg reg)    = usage [reg] [reg]
     usage1 (OpAddr ea)    = usage (addrToRegs ea) []
-    allFPRegs = [st0,st1,st2,st3,st4,st5,st6,st7]
+    allFPRegs = [fake0,fake1,fake2,fake3,fake4,fake5]
 
     --callClobberedRegs = [ eax, ecx, edx ] -- according to gcc, anyway.
-    callClobberedRegs = [eax]
+    callClobberedRegs = [eax,fake0,fake1,fake2,fake3,fake4,fake5]
 
 -- General purpose register collecting functions.
 
@@ -672,32 +661,39 @@ patchRegs instr env = case instr of
     POP  sz op		-> patch1 (POP  sz) op
     SETCC cond op	-> patch1 (SETCC cond) op
     JMP op		-> patch1 JMP op
-    FADD sz src		-> FADD sz (patchOp src)
-    FIADD sz asrc	-> FIADD sz (lookupAddr asrc)
-    FCOM sz src		-> patch1 (FCOM sz) src
-    FDIV sz src 	-> FDIV sz (patchOp src)
-    --FDIVP sz src 	-> FDIVP sz (patchOp src)
-    FIDIV sz asrc	-> FIDIV sz (lookupAddr asrc)
-    FDIVR sz src 	-> FDIVR sz (patchOp src)
-    --FDIVRP sz src 	-> FDIVRP sz (patchOp src)
-    FIDIVR sz asrc	-> FIDIVR sz (lookupAddr asrc)
-    FICOM sz asrc	-> FICOM sz (lookupAddr asrc)
-    FILD sz asrc dst	-> FILD sz (lookupAddr asrc) (env dst)
-    FIST sz adst	-> FIST sz (lookupAddr adst)
-    FLD	sz src 		-> patch1 (FLD sz) (patchOp src)
-    FMUL sz src 	-> FMUL sz (patchOp src)
-    --FMULP sz src 	-> FMULP sz (patchOp src)
-    FIMUL sz asrc	-> FIMUL sz (lookupAddr asrc)
-    FST sz dst		-> FST sz (patchOp dst)
-    FSTP sz dst		-> FSTP sz (patchOp dst)
-    FSUB sz src		-> FSUB sz (patchOp src)
-    --FSUBP sz src	-> FSUBP sz (patchOp src)
-    FISUB sz asrc	-> FISUB sz (lookupAddr asrc)
-    FSUBR sz src 	-> FSUBR sz (patchOp src)
-    --FSUBRP sz src 	-> FSUBRP sz (patchOp src)
-    FISUBR sz asrc	-> FISUBR sz (lookupAddr asrc)
-    FCOMP sz src	-> FCOMP sz (patchOp src)
-    _			-> instr
+
+    GMOV src dst	-> GMOV (env src) (env dst)
+    GLD sz src dst	-> GLD sz (lookupAddr src) (env dst)
+    GST sz src dst	-> GST sz (env src) (lookupAddr dst)
+
+    GFTOD src dst	-> GFTOD (env src) (env dst)
+    GFTOI src dst	-> GFTOI (env src) (env dst)
+
+    GDTOF src dst	-> GDTOF (env src) (env dst)
+    GDTOI src dst	-> GDTOI (env src) (env dst)
+
+    GITOF src dst	-> GITOF (env src) (env dst)
+    GITOD src dst	-> GITOD (env src) (env dst)
+
+    GADD sz s1 s2 dst	-> GADD sz (env s1) (env s2) (env dst)
+    GSUB sz s1 s2 dst	-> GSUB sz (env s1) (env s2) (env dst)
+    GMUL sz s1 s2 dst	-> GMUL sz (env s1) (env s2) (env dst)
+    GDIV sz s1 s2 dst	-> GDIV sz (env s1) (env s2) (env dst)
+
+    GCMP sz src1 src2	-> GCMP sz (env src1) (env src2)
+    GABS sz src dst	-> GABS sz (env src) (env dst)
+    GNEG sz src dst	-> GNEG sz (env src) (env dst)
+    GSQRT sz src dst	-> GSQRT sz (env src) (env dst)
+
+    COMMENT _		-> instr
+    SEGMENT _ 		-> instr
+    LABEL _		-> instr
+    ASCII _ _		-> instr
+    DATA _ _		-> instr
+    JXX _ _		-> instr
+    CALL _		-> instr
+    CLTD		-> instr
+    _			-> error ("patchInstr: " ++ showSDoc (pprInstr instr)) --instr
   where
     patch1 insn op      = insn (patchOp op)
     patch2 insn src dst = insn (patchOp src) (patchOp dst)
@@ -765,10 +761,15 @@ patchRegs instr env = case instr of
 
 Spill to memory, and load it back...
 
+JRS, 000122: on x86, don't spill directly below the stack pointer, since 
+some insn sequences (int <-> conversions) use this as a temp location.
+Leave 16 bytes of slop.
+
 \begin{code}
 spillReg, loadReg :: Reg -> Reg -> InstrList
 
 spillReg dyn (MemoryReg i pk)
+  | i >= 0  -- JRS paranoia
   = let
 	sz = primRepToSize pk
     in
@@ -777,7 +778,9 @@ spillReg dyn (MemoryReg i pk)
 	 IF_ARCH_alpha( ST sz dyn (spRel i)
 
 	{-I386: spill below stack pointer leaving 2 words/spill-}
-	,IF_ARCH_i386 ( MOV sz (OpReg dyn) (OpAddr (spRel (-2 * i)))
+	,IF_ARCH_i386 ( if pk == FloatRep || pk == DoubleRep
+                        then GST sz dyn (spRel (-16 + (-2 * i)))
+                        else MOV sz (OpReg dyn) (OpAddr (spRel (-16 + (-2 * i))))
 
 	{-SPARC: spill below frame pointer leaving 2 words/spill-}
 	,IF_ARCH_sparc( ST sz dyn (fpRel (-2 * i))
@@ -786,12 +789,15 @@ spillReg dyn (MemoryReg i pk)
 
 ----------------------------
 loadReg (MemoryReg i pk) dyn
+  | i >= 0  -- JRS paranoia
   = let
 	sz = primRepToSize pk
     in
     mkUnitList (
 	 IF_ARCH_alpha( LD  sz dyn (spRel i)
-	,IF_ARCH_i386 ( MOV sz (OpAddr (spRel (-2 * i))) (OpReg dyn)
+	,IF_ARCH_i386 ( if   pk == FloatRep || pk == DoubleRep
+                        then GLD sz (spRel (-16 + (-2 * i))) dyn
+                        else MOV sz (OpAddr (spRel (-16 + (-2 * i)))) (OpReg dyn)
 	,IF_ARCH_sparc( LD  sz (fpRel (-2 * i)) dyn
 	,)))
     )
diff --git a/ghc/compiler/nativeGen/StixPrim.lhs b/ghc/compiler/nativeGen/StixPrim.lhs
index c9323ec415951a47917f17da2390c2bc0823be65..ff5332df1ac035bc99912e1561937442a8d80b10 100644
--- a/ghc/compiler/nativeGen/StixPrim.lhs
+++ b/ghc/compiler/nativeGen/StixPrim.lhs
@@ -159,7 +159,7 @@ primCode [] WriteArrayOp [obj, ix, v]
 	obj' = amodeToStix obj
     	ix' = amodeToStix ix
     	v' = amodeToStix v
-    	base = StIndex IntRep obj' arrHS
+    	base = StIndex IntRep obj' arrHS --(StInt (toInteger 3))
     	assign = StAssign PtrRep (StInd PtrRep (StIndex PtrRep base ix')) v'
     in
     returnUs (\xs -> assign : xs)