X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=compiler%2FnativeGen%2FRegAllocInfo.hs;h=376ea489b5b2374b4504b56aa121aea61a009a2d;hp=df7421877a8ad458c339273d727d1360665b2076;hb=7fc749a43b4b6b85d234fa95d4928648259584f4;hpb=561e57422c9189457e2c837a6329861dbc4231a5 diff --git a/compiler/nativeGen/RegAllocInfo.hs b/compiler/nativeGen/RegAllocInfo.hs index df74218..376ea48 100644 --- a/compiler/nativeGen/RegAllocInfo.hs +++ b/compiler/nativeGen/RegAllocInfo.hs @@ -6,6 +6,13 @@ -- ----------------------------------------------------------------------------- +{-# OPTIONS -w #-} +-- The above warning supression flag is a temporary kludge. +-- While working on this module you are encouraged to remove it and fix +-- any warnings in the module. See +-- http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#Warnings +-- for details + #include "nativeGen/NCG.h" module RegAllocInfo ( @@ -17,6 +24,8 @@ module RegAllocInfo ( patchJump, isRegRegMove, + JumpDest, canShortcut, shortcutJump, shortcutStatic, + maxSpillSlots, mkSpillInstr, mkLoadInstr, @@ -26,7 +35,8 @@ module RegAllocInfo ( #include "HsVersions.h" -import Cmm ( BlockId ) +import Cmm +import CLabel import MachOp ( MachRep(..), wordRep ) import MachInstrs import MachRegs @@ -66,6 +76,8 @@ interesting (RealReg i) = isFastTrue (freeReg i) #if alpha_TARGET_ARCH regUsage instr = case instr of + SPILL reg slot -> usage ([reg], []) + RELOAD slot reg -> usage ([], [reg]) LD B 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 @@ -156,6 +168,8 @@ regUsage instr = case instr of IDIV sz op -> mkRU (eax:edx:use_R op) [eax,edx] AND sz src dst -> usageRM src dst OR sz src dst -> usageRM src dst + XOR sz (OpReg src) (OpReg dst) + | src == dst -> mkRU [] [dst] XOR sz src dst -> usageRM src dst NOT sz op -> usageM op NEGI sz op -> usageM op @@ -170,6 +184,7 @@ regUsage instr = case instr of CMP sz src dst -> mkRUR (use_R src ++ use_R dst) SETCC cond op -> mkRU [] (def_W op) JXX cond lbl -> mkRU [] [] + JXX_GBL cond lbl -> mkRU [] [] JMP op -> mkRUR (use_R op) JMP_TBL op ids -> mkRUR (use_R op) CALL (Left imm) params -> mkRU params callClobberedRegs @@ -208,8 +223,8 @@ regUsage instr = case instr of #if x86_64_TARGET_ARCH CVTSS2SD src dst -> mkRU [src] [dst] CVTSD2SS src dst -> mkRU [src] [dst] - CVTSS2SI src dst -> mkRU (use_R src) [dst] - CVTSD2SI src dst -> mkRU (use_R src) [dst] + CVTTSS2SIQ src dst -> mkRU (use_R src) [dst] + CVTTSD2SIQ src dst -> mkRU (use_R src) [dst] CVTSI2SS src dst -> mkRU (use_R src) [dst] CVTSI2SD src dst -> mkRU (use_R src) [dst] FDIV sz src dst -> usageRM src dst @@ -220,6 +235,8 @@ regUsage instr = case instr of COMMENT _ -> noUsage DELTA _ -> noUsage + SPILL reg slot -> mkRU [reg] [] + RELOAD slot reg -> mkRU [] [reg] _other -> panic "regUsage: unrecognised instr" @@ -269,6 +286,9 @@ regUsage instr = case instr of #if sparc_TARGET_ARCH regUsage instr = case instr of + SPILL reg slot -> usage ([reg], []) + RELOAD slot reg -> usage ([], [reg]) + 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]) @@ -321,6 +341,9 @@ regUsage instr = case instr of #if powerpc_TARGET_ARCH regUsage instr = case instr of + SPILL reg slot -> usage ([reg], []) + RELOAD slot reg -> usage ([], [reg]) + LD sz reg addr -> usage (regAddr addr, [reg]) LA sz reg addr -> usage (regAddr addr, [reg]) ST sz reg addr -> usage (reg : regAddr addr, []) @@ -331,6 +354,7 @@ regUsage instr = case instr of CMP sz reg ri -> usage (reg : regRI ri,[]) CMPL sz reg ri -> usage (reg : regRI ri,[]) BCC cond lbl -> noUsage + BCCFAR cond lbl -> noUsage MTCTR reg -> usage ([reg],[]) BCTR targets -> noUsage BL imm params -> usage (params, callClobberedRegs) @@ -395,6 +419,7 @@ jumpDests insn acc JMP_TBL _ ids -> ids ++ acc #elif powerpc_TARGET_ARCH BCC _ id -> id : acc + BCCFAR _ id -> id : acc BCTR targets -> targets ++ acc #endif _other -> acc @@ -408,10 +433,50 @@ patchJump insn old new JMP_TBL op ids -> error "Cannot patch JMP_TBL" #elif powerpc_TARGET_ARCH BCC cc id | id == old -> BCC cc new + BCCFAR cc id | id == old -> BCCFAR cc new BCTR targets -> error "Cannot patch BCTR" #endif _other -> insn +data JumpDest = DestBlockId BlockId | DestImm Imm + +canShortcut :: Instr -> Maybe JumpDest +#if i386_TARGET_ARCH || x86_64_TARGET_ARCH +canShortcut (JXX ALWAYS id) = Just (DestBlockId id) +canShortcut (JMP (OpImm imm)) = Just (DestImm imm) +#endif +canShortcut _ = Nothing + +shortcutJump :: (BlockId -> Maybe JumpDest) -> Instr -> Instr +#if i386_TARGET_ARCH || x86_64_TARGET_ARCH +shortcutJump fn insn@(JXX cc id) = + case fn id of + Nothing -> insn + Just (DestBlockId id') -> shortcutJump fn (JXX cc id') + Just (DestImm imm) -> shortcutJump fn (JXX_GBL cc imm) +#endif +shortcutJump fn other = other + +-- Here because it knows about JumpDest +shortcutStatic :: (BlockId -> Maybe JumpDest) -> CmmStatic -> CmmStatic +shortcutStatic fn (CmmStaticLit (CmmLabel lab)) + | Just uq <- maybeAsmTemp lab + = CmmStaticLit (CmmLabel (shortBlockId fn (BlockId uq))) +shortcutStatic fn (CmmStaticLit (CmmLabelDiffOff lbl1 lbl2 off)) + | Just uq <- maybeAsmTemp lbl1 + = CmmStaticLit (CmmLabelDiffOff (shortBlockId fn (BlockId uq)) lbl2 off) + -- slightly dodgy, we're ignoring the second label, but this + -- works with the way we use CmmLabelDiffOff for jump tables now. +shortcutStatic fn other_static + = other_static + +shortBlockId fn blockid@(BlockId uq) = + case fn blockid of + Nothing -> mkAsmTempLabel uq + Just (DestBlockId blockid') -> shortBlockId fn blockid' + Just (DestImm (ImmCLbl lbl)) -> lbl + _other -> panic "shortBlockId" + -- ----------------------------------------------------------------------------- -- 'patchRegs' function @@ -423,6 +488,8 @@ patchRegs :: Instr -> (Reg -> Reg) -> Instr #if alpha_TARGET_ARCH patchRegs instr env = case instr of + SPILL reg slot -> SPILL (env reg) slot + RELOAD slot reg -> RELOAD slot (env reg) LD sz reg addr -> LD sz (env reg) (fixAddr addr) LDA reg addr -> LDA (env reg) (fixAddr addr) LDAH reg addr -> LDAH (env reg) (fixAddr addr) @@ -540,8 +607,8 @@ patchRegs instr env = case instr of #if x86_64_TARGET_ARCH CVTSS2SD src dst -> CVTSS2SD (env src) (env dst) CVTSD2SS src dst -> CVTSD2SS (env src) (env dst) - CVTSS2SI src dst -> CVTSS2SI (patchOp src) (env dst) - CVTSD2SI src dst -> CVTSD2SI (patchOp src) (env dst) + CVTTSS2SIQ src dst -> CVTTSS2SIQ (patchOp src) (env dst) + CVTTSD2SIQ src dst -> CVTTSD2SIQ (patchOp src) (env dst) CVTSI2SS src dst -> CVTSI2SS (patchOp src) (env dst) CVTSI2SD src dst -> CVTSI2SD (patchOp src) (env dst) FDIV sz src dst -> FDIV sz (patchOp src) (patchOp dst) @@ -556,7 +623,11 @@ patchRegs instr env = case instr of NOP -> instr COMMENT _ -> instr DELTA _ -> instr + SPILL reg slot -> SPILL (env reg) slot + RELOAD slot reg -> RELOAD slot (env reg) + JXX _ _ -> instr + JXX_GBL _ _ -> instr CLTD _ -> instr _other -> panic "patchRegs: unrecognised instr" @@ -585,6 +656,8 @@ patchRegs instr env = case instr of #if sparc_TARGET_ARCH patchRegs instr env = case instr of + SPILL reg slot -> SPILL (env reg) slot + RELOAD slot reg -> RELOAD slot (env reg) 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) @@ -628,6 +701,9 @@ patchRegs instr env = case instr of #if powerpc_TARGET_ARCH patchRegs instr env = case instr of + SPILL reg slot -> SPILL (env reg) slot + RELOAD slot reg -> RELOAD slot (env reg) + LD sz reg addr -> LD sz (env reg) (fixAddr addr) LA sz reg addr -> LA sz (env reg) (fixAddr addr) ST sz reg addr -> ST sz (env reg) (fixAddr addr) @@ -638,6 +714,7 @@ patchRegs instr env = case instr of 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 + BCCFAR cond lbl -> BCCFAR cond lbl MTCTR reg -> MTCTR (env reg) BCTR targets -> BCTR targets BL imm argRegs -> BL imm argRegs -- argument regs @@ -705,14 +782,12 @@ isRegRegMove _ = Nothing -- Generating spill instructions mkSpillInstr - :: Reg -- register to spill (should be a real) + :: Reg -- register to spill -> Int -- current stack delta -> Int -- spill slot to use -> Instr mkSpillInstr reg delta slot - = ASSERT(isRealReg reg) - let - off = spillSlotToOffset slot + = let off = spillSlotToOffset slot in #ifdef alpha_TARGET_ARCH {-Alpha: spill below the stack pointer (?)-} @@ -750,14 +825,12 @@ mkSpillInstr reg delta slot mkLoadInstr - :: Reg -- register to load (should be a real) + :: Reg -- register to load -> Int -- current stack delta -> Int -- spill slot to use -> Instr mkLoadInstr reg delta slot - = ASSERT(isRealReg reg) - let - off = spillSlotToOffset slot + = let off = spillSlotToOffset slot in #if alpha_TARGET_ARCH LD sz dyn (spRel (- (off `div` 8))) @@ -841,4 +914,5 @@ spillSlotToOffset slot = 64 + spillSlotSize * slot | otherwise = pprPanic "spillSlotToOffset:" - (text "invalid spill location: " <> int slot) + ( text "invalid spill location: " <> int slot + $$ text "maxSpillSlots: " <> int maxSpillSlots)