Fix sparc bustage following latest round of NCG hacking (reg-alloc stuff).
Still won't work, but at least should compile again.
-- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
#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
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 -}
, 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
| 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
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
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
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}
-------------------
#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 ]
-- 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',
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
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
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
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]
@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
-- 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}
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)))
,)))
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}
mkMAP_FROZEN_infoLabel, mkForeignLabel )
import Outputable
-import Char ( ord, isAlphaNum )
+import Char ( ord, isAlpha, isDigit )
#include "NCG.h"
\end{code}
| 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
projects / ghc-hetmet.git / commitdiff