[project @ 2000-06-16 09:32:32 by sewardj]

Fix sparc bustage following latest round of NCG hacking (reg-alloc stuff).
Still won't work, but at least should compile again.

ghc/compiler/nativeGen/MachCode.lhs

@@ -2395,10 +2395,15 @@ genCCall fn cconv kind args
 -- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
 #if sparc_TARGET_ARCH
 
+-- Implement this!  It should be im MachRegs.lhs, not here.
+allArgRegs :: [Reg]
+allArgRegs = error "nativeGen(sparc): allArgRegs"
+
 genCCall fn cconv kind args
   = mapAccumLNat get_arg (allArgRegs, eXTRA_STK_ARGS_HERE) args
     	    	    	  `thenNat` \ ((unused,_), argCode) ->
     let
+
     	nRegs = length allArgRegs - length unused
     	call = CALL fn__2 nRegs False
     	code = concatOL argCode

ghc/compiler/nativeGen/MachMisc.lhs

@@ -636,7 +636,7 @@ riZero :: RI -> Bool
 
 riZero (RIImm (ImmInt 0))	    = True
 riZero (RIImm (ImmInteger 0))	    = True
-riZero (RIReg (FixedReg ILIT(0)))   = True
+riZero (RIReg (RealReg 0))          = True
 riZero _			    = False
 
 #endif {- sparc_TARGET_ARCH -}

ghc/compiler/nativeGen/MachRegs.lhs

@@ -45,9 +45,8 @@ module MachRegs (
 	, fake0, fake1, fake2, fake3, fake4, fake5
 #endif
 #if sparc_TARGET_ARCH
-	, allArgRegs
 	, fits13Bits
-	, fPair, fpRel, gReg, iReg, lReg, oReg, largeOffsetError
+	, fpRel, gReg, iReg, lReg, oReg, largeOffsetError
 	, fp, g0, o0, f0
 	
 #endif
@@ -134,7 +133,7 @@ addrOffset addr off
        | otherwise     -> Nothing
        where n2 = n + toInteger off
 
-      AddrRegReg r (FixedReg ILIT(0))
+      AddrRegReg r (RealReg 0)
        | fits13Bits off -> Just (AddrRegImm r (ImmInt off))
        | otherwise     -> Nothing
        
@@ -379,6 +378,8 @@ regClass (VirtualRegF u) = RcFloating
 regNames 
    = ["%eax", "%ebx", "%ecx", "%edx", "%esi", "%edi", "%ebp", "%esp", 
       "%fake0", "%fake1", "%fake2", "%fake3", "%fake4", "%fake5", "%fake6"]
+
+showReg :: Int -> String
 showReg n
    = if   n >= 0 && n < 14
      then regNames !! n
@@ -390,7 +391,9 @@ showReg n
 The SPARC has 64 registers of interest; 32 integer registers and 32
 floating point registers.  The mapping of STG registers to SPARC
 machine registers is defined in StgRegs.h.  We are, of course,
-prepared for any eventuality.
+prepared for any eventuality.  When (if?) the sparc nativegen is 
+ever revived, we should just treat it as if it has 16 floating
+regs, and use them in pairs.  
 
 \begin{code}
 #if sparc_TARGET_ARCH
@@ -402,16 +405,24 @@ lReg x = (16 + x)
 iReg x = (24 + x)
 fReg x = (32 + x)
 
-fPair :: Reg -> Reg
-fPair (FixedReg i) = FixedReg (i _ADD_ ILIT(1))
-fPair (MappedReg i) = MappedReg (i _ADD_ ILIT(1))
+-- CHECK THIS
+regClass (RealReg i)     = if i < 32 then RcInteger else RcFloating
+regClass (VirtualRegI u) = RcInteger
+regClass (VirtualRegF u) = RcFloating
+
+-- FIX THIS
+showReg :: Int -> String
+showReg n
+   = if   n >= 0 && n < 64
+     then "%sparc_real_reg_" ++ show n
+     else "%unknown_sparc_real_reg_" ++ show n
 
 g0, fp, sp, o0, f0 :: Reg
-g0 = case (gReg 0) of { IBOX(g0) -> FixedReg g0 }
-fp = case (iReg 6) of { IBOX(i6) -> FixedReg i6 }
-sp = case (oReg 6) of { IBOX(o6) -> FixedReg o6 }
-o0 = realReg  (oReg 0)
-f0 = realReg  (fReg 0)
+g0 = RealReg (gReg 0)
+fp = RealReg (iReg 6)
+sp = RealReg (oReg 6)
+o0 = RealReg (oReg 0)
+f0 = RealReg (fReg 0)
 
 #endif
 \end{code}

ghc/compiler/nativeGen/PprMach.lhs

@@ -332,7 +332,7 @@ pprAddr (AddrBaseIndex base index displacement)
 -------------------
 
 #if sparc_TARGET_ARCH
-pprAddr (AddrRegReg r1 (FixedReg ILIT(0))) = pprReg r1
+pprAddr (AddrRegReg r1 (RealReg 0)) = pprReg r1
 
 pprAddr (AddrRegReg r1 r2)
   = hcat [ pprReg r1, char '+', pprReg r2 ]
@@ -1344,6 +1344,7 @@ pprCondInstr name cond arg
 -- even clumsier, to allow for RegReg regs that show when doing indexed
 -- reads (bytearrays).
 --
+
 pprInstr (LD DF (AddrRegReg g1 g2) reg)
   = hcat [
 	ptext SLIT("\tadd\t"), pprReg g1,comma,pprReg g2,comma,pprReg g1, char '\n',
@@ -1535,6 +1536,11 @@ pprInstr (CALL imm n _)
 
 Continue with SPARC-only printing bits and bobs:
 \begin{code}
+-- Get rid of this fPair nonsense, don't reimplement it.  It's an
+-- entirely unnecessary complication.  I just put this here so it will 
+-- at least compile on Sparcs.  JRS, 000616.
+fPair = error "nativeGen(sparc): unimp fPair"
+
 pprRI :: RI -> SDoc
 pprRI (RIReg r) = pprReg r
 pprRI (RIImm r) = pprImm r

ghc/compiler/nativeGen/RegAllocInfo.lhs

@@ -148,6 +148,10 @@ noUsage  = RU emptyRegSet emptyRegSet
 
 regUsage :: Instr -> RegUsage
 
+interesting (VirtualRegI _)  = True
+interesting (VirtualRegF _)  = True
+interesting (RealReg (I# i)) = _IS_TRUE_(freeReg i)
+
 #if alpha_TARGET_ARCH
 
 regUsage instr = case instr of
@@ -331,11 +335,6 @@ regUsage instr = case instr of
     mkRU src dst = RU (regSetFromList (filter interesting src))
   	    	      (regSetFromList (filter interesting dst))
 
-    interesting (VirtualRegI _)  = True
-    interesting (VirtualRegF _)  = True
-    interesting (RealReg (I# i)) = _IS_TRUE_(freeReg i)
-
-
 -- Allow the spiller to de\cide whether or not it can use 
 -- %edx as a spill temporary.
 hasFixedEDX instr
@@ -375,18 +374,17 @@ regUsage instr = case instr of
     FxTOy s1 s2 r1 r2 	-> usage ([r1], [r2])
 
     -- We assume that all local jumps will be BI/BF.  JMP must be out-of-line.
-    JMP addr 	    	-> RU (mkRegSet (filter interesting (regAddr addr))) freeRegSet
+    JMP addr 	    	-> noUsage
 
-    CALL _ n True   	-> endUsage
-    CALL _ n False  	-> RU (argRegSet n) callClobberedRegSet
+    -- I don't understand this terminal vs non-terminal distinction for
+    -- CALLs is.  Fix.  JRS, 000616.
+    CALL _ n True   	-> error "nativeGen(sparc): unimp regUsage CALL"
+    CALL _ n False  	-> error "nativeGen(sparc): unimp regUsage CALL"
 
     _ 	    	    	-> noUsage
   where
-    usage (src, dst) = RU (mkRegSet (filter interesting src))
-    	    	    	  (mkRegSet (filter interesting dst))
-
-    interesting (FixedReg _) = False
-    interesting _ = True
+    usage (src, dst) = RU (regSetFromList (filter interesting src))
+    	    	    	  (regSetFromList (filter interesting dst))
 
     regAddr (AddrRegReg r1 r2) = [r1, r2]
     regAddr (AddrRegImm r1 _)  = [r1]
@@ -484,7 +482,7 @@ findReservedRegs instrs
 
 @insnFuture@ indicates the places we could get to following the
 current instruction.  This is used by the register allocator to
-compute the flow edges for a bunch of instructions.
+compute the flow edges between instructions.
 
 \begin{code}
 data InsnFuture 
@@ -539,15 +537,7 @@ insnFuture insn
 
     -- We assume that all local jumps will be BI/BF.  JMP must be out-of-line.
 
-    BI ALWAYS _ (ImmCLbl lbl)	-> RL (lookup lbl) future
-    BI _ _ (ImmCLbl lbl)	-> RL (lookup lbl `unionRegSets` live) future
-    BF ALWAYS _ (ImmCLbl lbl)	-> RL (lookup lbl) future
-    BF _ _ (ImmCLbl lbl)	-> RL (lookup lbl `unionRegSets` live) future
-    JMP _			-> RL emptyRegSet future
-    CALL _ i True   -> RL emptyRegSet future
-    CALL _ i False  -> RL live future
-    LABEL lbl	    -> RL live (FL (all `unionRegSets` live) (addToFM env lbl live))
-    _		    -> info
+    boring -> error "nativeGen(sparc): unimp insnFuture"
 
 #endif {- sparc_TARGET_ARCH -}
 \end{code}
@@ -801,7 +791,8 @@ spillReg vreg_to_slot_map delta dyn vreg
                         else MOV L (OpReg dyn) (OpAddr (spRel off_w))
 
 	{-SPARC: spill below frame pointer leaving 2 words/spill-}
-	,IF_ARCH_sparc( ST sz dyn (fpRel (- (off `div` 4)))
+	,IF_ARCH_sparc( ST (error "get sz from regClass vreg") 
+                           dyn (fpRel (- (off `div` 4)))
         ,)))
 
    
@@ -816,6 +807,7 @@ loadReg vreg_to_slot_map delta vreg dyn
                         if   regClass vreg == RcFloating
                         then GLD F80 (spRel off_w) dyn
                         else MOV L (OpAddr (spRel off_w)) (OpReg dyn)
-	,IF_ARCH_sparc( LD  sz (fpRel (- (off `div` 4))) dyn
+	,IF_ARCH_sparc( LD  (error "get sz from regClass vreg")
+                            (fpRel (- (off `div` 4))) dyn
 	,)))
 \end{code}

ghc/compiler/nativeGen/StixPrim.lhs

@@ -26,7 +26,7 @@ import CLabel		( mkIntlikeClosureLabel, mkCharlikeClosureLabel,
 			  mkMAP_FROZEN_infoLabel, mkForeignLabel )
 import Outputable
 
-import Char	       	( ord, isAlphaNum )
+import Char	       	( ord, isAlpha, isDigit )
 
 #include "NCG.h"
 \end{code}
@@ -470,7 +470,7 @@ litLitToStix nm
   | otherwise    = error ("\nlitLitToStix: can't handle `" ++ nm ++ "'\n" 
                            ++ "suggested workaround: use flag -fvia-C\n")
 
-  where is_id c = isAlphaNum c || c == '_'
+  where is_id c = isAlpha c || isDigit c || c == '_'
 \end{code}
 
 Sizes of the CharLike and IntLike closures that are arranged as arrays