15 #include "nativeGen/NCG.h"
16 #include "HsVersions.h"
30 #if i386_TARGET_ARCH || x86_64_TARGET_ARCH
35 mkVReg :: Unique -> Size -> Reg
37 | not (isFloatSize size) = VirtualRegI u
45 data JumpDest = DestBlockId BlockId | DestImm Imm
48 canShortcut :: Instr -> Maybe JumpDest
49 canShortcut (JXX ALWAYS id) = Just (DestBlockId id)
50 canShortcut (JMP (OpImm imm)) = Just (DestImm imm)
51 canShortcut _ = Nothing
54 -- The helper ensures that we don't follow cycles.
55 shortcutJump :: (BlockId -> Maybe JumpDest) -> Instr -> Instr
56 shortcutJump fn insn = shortcutJump' fn emptyBlockSet insn
57 where shortcutJump' fn seen insn@(JXX cc id) =
58 if elemBlockSet id seen then insn
61 Just (DestBlockId id') -> shortcutJump' fn seen' (JXX cc id')
62 Just (DestImm imm) -> shortcutJump' fn seen' (JXX_GBL cc imm)
63 where seen' = extendBlockSet seen id
64 shortcutJump' _ _ other = other
67 -- Here because it knows about JumpDest
68 shortcutStatic :: (BlockId -> Maybe JumpDest) -> CmmStatic -> CmmStatic
69 shortcutStatic fn (CmmStaticLit (CmmLabel lab))
70 | Just uq <- maybeAsmTemp lab
71 = CmmStaticLit (CmmLabel (shortBlockId fn (BlockId uq)))
72 shortcutStatic fn (CmmStaticLit (CmmLabelDiffOff lbl1 lbl2 off))
73 | Just uq <- maybeAsmTemp lbl1
74 = CmmStaticLit (CmmLabelDiffOff (shortBlockId fn (BlockId uq)) lbl2 off)
75 -- slightly dodgy, we're ignoring the second label, but this
76 -- works with the way we use CmmLabelDiffOff for jump tables now.
78 shortcutStatic _ other_static
82 :: (BlockId -> Maybe JumpDest)
86 shortBlockId fn blockid@(BlockId uq) =
88 Nothing -> mkAsmTempLabel uq
89 Just (DestBlockId blockid') -> shortBlockId fn blockid'
90 Just (DestImm (ImmCLbl lbl)) -> lbl
91 _other -> panic "shortBlockId"
97 regDotColor :: Reg -> SDoc
99 = let Just str = lookupUFM regColors reg
102 regColors :: UniqFM [Char]
115 , (fake5, "#5500ff") ]
118 -- reg colors for x86_64
119 #elif x86_64_TARGET_ARCH
120 regDotColor :: Reg -> SDoc
122 = let Just str = lookupUFM regColors reg
125 regColors :: UniqFM [Char]
128 $ [ (rax, "#00ff00"), (eax, "#00ff00")
129 , (rbx, "#0000ff"), (ebx, "#0000ff")
130 , (rcx, "#00ffff"), (ecx, "#00ffff")
131 , (rdx, "#0080ff"), (edx, "#00ffff")
141 ++ zip (map RealReg [16..31]) (repeat "red")
143 regDotColor :: Reg -> SDoc
144 regDotColor = panic "not defined"