8f41e8e052568ef0251f1054d884bdbba0bbd8b9
[ghc.git] / compiler / nativeGen / X86 / RegInfo.hs
1
2 module X86.RegInfo (
3 mkVirtualReg,
4 regDotColor
5 )
6
7 where
8
9 #include "nativeGen/NCG.h"
10 #include "HsVersions.h"
11
12 import Size
13 import Reg
14
15 import Outputable
16 import Platform
17 import Unique
18
19 import UniqFM
20 import X86.Regs
21
22
23 mkVirtualReg :: Unique -> Size -> VirtualReg
24 mkVirtualReg u size
25 = case size of
26 FF32 -> VirtualRegSSE u
27 FF64 -> VirtualRegSSE u
28 FF80 -> VirtualRegD u
29 _other -> VirtualRegI u
30
31 regDotColor :: Platform -> RealReg -> SDoc
32 regDotColor platform reg
33 = let Just str = lookupUFM (regColors platform) reg
34 in text str
35
36 regColors :: Platform -> UniqFM [Char]
37 regColors platform = listToUFM (normalRegColors platform ++ fpRegColors)
38
39 normalRegColors :: Platform -> [(Reg,String)]
40 normalRegColors platform
41 = case platformArch platform of
42 ArchX86 -> [ (eax, "#00ff00")
43 , (ebx, "#0000ff")
44 , (ecx, "#00ffff")
45 , (edx, "#0080ff") ]
46 ArchX86_64 -> [ (rax, "#00ff00"), (eax, "#00ff00")
47 , (rbx, "#0000ff"), (ebx, "#0000ff")
48 , (rcx, "#00ffff"), (ecx, "#00ffff")
49 , (rdx, "#0080ff"), (edx, "#00ffff")
50 , (r8, "#00ff80")
51 , (r9, "#008080")
52 , (r10, "#0040ff")
53 , (r11, "#00ff40")
54 , (r12, "#008040")
55 , (r13, "#004080")
56 , (r14, "#004040")
57 , (r15, "#002080") ]
58 ArchPPC -> panic "X86 normalRegColors ArchPPC"
59 ArchPPC_64 -> panic "X86 normalRegColors ArchPPC_64"
60 ArchSPARC -> panic "X86 normalRegColors ArchSPARC"
61 ArchARM _ _ -> panic "X86 normalRegColors ArchARM"
62
63 fpRegColors :: [(Reg,String)]
64 fpRegColors =
65 [ (fake0, "#ff00ff")
66 , (fake1, "#ff00aa")
67 , (fake2, "#aa00ff")
68 , (fake3, "#aa00aa")
69 , (fake4, "#ff0055")
70 , (fake5, "#5500ff") ]
71
72 ++ zip (map regSingle [24..39]) (repeat "red")
73