[project @ 2000-07-12 13:04:31 by sewardj]

Make the x86 NCG work again following recent sparc hackage.

Also, fix the x86 bits pertaining to the floats-promoted-to-doubles-
in-ccalls problem.  So this problem should no longer exist on x86
or sparc via NCG.

diff --git a/ghc/compiler/nativeGen/AsmCodeGen.lhs b/ghc/compiler/nativeGen/AsmCodeGen.lhs
index 17f184a..bbbc760 100644 (file)
--- a/ghc/compiler/nativeGen/AsmCodeGen.lhs
+++ b/ghc/compiler/nativeGen/AsmCodeGen.lhs
@@ -95,7 +95,7 @@ nativeCodeGen absC us
          insn_sdoc         = my_vcat insn_sdocs
          stix_sdoc         = vcat stix_sdocs
 
-#        if 1 /* ifdef NCG_DEBUG */
+#        ifdef NCG_DEBUG
          my_trace m x = trace m x
          my_vcat sds = vcat (intersperse (char ' ' 
                                           $$ ptext SLIT("# ___ncg_debug_marker")

diff --git a/ghc/compiler/nativeGen/AsmRegAlloc.lhs b/ghc/compiler/nativeGen/AsmRegAlloc.lhs
index 790a955..162befc 100644 (file)
--- a/ghc/compiler/nativeGen/AsmRegAlloc.lhs
+++ b/ghc/compiler/nativeGen/AsmRegAlloc.lhs
@@ -222,7 +222,7 @@ doGeneralAlloc all_regs reserve_regs instrs
               ++ " using " 
               ++ showSDoc (hsep (map ppr reserve_regs))
 
-#        if 1 /* ifdef DEBUG */
+#        ifdef NCG_DEBUG
          maybetrace msg x = trace msg x
 #        else
          maybetrace msg x = x
@@ -320,9 +320,10 @@ patchInstr vreg_to_slot_map (delta,ctr) instr
         mkTmpReg vreg
            | isVirtualReg vreg
            = case [vi | (vreg', vi) <- vreg_env, vreg' == vreg] of
-                [i] -> if   regClass vreg == RcInteger
-                       then VirtualRegI (mkPseudoUnique3 i)
-                       else VirtualRegF (mkPseudoUnique3 i)
+                [i] -> case regClass vreg of
+                          RcInteger -> VirtualRegI (mkPseudoUnique3 i)
+                          RcFloat   -> VirtualRegF (mkPseudoUnique3 i)
+                          RcDouble  -> VirtualRegD (mkPseudoUnique3 i)
                 _   -> pprPanic "patchInstr: unmapped VReg" (ppr vreg)
            | otherwise
            = vreg

diff --git a/ghc/compiler/nativeGen/MachCode.lhs b/ghc/compiler/nativeGen/MachCode.lhs
index 41bec67..957a0d1 100644 (file)
--- a/ghc/compiler/nativeGen/MachCode.lhs
+++ b/ghc/compiler/nativeGen/MachCode.lhs
@@ -509,6 +509,19 @@ getRegister leaf
 -- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
 #if i386_TARGET_ARCH
 
+getRegister (StFloat f)
+  = getNatLabelNCG                 `thenNat` \ lbl ->
+    let code dst = toOL [
+           SEGMENT DataSegment,
+           LABEL lbl,
+           DATA F [ImmFloat f],
+           SEGMENT TextSegment,
+           GLD F (ImmAddr (ImmCLbl lbl) 0) dst
+           ]
+    in
+    returnNat (Any FloatRep code)
+
+
 getRegister (StDouble d)
 
   | d == 0.0
@@ -2382,7 +2395,7 @@ genCCall fn cconv kind args
              _   -> ImmLab False (ptext fn)
 
     arg_size DF = 8
-    arg_size F  = 8
+    arg_size F  = 4
     arg_size _  = 4
 
     ------------
@@ -2399,7 +2412,7 @@ genCCall fn cconv kind args
                         code `appOL`
                         toOL [SUB L (OpImm (ImmInt 8)) (OpReg esp),
                               DELTA (delta-size),
-                              GST DF reg (AddrBaseIndex (Just esp) 
+                              GST sz reg (AddrBaseIndex (Just esp) 
                                                         Nothing 
                                                         (ImmInt 0))]
                        )
@@ -2987,7 +3000,7 @@ trivialFCode pk instr x y
              code2 `snocOL`
              instr (primRepToSize pk) tmp1 src2 dst
     in
-    returnNat (Any DoubleRep code__2)
+    returnNat (Any pk code__2)
 
 
 -------------

diff --git a/ghc/compiler/nativeGen/MachMisc.lhs b/ghc/compiler/nativeGen/MachMisc.lhs
index b06cac3..d287ac1 100644 (file)
--- a/ghc/compiler/nativeGen/MachMisc.lhs
+++ b/ghc/compiler/nativeGen/MachMisc.lhs
@@ -43,7 +43,7 @@ import AbsCUtils      ( magicIdPrimRep )
 import CLabel           ( CLabel, isAsmTemp )
 import Literal         ( mkMachInt, Literal(..) )
 import MachRegs                ( stgReg, callerSaves, RegLoc(..),
-                         Imm(..), Reg(..), 
+                         Imm(..), Reg, 
                          MachRegsAddr(..)
 #                         if sparc_TARGET_ARCH
                           ,fp, sp

diff --git a/ghc/compiler/nativeGen/MachRegs.lhs b/ghc/compiler/nativeGen/MachRegs.lhs
index 5e7e586..45f062f 100644 (file)
--- a/ghc/compiler/nativeGen/MachRegs.lhs
+++ b/ghc/compiler/nativeGen/MachRegs.lhs
@@ -372,6 +372,10 @@ Intel x86 architecture:
   fp registers, and 3-operand insns for them, and we translate this into
   real stack-based x86 fp code after register allocation.
 
+The fp registers are all Double registers; we don't have any RcFloat class
+regs.  @regClass@ barfs if you give it a VirtualRegF, and mkVReg above should
+never generate them.
+
 \begin{code}
 #if i386_TARGET_ARCH
 
@@ -394,8 +398,9 @@ fake5 = RealReg 13
 
 regClass (RealReg i)     = if i < 8 then RcInteger else RcDouble
 regClass (VirtualRegI u) = RcInteger
-regClass (VirtualRegF u) = RcFloat
 regClass (VirtualRegD u) = RcDouble
+regClass (VirtualRegF u) = pprPanic "regClass(x86):VirtualRegF" 
+                                    (ppr (VirtualRegF u))
 
 regNames 
    = ["%eax", "%ebx", "%ecx", "%edx", "%esi", "%edi", "%ebp", "%esp", 
@@ -470,29 +475,6 @@ f0  = RealReg (fReg 0)
 f1  = RealReg (fReg 1)
 
 #endif
-
--------------------------------
-callClobberedRegs :: [Reg]
-callClobberedRegs
-  =
-#if alpha_TARGET_ARCH
-    [0, 1, 2, 3, 4, 5, 6, 7, 8,
-     16, 17, 18, 19, 20, 21, 22, 23, 24, 25, 26, 27, 28, 29,
-     fReg 0, fReg 1, fReg 10, fReg 11, fReg 12, fReg 13, fReg 14, fReg 15,
-     fReg 16, fReg 17, fReg 18, fReg 19, fReg 20, fReg 21, fReg 22, fReg 23,
-     fReg 24, fReg 25, fReg 26, fReg 27, fReg 28, fReg 29, fReg 30]
-#endif {- alpha_TARGET_ARCH -}
-#if i386_TARGET_ARCH
-    -- caller-saves registers
-    [eax,ecx,edx,fake0,fake1,fake2,fake3,fake4,fake5]
-#endif {- i386_TARGET_ARCH -}
-#if sparc_TARGET_ARCH
-    map RealReg 
-        ( oReg 7 :
-          [oReg i | i <- [0..5]] ++
-          [gReg i | i <- [1..7]] ++
-          [fReg i | i <- [0..31]] )
-#endif {- sparc_TARGET_ARCH -}
 \end{code}
 
 Redefine the literals used for machine-registers with non-numeric
@@ -650,7 +632,7 @@ baseRegOffset Hp                 = OFFSET_Hp
 baseRegOffset HpLim                 = OFFSET_HpLim
 baseRegOffset CurrentTSO            = OFFSET_CurrentTSO
 baseRegOffset CurrentNursery        = OFFSET_CurrentNursery
-#ifdef DEBUG
+#ifdef NCG_DEBUG
 baseRegOffset BaseReg               = panic "baseRegOffset:BaseReg"
 baseRegOffset CurCostCentre         = panic "baseRegOffset:CurCostCentre"
 baseRegOffset VoidReg               = panic "baseRegOffset:VoidReg"
@@ -828,12 +810,39 @@ allMachRegNos
                      ++ [nCG_FirstFloatReg .. f31]),
                    )))
 -- allocatableRegs is allMachRegNos with the fixed-use regs removed.
+-- i.e., these are the regs for which we are prepared to allow the
+-- register allocator to attempt to map VRegs to.
 allocatableRegs :: [Reg]
 allocatableRegs
    = let isFree (RealReg (I# i)) = _IS_TRUE_(freeReg i)
      in  filter isFree (map RealReg allMachRegNos)
 
 -------------------------------
+-- these are the regs which we cannot assume stay alive over a
+-- C call.  
+callClobberedRegs :: [Reg]
+callClobberedRegs
+  =
+#if alpha_TARGET_ARCH
+    [0, 1, 2, 3, 4, 5, 6, 7, 8,
+     16, 17, 18, 19, 20, 21, 22, 23, 24, 25, 26, 27, 28, 29,
+     fReg 0, fReg 1, fReg 10, fReg 11, fReg 12, fReg 13, fReg 14, fReg 15,
+     fReg 16, fReg 17, fReg 18, fReg 19, fReg 20, fReg 21, fReg 22, fReg 23,
+     fReg 24, fReg 25, fReg 26, fReg 27, fReg 28, fReg 29, fReg 30]
+#endif {- alpha_TARGET_ARCH -}
+#if i386_TARGET_ARCH
+    -- caller-saves registers
+    map RealReg [eax,ecx,edx,fake0,fake1,fake2,fake3,fake4,fake5]
+#endif {- i386_TARGET_ARCH -}
+#if sparc_TARGET_ARCH
+    map RealReg 
+        ( oReg 7 :
+          [oReg i | i <- [0..5]] ++
+          [gReg i | i <- [1..7]] ++
+          [fReg i | i <- [0..31]] )
+#endif {- sparc_TARGET_ARCH -}
+
+-------------------------------
 -- argRegs is the set of regs which are read for an n-argument call to C.
 -- For archs which pass all args on the stack (x86), is empty.
 -- Sparc passes up to the first 6 args in regs.
@@ -866,8 +875,6 @@ argRegs 6 = map (RealReg . oReg) [0,1,2,3,4,5]
 argRegs _ = panic "MachRegs.argRegs(sparc): don't know about >6 arguments!"
 #endif {- sparc_TARGET_ARCH -}
 
-
-
 -------------------------------
 -- all of the arg regs ??
 #if alpha_TARGET_ARCH