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 shortcutJump :: (BlockId -> Maybe JumpDest) -> Instr -> Instr
  55 shortcutJump fn insn@(JXX cc id) =
  56   case fn id of
  57     Nothing                -> insn
  58     Just (DestBlockId id') -> shortcutJump fn (JXX cc id')
  59     Just (DestImm imm)     -> shortcutJump fn (JXX_GBL cc imm)
  60
  61 shortcutJump _ other = other
  62
  63
  64 -- Here because it knows about JumpDest
  65 shortcutStatic :: (BlockId -> Maybe JumpDest) -> CmmStatic -> CmmStatic
  66 shortcutStatic fn (CmmStaticLit (CmmLabel lab))
  67   | Just uq <- maybeAsmTemp lab
  68   = CmmStaticLit (CmmLabel (shortBlockId fn (BlockId uq)))
  69 shortcutStatic fn (CmmStaticLit (CmmLabelDiffOff lbl1 lbl2 off))
  70   | Just uq <- maybeAsmTemp lbl1
  71   = CmmStaticLit (CmmLabelDiffOff (shortBlockId fn (BlockId uq)) lbl2 off)
  72         -- slightly dodgy, we're ignoring the second label, but this
  73         -- works with the way we use CmmLabelDiffOff for jump tables now.
  74
  75 shortcutStatic _ other_static
  76         = other_static
  77
  78 shortBlockId
  79         :: (BlockId -> Maybe JumpDest)
  80         -> BlockId
  81         -> CLabel
  82
  83 shortBlockId fn blockid@(BlockId uq) =
  84    case fn blockid of
  85       Nothing -> mkAsmTempLabel uq
  86       Just (DestBlockId blockid')  -> shortBlockId fn blockid'
  87       Just (DestImm (ImmCLbl lbl)) -> lbl
  88       _other -> panic "shortBlockId"
  89
  90
  91
  92 -- reg colors for x86
  93 #if i386_TARGET_ARCH
  94 regDotColor :: Reg -> SDoc
  95 regDotColor reg
  96  = let  Just    str     = lookupUFM regColors reg
  97    in   text str
  98
  99 regColors :: UniqFM [Char]
 100 regColors
 101  = listToUFM
 102  $      [ (eax, "#00ff00")
 103         , (ebx, "#0000ff")
 104         , (ecx, "#00ffff")
 105         , (edx, "#0080ff")
 106
 107         , (fake0, "#ff00ff")
 108         , (fake1, "#ff00aa")
 109         , (fake2, "#aa00ff")
 110         , (fake3, "#aa00aa")
 111         , (fake4, "#ff0055")
 112         , (fake5, "#5500ff") ]
 113
 114
 115 -- reg colors for x86_64
 116 #elif x86_64_TARGET_ARCH
 117 regDotColor :: Reg -> SDoc
 118 regDotColor reg
 119  = let  Just    str     = lookupUFM regColors reg
 120    in   text str
 121
 122 regColors :: UniqFM [Char]
 123 regColors
 124  = listToUFM
 125  $      [ (rax, "#00ff00"), (eax, "#00ff00")
 126         , (rbx, "#0000ff"), (ebx, "#0000ff")
 127         , (rcx, "#00ffff"), (ecx, "#00ffff")
 128         , (rdx, "#0080ff"), (edx, "#00ffff")
 129         , (r8,  "#00ff80")
 130         , (r9,  "#008080")
 131         , (r10, "#0040ff")
 132         , (r11, "#00ff40")
 133         , (r12, "#008040")
 134         , (r13, "#004080")
 135         , (r14, "#004040")
 136         , (r15, "#002080") ]
 137
 138         ++ zip (map RealReg [16..31]) (repeat "red")
 139 #else
 140 regDotColor :: Reg -> SDoc
 141 regDotColor     = panic "not defined"
 142 #endif