X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2FnativeGen%2FRegAllocInfo.lhs;h=e0377b801f43afda9114d83ffd914a9be3aa241d;hb=56af76cc6a264621bfd18071f21e6a608e691e47;hp=1013252337816c6926fddb474b8fb1f566635936;hpb=f6ce418875ed08171c85352ca93010570708810d;p=ghc-hetmet.git diff --git a/ghc/compiler/nativeGen/RegAllocInfo.lhs b/ghc/compiler/nativeGen/RegAllocInfo.lhs index 1013252..e0377b8 100644 --- a/ghc/compiler/nativeGen/RegAllocInfo.lhs +++ b/ghc/compiler/nativeGen/RegAllocInfo.lhs @@ -36,20 +36,17 @@ module RegAllocInfo ( #include "HsVersions.h" -import List ( partition, sort ) -import OrdList ( unitOL ) +import List ( sort ) import MachMisc import MachRegs -import MachCode ( InstrBlock ) - -import BitSet ( unitBS, mkBS, minusBS, unionBS, listBS, BitSet ) -import CLabel ( pprCLabel_asm, isAsmTemp, CLabel{-instance Ord-} ) +import Stix ( DestInfo(..) ) +import CLabel ( isAsmTemp, CLabel{-instance Ord-} ) import FiniteMap ( addToFM, lookupFM, FiniteMap ) -import PrimRep ( PrimRep(..) ) -import UniqSet -- quite a bit of it import Outputable import Constants ( rESERVED_C_STACK_BYTES ) import Unique ( Unique, Uniquable(..) ) +import FastTypes + \end{code} %************************************************************************ @@ -124,7 +121,7 @@ intersectionRegSets (MkRegSet xs1) (MkRegSet xs2) %************************************************************************ %* * -\subsection{@RegUsage@ type; @noUsage@, @endUsage@, @regUsage@ functions} +\subsection{@RegUsage@ type; @noUsage@ and @regUsage@ functions} %* * %************************************************************************ @@ -150,15 +147,16 @@ regUsage :: Instr -> RegUsage interesting (VirtualRegI _) = True interesting (VirtualRegF _) = True -interesting (RealReg (I# i)) = _IS_TRUE_(freeReg i) +interesting (VirtualRegD _) = True +interesting (RealReg i) = isFastTrue (freeReg i) #if alpha_TARGET_ARCH regUsage instr = case instr of LD B reg addr -> usage (regAddr addr, [reg, t9]) - LD BU reg addr -> usage (regAddr addr, [reg, t9]) + LD Bu reg addr -> usage (regAddr addr, [reg, t9]) -- LD W reg addr -> usage (regAddr addr, [reg, t9]) : UNUSED --- LD WU reg addr -> usage (regAddr addr, [reg, t9]) : UNUSED +-- LD Wu reg addr -> usage (regAddr addr, [reg, t9]) : UNUSED LD sz reg addr -> usage (regAddr addr, [reg]) LDA reg addr -> usage (regAddr addr, [reg]) LDAH reg addr -> usage (regAddr addr, [reg]) @@ -238,7 +236,12 @@ regUsage instr = case instr of ADD sz src dst -> usageRM src dst SUB sz src dst -> usageRM src dst IMUL sz src dst -> usageRM src dst - IDIV sz src -> mkRU (eax:edx:use_R src) [eax,edx] + IMUL64 sd1 sd2 -> mkRU [sd1,sd2] [sd1,sd2] + MUL sz src dst -> usageRM src dst + IQUOT sz src dst -> usageRM src dst + IREM sz src dst -> usageRM src dst + QUOT sz src dst -> usageRM src dst + REM sz src dst -> usageRM src dst AND sz src dst -> usageRM src dst OR sz src dst -> usageRM src dst XOR sz src dst -> usageRM src dst @@ -255,8 +258,9 @@ regUsage instr = case instr of CMP sz src dst -> mkRU (use_R src ++ use_R dst) [] SETCC cond op -> mkRU [] (def_W op) JXX cond lbl -> mkRU [] [] - JMP op -> mkRU (use_R op) [] - CALL imm -> mkRU [] callClobberedRegs + JMP dsts op -> mkRU (use_R op) [] + CALL (Left imm) -> mkRU [] callClobberedRegs + CALL (Right reg) -> mkRU [reg] callClobberedRegs CLTD -> mkRU [eax] [edx] NOP -> mkRU [] [] @@ -267,10 +271,7 @@ regUsage instr = case instr of GLDZ dst -> mkRU [] [dst] GLD1 dst -> mkRU [] [dst] - GFTOD src dst -> mkRU [src] [dst] GFTOI src dst -> mkRU [src] [dst] - - GDTOF src dst -> mkRU [src] [dst] GDTOI src dst -> mkRU [src] [dst] GITOF src dst -> mkRU [src] [dst] @@ -313,9 +314,6 @@ regUsage instr = case instr of usageM (OpReg reg) = mkRU [reg] [reg] usageM (OpAddr ea) = mkRU (use_EA ea) [] - -- caller-saves registers - callClobberedRegs = [eax,ecx,edx,fake0,fake1,fake2,fake3,fake4,fake5] - -- Registers defd when an operand is written. def_W (OpReg reg) = [reg] def_W (OpAddr ea) = [] @@ -335,51 +333,46 @@ regUsage instr = case instr of mkRU src dst = RU (regSetFromList (filter interesting src)) (regSetFromList (filter interesting dst)) --- Allow the spiller to de\cide whether or not it can use --- %edx as a spill temporary. -hasFixedEDX instr - = case instr of - IDIV _ _ -> True - CLTD -> True - other -> False - #endif {- i386_TARGET_ARCH -} -- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - #if sparc_TARGET_ARCH regUsage instr = case instr of - LD sz addr reg -> usage (regAddr addr, [reg]) - ST sz reg addr -> usage (reg : regAddr addr, []) - ADD x cc r1 ar r2 -> usage (r1 : regRI ar, [r2]) - SUB x cc r1 ar r2 -> usage (r1 : regRI ar, [r2]) - AND b r1 ar r2 -> usage (r1 : regRI ar, [r2]) - ANDN b r1 ar r2 -> usage (r1 : regRI ar, [r2]) - OR b r1 ar r2 -> usage (r1 : regRI ar, [r2]) - ORN b r1 ar r2 -> usage (r1 : regRI ar, [r2]) - XOR b r1 ar r2 -> usage (r1 : regRI ar, [r2]) - XNOR b r1 ar r2 -> usage (r1 : regRI ar, [r2]) - SLL r1 ar r2 -> usage (r1 : regRI ar, [r2]) - SRL r1 ar r2 -> usage (r1 : regRI ar, [r2]) - SRA r1 ar r2 -> usage (r1 : regRI ar, [r2]) + LD sz addr reg -> usage (regAddr addr, [reg]) + ST sz reg addr -> usage (reg : regAddr addr, []) + ADD x cc r1 ar r2 -> usage (r1 : regRI ar, [r2]) + SUB x cc r1 ar r2 -> usage (r1 : regRI ar, [r2]) + UMUL cc r1 ar r2 -> usage (r1 : regRI ar, [r2]) + SMUL cc r1 ar r2 -> usage (r1 : regRI ar, [r2]) + RDY rd -> usage ([], [rd]) + AND b r1 ar r2 -> usage (r1 : regRI ar, [r2]) + ANDN b r1 ar r2 -> usage (r1 : regRI ar, [r2]) + OR b r1 ar r2 -> usage (r1 : regRI ar, [r2]) + ORN b r1 ar r2 -> usage (r1 : regRI ar, [r2]) + XOR b r1 ar r2 -> usage (r1 : regRI ar, [r2]) + XNOR b r1 ar r2 -> usage (r1 : regRI ar, [r2]) + SLL r1 ar r2 -> usage (r1 : regRI ar, [r2]) + SRL r1 ar r2 -> usage (r1 : regRI ar, [r2]) + SRA r1 ar r2 -> usage (r1 : regRI ar, [r2]) SETHI imm reg -> usage ([], [reg]) - FABS s r1 r2 -> usage ([r1], [r2]) - FADD s r1 r2 r3 -> usage ([r1, r2], [r3]) - FCMP e s r1 r2 -> usage ([r1, r2], []) - FDIV s r1 r2 r3 -> usage ([r1, r2], [r3]) - FMOV s r1 r2 -> usage ([r1], [r2]) - FMUL s r1 r2 r3 -> usage ([r1, r2], [r3]) - FNEG s r1 r2 -> usage ([r1], [r2]) + FABS s r1 r2 -> usage ([r1], [r2]) + FADD s r1 r2 r3 -> usage ([r1, r2], [r3]) + FCMP e s r1 r2 -> usage ([r1, r2], []) + FDIV s r1 r2 r3 -> usage ([r1, r2], [r3]) + FMOV s r1 r2 -> usage ([r1], [r2]) + FMUL s r1 r2 r3 -> usage ([r1, r2], [r3]) + FNEG s r1 r2 -> usage ([r1], [r2]) FSQRT s r1 r2 -> usage ([r1], [r2]) - FSUB s r1 r2 r3 -> usage ([r1, r2], [r3]) + FSUB s r1 r2 r3 -> usage ([r1, r2], [r3]) 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 -> noUsage + JMP dst addr -> usage (regAddr addr, []) - -- 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" + CALL (Left imm) n True -> noUsage + CALL (Left imm) n False -> usage (argRegs n, callClobberedRegs) + CALL (Right reg) n True -> usage ([reg], []) + CALL (Right reg) n False -> usage (reg : (argRegs n), callClobberedRegs) _ -> noUsage where @@ -393,6 +386,54 @@ regUsage instr = case instr of regRI _ = [] #endif {- sparc_TARGET_ARCH -} +-- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - +#if powerpc_TARGET_ARCH + +regUsage instr = case instr of + LD sz reg addr -> usage (regAddr addr, [reg]) + ST sz reg addr -> usage (reg : regAddr addr, []) + STU sz reg addr -> usage (reg : regAddr addr, []) + LIS reg imm -> usage ([], [reg]) + LI reg imm -> usage ([], [reg]) + MR reg1 reg2 -> usage ([reg2], [reg1]) + CMP sz reg ri -> usage (reg : regRI ri,[]) + CMPL sz reg ri -> usage (reg : regRI ri,[]) + BCC cond lbl -> noUsage + MTCTR reg -> usage ([reg],[]) + BCTR dsts -> noUsage + BL imm params -> usage (params, callClobberedRegs) + BCTRL params -> usage (params, callClobberedRegs) + ADD reg1 reg2 ri -> usage (reg2 : regRI ri, [reg1]) + SUBF reg1 reg2 reg3-> usage ([reg2,reg3], [reg1]) + MULLW reg1 reg2 ri -> usage (reg2 : regRI ri, [reg1]) + DIVW reg1 reg2 reg3-> usage ([reg2,reg3], [reg1]) + DIVWU reg1 reg2 reg3-> usage ([reg2,reg3], [reg1]) + AND reg1 reg2 ri -> usage (reg2 : regRI ri, [reg1]) + OR reg1 reg2 ri -> usage (reg2 : regRI ri, [reg1]) + XOR reg1 reg2 ri -> usage (reg2 : regRI ri, [reg1]) + XORIS reg1 reg2 imm -> usage ([reg2], [reg1]) + NEG reg1 reg2 -> usage ([reg2], [reg1]) + NOT reg1 reg2 -> usage ([reg2], [reg1]) + SLW reg1 reg2 ri -> usage (reg2 : regRI ri, [reg1]) + SRW reg1 reg2 ri -> usage (reg2 : regRI ri, [reg1]) + SRAW reg1 reg2 ri -> usage (reg2 : regRI ri, [reg1]) + FADD sz r1 r2 r3 -> usage ([r2,r3], [r1]) + FSUB sz r1 r2 r3 -> usage ([r2,r3], [r1]) + FMUL sz r1 r2 r3 -> usage ([r2,r3], [r1]) + FDIV sz r1 r2 r3 -> usage ([r2,r3], [r1]) + FNEG r1 r2 -> usage ([r2], [r1]) + FCMP r1 r2 -> usage ([r1,r2], []) + FCTIWZ r1 r2 -> usage ([r2], [r1]) + _ -> noUsage + where + usage (src, dst) = RU (regSetFromList (filter interesting src)) + (regSetFromList (filter interesting dst)) + regAddr (AddrRegReg r1 r2) = [r1, r2] + regAddr (AddrRegImm r1 _) = [r1] + + regRI (RIReg r) = [r] + regRI _ = [] +#endif {- powerpc_TARGET_ARCH -} \end{code} @@ -439,17 +480,15 @@ findReservedRegs instrs error "findReservedRegs: alpha" #endif #if sparc_TARGET_ARCH - = --[[NCG_Reserved_I1, NCG_Reserved_I2, - -- NCG_Reserved_F1, NCG_Reserved_F2, - -- NCG_Reserved_D1, NCG_Reserved_D2]] - error "findReservedRegs: sparc" + = [[NCG_SpillTmp_I1, NCG_SpillTmp_I2, + NCG_SpillTmp_D1, NCG_SpillTmp_D2, + NCG_SpillTmp_F1, NCG_SpillTmp_F2]] #endif #if i386_TARGET_ARCH -- We can use %fake4 and %fake5 safely for float temps. - -- Int regs are more troublesome. Only %ecx is definitely - -- available. If there are no division insns, we can use %edx - -- too. At a pinch, we also could bag %eax if there are no - -- divisions and no ccalls, but so far we've never encountered + -- Int regs are more troublesome. Only %ecx and %edx are + -- definitely. At a pinch, we also could bag %eax if there + -- are no ccalls, but so far we've never encountered -- a situation where three integer temporaries are necessary. -- -- Because registers are in short supply on x86, we give the @@ -461,7 +500,7 @@ findReservedRegs instrs = let f1 = fake5 f2 = fake4 intregs_avail - = ecx : if any hasFixedEDX instrs then [] else [edx] + = [ecx, edx] possibilities = case intregs_avail of [i1] -> [ [], [i1], [f1], [i1,f1], [f1,f2], @@ -472,6 +511,10 @@ findReservedRegs instrs in possibilities #endif +#if powerpc_TARGET_ARCH + = [[NCG_SpillTmp_I1, NCG_SpillTmp_I2, + NCG_SpillTmp_D1, NCG_SpillTmp_D2]] +#endif \end{code} %************************************************************************ @@ -491,6 +534,7 @@ data InsnFuture | Next -- falls through to next insn | Branch CLabel -- unconditional branch to the label | NextOrBranch CLabel -- conditional branch to the label + | MultiFuture [CLabel] -- multiple specific futures --instance Outputable InsnFuture where -- ppr NoFuture = text "NoFuture" @@ -523,11 +567,17 @@ insnFuture insn JXX _ clbl | isAsmTemp clbl -> NextOrBranch clbl JXX _ _ -> panic "insnFuture: conditional jump to non-local label" + -- If the insn says what its dests are, use em! + JMP (DestInfo dsts) _ -> MultiFuture dsts + -- unconditional jump to local label - JMP (OpImm (ImmCLbl clbl)) | isAsmTemp clbl -> Branch clbl + JMP NoDestInfo (OpImm (ImmCLbl clbl)) | isAsmTemp clbl -> Branch clbl -- unconditional jump to non-local label - JMP lbl -> NoFuture + JMP NoDestInfo lbl -> NoFuture + + -- be extra-paranoid + JMP _ _ -> panic "insnFuture(x86): JMP wierdness" boring -> Next @@ -535,11 +585,36 @@ insnFuture insn -- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - #if sparc_TARGET_ARCH - -- We assume that all local jumps will be BI/BF. JMP must be out-of-line. + -- We assume that all local jumps will be BI/BF. + BI ALWAYS _ (ImmCLbl clbl) -> Branch clbl + BI other _ (ImmCLbl clbl) -> NextOrBranch clbl + BI other _ _ -> panic "nativeGen(sparc):insnFuture(BI)" + + BF ALWAYS _ (ImmCLbl clbl) -> Branch clbl + BF other _ (ImmCLbl clbl) -> NextOrBranch clbl + BF other _ _ -> panic "nativeGen(sparc):insnFuture(BF)" - boring -> error "nativeGen(sparc): unimp insnFuture" + -- CALL(terminal) must be out-of-line. JMP is not out-of-line + -- iff it specifies its destinations. + JMP NoDestInfo _ -> NoFuture -- n.b. NoFuture == MultiFuture [] + JMP (DestInfo dsts) _ -> MultiFuture dsts + + CALL _ _ True -> NoFuture + + boring -> Next #endif {- sparc_TARGET_ARCH -} +-- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - +#if powerpc_TARGET_ARCH + BCC ALWAYS clbl | isAsmTemp clbl -> Branch clbl + | otherwise -> NoFuture + BCC _ clbl | isAsmTemp clbl -> NextOrBranch clbl + BCC _ _ -> panic "insnFuture: conditional jump to non-local label" + + BCTR (DestInfo dsts) -> MultiFuture dsts + BCTR NoDestInfo -> NoFuture + boring -> Next +#endif {- powerpc_TARGET_ARCH -} \end{code} %************************************************************************ @@ -622,7 +697,12 @@ patchRegs instr env = case instr of ADD sz src dst -> patch2 (ADD sz) src dst SUB sz src dst -> patch2 (SUB sz) src dst IMUL sz src dst -> patch2 (IMUL sz) src dst - IDIV sz src -> patch1 (IDIV sz) src + IMUL64 sd1 sd2 -> IMUL64 (env sd1) (env sd2) + MUL sz src dst -> patch2 (MUL sz) src dst + IQUOT sz src dst -> patch2 (IQUOT sz) src dst + IREM sz src dst -> patch2 (IREM sz) src dst + QUOT sz src dst -> patch2 (QUOT sz) src dst + REM sz src dst -> patch2 (REM sz) src dst AND sz src dst -> patch2 (AND sz) src dst OR sz src dst -> patch2 (OR sz) src dst XOR sz src dst -> patch2 (XOR sz) src dst @@ -637,7 +717,7 @@ patchRegs instr env = case instr of PUSH sz op -> patch1 (PUSH sz) op POP sz op -> patch1 (POP sz) op SETCC cond op -> patch1 (SETCC cond) op - JMP op -> patch1 JMP op + JMP dsts op -> patch1 (JMP dsts) op GMOV src dst -> GMOV (env src) (env dst) GLD sz src dst -> GLD sz (lookupAddr src) (env dst) @@ -646,10 +726,7 @@ patchRegs instr env = case instr of GLDZ dst -> GLDZ (env dst) GLD1 dst -> GLD1 (env 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) @@ -668,6 +745,9 @@ patchRegs instr env = case instr of GCOS sz src dst -> GCOS sz (env src) (env dst) GTAN sz src dst -> GTAN sz (env src) (env dst) + CALL (Left imm) -> instr + CALL (Right reg) -> CALL (Right (env reg)) + COMMENT _ -> instr SEGMENT _ -> instr LABEL _ -> instr @@ -675,9 +755,8 @@ patchRegs instr env = case instr of DATA _ _ -> instr DELTA _ -> instr JXX _ _ -> instr - CALL _ -> instr CLTD -> instr - _ -> pprPanic "patchInstr(x86)" empty + _ -> pprPanic "patchRegs(x86)" empty where patch1 insn op = insn (patchOp op) @@ -702,31 +781,36 @@ patchRegs instr env = case instr of #if sparc_TARGET_ARCH patchRegs instr env = case instr of - LD sz addr reg -> LD sz (fixAddr addr) (env reg) - ST sz reg addr -> ST sz (env reg) (fixAddr addr) - ADD x cc r1 ar r2 -> ADD x cc (env r1) (fixRI ar) (env r2) - SUB x cc r1 ar r2 -> SUB x cc (env r1) (fixRI ar) (env r2) - AND b r1 ar r2 -> AND b (env r1) (fixRI ar) (env r2) - ANDN b r1 ar r2 -> ANDN b (env r1) (fixRI ar) (env r2) - OR b r1 ar r2 -> OR b (env r1) (fixRI ar) (env r2) - ORN b r1 ar r2 -> ORN b (env r1) (fixRI ar) (env r2) - XOR b r1 ar r2 -> XOR b (env r1) (fixRI ar) (env r2) - XNOR b r1 ar r2 -> XNOR b (env r1) (fixRI ar) (env r2) - SLL r1 ar r2 -> SLL (env r1) (fixRI ar) (env r2) - SRL r1 ar r2 -> SRL (env r1) (fixRI ar) (env r2) - SRA r1 ar r2 -> SRA (env r1) (fixRI ar) (env r2) - SETHI imm reg -> SETHI imm (env reg) - FABS s r1 r2 -> FABS s (env r1) (env r2) - FADD s r1 r2 r3 -> FADD s (env r1) (env r2) (env r3) - FCMP e s r1 r2 -> FCMP e s (env r1) (env r2) - FDIV s r1 r2 r3 -> FDIV s (env r1) (env r2) (env r3) - FMOV s r1 r2 -> FMOV s (env r1) (env r2) - FMUL s r1 r2 r3 -> FMUL s (env r1) (env r2) (env r3) - FNEG s r1 r2 -> FNEG s (env r1) (env r2) - FSQRT s r1 r2 -> FSQRT s (env r1) (env r2) - FSUB s r1 r2 r3 -> FSUB s (env r1) (env r2) (env r3) - FxTOy s1 s2 r1 r2 -> FxTOy s1 s2 (env r1) (env r2) - JMP addr -> JMP (fixAddr addr) + LD sz addr reg -> LD sz (fixAddr addr) (env reg) + ST sz reg addr -> ST sz (env reg) (fixAddr addr) + ADD x cc r1 ar r2 -> ADD x cc (env r1) (fixRI ar) (env r2) + SUB x cc r1 ar r2 -> SUB x cc (env r1) (fixRI ar) (env r2) + UMUL cc r1 ar r2 -> UMUL cc (env r1) (fixRI ar) (env r2) + SMUL cc r1 ar r2 -> SMUL cc (env r1) (fixRI ar) (env r2) + RDY rd -> RDY (env rd) + AND b r1 ar r2 -> AND b (env r1) (fixRI ar) (env r2) + ANDN b r1 ar r2 -> ANDN b (env r1) (fixRI ar) (env r2) + OR b r1 ar r2 -> OR b (env r1) (fixRI ar) (env r2) + ORN b r1 ar r2 -> ORN b (env r1) (fixRI ar) (env r2) + XOR b r1 ar r2 -> XOR b (env r1) (fixRI ar) (env r2) + XNOR b r1 ar r2 -> XNOR b (env r1) (fixRI ar) (env r2) + SLL r1 ar r2 -> SLL (env r1) (fixRI ar) (env r2) + SRL r1 ar r2 -> SRL (env r1) (fixRI ar) (env r2) + SRA r1 ar r2 -> SRA (env r1) (fixRI ar) (env r2) + SETHI imm reg -> SETHI imm (env reg) + FABS s r1 r2 -> FABS s (env r1) (env r2) + FADD s r1 r2 r3 -> FADD s (env r1) (env r2) (env r3) + FCMP e s r1 r2 -> FCMP e s (env r1) (env r2) + FDIV s r1 r2 r3 -> FDIV s (env r1) (env r2) (env r3) + FMOV s r1 r2 -> FMOV s (env r1) (env r2) + FMUL s r1 r2 r3 -> FMUL s (env r1) (env r2) (env r3) + FNEG s r1 r2 -> FNEG s (env r1) (env r2) + FSQRT s r1 r2 -> FSQRT s (env r1) (env r2) + FSUB s r1 r2 r3 -> FSUB s (env r1) (env r2) (env r3) + FxTOy s1 s2 r1 r2 -> FxTOy s1 s2 (env r1) (env r2) + JMP dsts addr -> JMP dsts (fixAddr addr) + CALL (Left i) n t -> CALL (Left i) n t + CALL (Right r) n t -> CALL (Right (env r)) n t _ -> instr where fixAddr (AddrRegReg r1 r2) = AddrRegReg (env r1) (env r2) @@ -736,6 +820,52 @@ patchRegs instr env = case instr of fixRI other = other #endif {- sparc_TARGET_ARCH -} +-- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - +#if powerpc_TARGET_ARCH + +patchRegs instr env = case instr of + LD sz reg addr -> LD sz (env reg) (fixAddr addr) + ST sz reg addr -> ST sz (env reg) (fixAddr addr) + STU sz reg addr -> STU sz (env reg) (fixAddr addr) + LIS reg imm -> LIS (env reg) imm + LI reg imm -> LI (env reg) imm + MR reg1 reg2 -> MR (env reg1) (env reg2) + CMP sz reg ri -> CMP sz (env reg) (fixRI ri) + CMPL sz reg ri -> CMPL sz (env reg) (fixRI ri) + BCC cond lbl -> BCC cond lbl + MTCTR reg -> MTCTR (env reg) + BCTR dsts -> BCTR dsts + BL imm argRegs -> BL imm argRegs -- argument regs + BCTRL argRegs -> BCTRL argRegs -- cannot be remapped + ADD reg1 reg2 ri -> ADD (env reg1) (env reg2) (fixRI ri) + SUBF reg1 reg2 reg3-> SUBF (env reg1) (env reg2) (env reg3) + MULLW reg1 reg2 ri -> MULLW (env reg1) (env reg2) (fixRI ri) + DIVW reg1 reg2 reg3-> DIVW (env reg1) (env reg2) (env reg3) + DIVWU reg1 reg2 reg3-> DIVWU (env reg1) (env reg2) (env reg3) + AND reg1 reg2 ri -> AND (env reg1) (env reg2) (fixRI ri) + OR reg1 reg2 ri -> OR (env reg1) (env reg2) (fixRI ri) + XOR reg1 reg2 ri -> XOR (env reg1) (env reg2) (fixRI ri) + XORIS reg1 reg2 imm -> XORIS (env reg1) (env reg2) imm + NEG reg1 reg2 -> NEG (env reg1) (env reg2) + NOT reg1 reg2 -> NOT (env reg1) (env reg2) + SLW reg1 reg2 ri -> SLW (env reg1) (env reg2) (fixRI ri) + SRW reg1 reg2 ri -> SRW (env reg1) (env reg2) (fixRI ri) + SRAW reg1 reg2 ri -> SRAW (env reg1) (env reg2) (fixRI ri) + FADD sz r1 r2 r3 -> FADD sz (env r1) (env r2) (env r3) + FSUB sz r1 r2 r3 -> FSUB sz (env r1) (env r2) (env r3) + FMUL sz r1 r2 r3 -> FMUL sz (env r1) (env r2) (env r3) + FDIV sz r1 r2 r3 -> FDIV sz (env r1) (env r2) (env r3) + FNEG r1 r2 -> FNEG (env r1) (env r2) + FCMP r1 r2 -> FCMP (env r1) (env r2) + FCTIWZ r1 r2 -> FCTIWZ (env r1) (env r2) + _ -> instr + where + fixAddr (AddrRegReg r1 r2) = AddrRegReg (env r1) (env r2) + fixAddr (AddrRegImm r1 i) = AddrRegImm (env r1) i + + fixRI (RIReg r) = RIReg (env r) + fixRI other = other +#endif {- powerpc_TARGET_ARCH -} \end{code} %************************************************************************ @@ -747,13 +877,15 @@ patchRegs instr env = case instr of Spill to memory, and load it back... JRS, 000122: on x86, don't spill directly above the stack pointer, -since some insn sequences (int <-> conversions, and eventually -StixInteger) use this as a temp location. Leave 8 words (ie, 64 bytes -for a 64-bit arch) of slop. +since some insn sequences (int <-> conversions) use this as a temp +location. Leave 8 words (ie, 64 bytes for a 64-bit arch) of slop. \begin{code} +spillSlotSize :: Int +spillSlotSize = IF_ARCH_alpha( 8, IF_ARCH_sparc( 8, IF_ARCH_i386( 12, IF_ARCH_powerpc( 8, )))) + maxSpillSlots :: Int -maxSpillSlots = (rESERVED_C_STACK_BYTES - 64) `div` 12 +maxSpillSlots = ((rESERVED_C_STACK_BYTES - 64) `div` spillSlotSize) - 1 -- convert a spill slot number to a *byte* offset, with no sign: -- decide on a per arch basis whether you are spilling above or below @@ -761,23 +893,23 @@ maxSpillSlots = (rESERVED_C_STACK_BYTES - 64) `div` 12 spillSlotToOffset :: Int -> Int spillSlotToOffset slot | slot >= 0 && slot < maxSpillSlots - = 64 + 12 * slot + = 64 + spillSlotSize * slot | otherwise = pprPanic "spillSlotToOffset:" (text "invalid spill location: " <> int slot) -vregToSpillSlot :: FiniteMap Unique Int -> Unique -> Int +vregToSpillSlot :: FiniteMap VRegUnique Int -> VRegUnique -> Int vregToSpillSlot vreg_to_slot_map u = case lookupFM vreg_to_slot_map u of Just xx -> xx - Nothing -> pprPanic "vregToSpillSlot: unmapped vreg" (ppr u) + Nothing -> pprPanic "vregToSpillSlot: unmapped vreg" (pprVRegUnique u) -spillReg, loadReg :: FiniteMap Unique Int -> Int -> Reg -> Reg -> Instr +spillReg, loadReg :: FiniteMap VRegUnique Int -> Int -> Reg -> Reg -> Instr spillReg vreg_to_slot_map delta dyn vreg | isVirtualReg vreg - = let slot_no = vregToSpillSlot vreg_to_slot_map (getUnique vreg) + = let slot_no = vregToSpillSlot vreg_to_slot_map (getVRegUnique vreg) off = spillSlotToOffset slot_no in {-Alpha: spill below the stack pointer (?)-} @@ -785,29 +917,51 @@ spillReg vreg_to_slot_map delta dyn vreg {-I386: spill above stack pointer leaving 3 words/spill-} ,IF_ARCH_i386 ( let off_w = (off-delta) `div` 4 - in - if regClass vreg == RcFloating - then GST F80 dyn (spRel off_w) - else MOV L (OpReg dyn) (OpAddr (spRel off_w)) + in case regClass vreg of { + RcInteger -> MOV L (OpReg dyn) (OpAddr (spRel off_w)); + _ -> GST F80 dyn (spRel off_w)} {- RcFloat/RcDouble -} {-SPARC: spill below frame pointer leaving 2 words/spill-} - ,IF_ARCH_sparc( ST (error "get sz from regClass vreg") - dyn (fpRel (- (off `div` 4))) - ,))) + ,IF_ARCH_sparc( + let{off_w = 1 + (off `div` 4); + sz = case regClass vreg of { + RcInteger -> W; + RcFloat -> F; + RcDouble -> DF}} + in ST sz dyn (fpRel (- off_w)) + ,IF_ARCH_powerpc( + let{sz = case regClass vreg of { + RcInteger -> W; + RcFloat -> F; + RcDouble -> DF}} + in ST sz dyn (AddrRegImm sp (ImmInt (off-delta))) + ,)))) loadReg vreg_to_slot_map delta vreg dyn | isVirtualReg vreg - = let slot_no = vregToSpillSlot vreg_to_slot_map (getUnique vreg) + = let slot_no = vregToSpillSlot vreg_to_slot_map (getVRegUnique vreg) off = spillSlotToOffset slot_no in IF_ARCH_alpha( LD sz dyn (spRel (- (off `div` 8))) + ,IF_ARCH_i386 ( let off_w = (off-delta) `div` 4 - in - if regClass vreg == RcFloating - then GLD F80 (spRel off_w) dyn - else MOV L (OpAddr (spRel off_w)) (OpReg dyn) - ,IF_ARCH_sparc( LD (error "get sz from regClass vreg") - (fpRel (- (off `div` 4))) dyn - ,))) + in case regClass vreg of { + RcInteger -> MOV L (OpAddr (spRel off_w)) (OpReg dyn); + _ -> GLD F80 (spRel off_w) dyn} {- RcFloat/RcDouble -} + + ,IF_ARCH_sparc( + let{off_w = 1 + (off `div` 4); + sz = case regClass vreg of { + RcInteger -> W; + RcFloat -> F; + RcDouble -> DF}} + in LD sz (fpRel (- off_w)) dyn + ,IF_ARCH_powerpc( + let{sz = case regClass vreg of { + RcInteger -> W; + RcFloat -> F; + RcDouble -> DF}} + in LD sz dyn (AddrRegImm sp (ImmInt (off-delta))) + ,)))) \end{code}