From f6ce418875ed08171c85352ca93010570708810d Mon Sep 17 00:00:00 2001 From: sewardj Date: Fri, 16 Jun 2000 09:32:32 +0000 Subject: [PATCH] [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 | 5 ++++ ghc/compiler/nativeGen/MachMisc.lhs | 2 +- ghc/compiler/nativeGen/MachRegs.lhs | 35 +++++++++++++++++--------- ghc/compiler/nativeGen/PprMach.lhs | 8 +++++- ghc/compiler/nativeGen/RegAllocInfo.lhs | 42 +++++++++++++------------------ ghc/compiler/nativeGen/StixPrim.lhs | 4 +-- 6 files changed, 55 insertions(+), 41 deletions(-) diff --git a/ghc/compiler/nativeGen/MachCode.lhs b/ghc/compiler/nativeGen/MachCode.lhs index 6769c33..85373b1 100644 --- a/ghc/compiler/nativeGen/MachCode.lhs +++ b/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 diff --git a/ghc/compiler/nativeGen/MachMisc.lhs b/ghc/compiler/nativeGen/MachMisc.lhs index 37dcd39..b9c69e7 100644 --- a/ghc/compiler/nativeGen/MachMisc.lhs +++ b/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 -} diff --git a/ghc/compiler/nativeGen/MachRegs.lhs b/ghc/compiler/nativeGen/MachRegs.lhs index f7dc79d..cb8006a 100644 --- a/ghc/compiler/nativeGen/MachRegs.lhs +++ b/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} diff --git a/ghc/compiler/nativeGen/PprMach.lhs b/ghc/compiler/nativeGen/PprMach.lhs index 41773fa..af8c5b3 100644 --- a/ghc/compiler/nativeGen/PprMach.lhs +++ b/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 diff --git a/ghc/compiler/nativeGen/RegAllocInfo.lhs b/ghc/compiler/nativeGen/RegAllocInfo.lhs index eedfe41..1013252 100644 --- a/ghc/compiler/nativeGen/RegAllocInfo.lhs +++ b/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} diff --git a/ghc/compiler/nativeGen/StixPrim.lhs b/ghc/compiler/nativeGen/StixPrim.lhs index 5571528..b7ca132 100644 --- a/ghc/compiler/nativeGen/StixPrim.lhs +++ b/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 -- 1.7.10.4