compiler/nativeGen/X86/RegInfo.hs

   1
   2 module X86.RegInfo (
   3         mkVReg,
   4
   5         JumpDest,
   6         canShortcut,
   7         shortcutJump,
   8
   9         shortcutStatic,
  10         regDotColor
  11 )
  12
  13 where
  14
  15 #include "nativeGen/NCG.h"
  16 #include "HsVersions.h"
  17
  18 import X86.Instr
  19 import X86.Cond
  20 import X86.Regs
  21 import Size
  22 import Reg
  23
  24 import Cmm
  25 import CLabel
  26 import BlockId
  27 import Outputable
  28 import Unique
  29
  30 #if i386_TARGET_ARCH || x86_64_TARGET_ARCH
  31 import UniqFM
  32 #endif
  33
  34
  35 mkVReg :: Unique -> Size -> Reg
  36 mkVReg u size
  37    | not (isFloatSize size) = VirtualRegI u
  38    | otherwise
  39    = case size of
  40         FF32    -> VirtualRegD u
  41         FF64    -> VirtualRegD u
  42         _       -> panic "mkVReg"
  43
  44
  45 data JumpDest = DestBlockId BlockId | DestImm Imm
  46
  47
  48 canShortcut :: Instr -> Maybe JumpDest
  49 canShortcut (JXX ALWAYS id)     = Just (DestBlockId id)
  50 canShortcut (JMP (OpImm imm))   = Just (DestImm imm)
  51 canShortcut _                   = Nothing
  52
  53
  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
  59           else case fn id of
  60                  Nothing                -> 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
  65
  66
  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.
  77
  78 shortcutStatic _ other_static
  79         = other_static
  80
  81 shortBlockId
  82         :: (BlockId -> Maybe JumpDest)
  83         -> BlockId
  84         -> CLabel
  85
  86 shortBlockId fn blockid@(BlockId uq) =
  87    case fn blockid of
  88       Nothing -> mkAsmTempLabel uq
  89       Just (DestBlockId blockid')  -> shortBlockId fn blockid'
  90       Just (DestImm (ImmCLbl lbl)) -> lbl
  91       _other -> panic "shortBlockId"
  92
  93
  94
  95 -- reg colors for x86
  96 #if i386_TARGET_ARCH
  97 regDotColor :: Reg -> SDoc
  98 regDotColor reg
  99  = let  Just    str     = lookupUFM regColors reg
 100    in   text str
 101
 102 regColors :: UniqFM [Char]
 103 regColors
 104  = listToUFM
 105  $      [ (eax, "#00ff00")
 106         , (ebx, "#0000ff")
 107         , (ecx, "#00ffff")
 108         , (edx, "#0080ff")
 109
 110         , (fake0, "#ff00ff")
 111         , (fake1, "#ff00aa")
 112         , (fake2, "#aa00ff")
 113         , (fake3, "#aa00aa")
 114         , (fake4, "#ff0055")
 115         , (fake5, "#5500ff") ]
 116
 117
 118 -- reg colors for x86_64
 119 #elif x86_64_TARGET_ARCH
 120 regDotColor :: Reg -> SDoc
 121 regDotColor reg
 122  = let  Just    str     = lookupUFM regColors reg
 123    in   text str
 124
 125 regColors :: UniqFM [Char]
 126 regColors
 127  = listToUFM
 128  $      [ (rax, "#00ff00"), (eax, "#00ff00")
 129         , (rbx, "#0000ff"), (ebx, "#0000ff")
 130         , (rcx, "#00ffff"), (ecx, "#00ffff")
 131         , (rdx, "#0080ff"), (edx, "#00ffff")
 132         , (r8,  "#00ff80")
 133         , (r9,  "#008080")
 134         , (r10, "#0040ff")
 135         , (r11, "#00ff40")
 136         , (r12, "#008040")
 137         , (r13, "#004080")
 138         , (r14, "#004040")
 139         , (r15, "#002080") ]
 140
 141         ++ zip (map RealReg [16..31]) (repeat "red")
 142 #else
 143 regDotColor :: Reg -> SDoc
 144 regDotColor     = panic "not defined"
 145 #endif