X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2FnativeGen%2FRegAllocInfo.lhs;h=7fd7e91fe1cd3f81ca194f14c89b70bfcf5f68ae;hb=c36b02d9d26fe4050397bdfba60a6f92c7314e8d;hp=a401f852feb9b2d6d6bada5b9c6ee23ef5e69182;hpb=6254fd4ab7c5798599e58b48896c9e284222f26f;p=ghc-hetmet.git diff --git a/ghc/compiler/nativeGen/RegAllocInfo.lhs b/ghc/compiler/nativeGen/RegAllocInfo.lhs index a401f85..7fd7e91 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} %************************************************************************ @@ -151,15 +148,15 @@ regUsage :: Instr -> RegUsage interesting (VirtualRegI _) = True interesting (VirtualRegF _) = True interesting (VirtualRegD _) = True -interesting (RealReg (I# i)) = _IS_TRUE_(freeReg i) +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]) @@ -239,7 +236,8 @@ 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] + IQUOT sz src dst -> usageRM src dst + IREM 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 @@ -256,7 +254,7 @@ 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) [] + JMP dsts op -> mkRU (use_R op) [] CALL imm -> mkRU [] callClobberedRegs CLTD -> mkRU [eax] [edx] NOP -> mkRU [] [] @@ -333,14 +331,6 @@ 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 @@ -372,7 +362,7 @@ 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 -> usage (regAddr addr, []) + JMP dst addr -> usage (regAddr addr, []) CALL _ n True -> noUsage CALL _ n False -> usage (argRegs n, callClobberedRegs) @@ -441,10 +431,9 @@ findReservedRegs instrs #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 @@ -456,7 +445,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], @@ -486,6 +475,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" @@ -518,11 +508,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 @@ -539,9 +535,12 @@ insnFuture insn BF other _ (ImmCLbl clbl) -> NextOrBranch clbl BF other _ _ -> panic "nativeGen(sparc):insnFuture(BF)" - -- JMP and CALL(terminal) must be out-of-line. - JMP _ -> NoFuture - CALL _ _ True -> NoFuture + -- 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 @@ -628,7 +627,8 @@ 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 + IQUOT sz src dst -> patch2 (IQUOT sz) src dst + IREM sz src dst -> patch2 (IREM 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 @@ -643,7 +643,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) @@ -708,31 +708,31 @@ 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) + 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) _ -> instr where fixAddr (AddrRegReg r1 r2) = AddrRegReg (env r1) (env r2) @@ -794,10 +794,9 @@ 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( @@ -818,10 +817,9 @@ loadReg vreg_to_slot_map delta vreg dyn 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) + 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)