Fix Hadrian build with Stack (#17189)
[ghc.git] / compiler / nativeGen / TargetReg.hs
1 {-# LANGUAGE CPP #-}
2 -- | Hard wired things related to registers.
3 -- This is module is preventing the native code generator being able to
4 -- emit code for non-host architectures.
5 --
6 -- TODO: Do a better job of the overloading, and eliminate this module.
7 -- We'd probably do better with a Register type class, and hook this to
8 -- Instruction somehow.
9 --
10 -- TODO: We should also make arch specific versions of RegAlloc.Graph.TrivColorable
11 module TargetReg (
12 targetVirtualRegSqueeze,
13 targetRealRegSqueeze,
14 targetClassOfRealReg,
15 targetMkVirtualReg,
16 targetRegDotColor,
17 targetClassOfReg
18 )
19
20 where
21
22 #include "HsVersions.h"
23
24 import GhcPrelude
25
26 import Reg
27 import RegClass
28 import Format
29
30 import Outputable
31 import Unique
32 import GHC.Platform
33
34 import qualified X86.Regs as X86
35 import qualified X86.RegInfo as X86
36
37 import qualified PPC.Regs as PPC
38
39 import qualified SPARC.Regs as SPARC
40
41 targetVirtualRegSqueeze :: Platform -> RegClass -> VirtualReg -> Int
42 targetVirtualRegSqueeze platform
43 = case platformArch platform of
44 ArchX86 -> X86.virtualRegSqueeze
45 ArchX86_64 -> X86.virtualRegSqueeze
46 ArchPPC -> PPC.virtualRegSqueeze
47 ArchSPARC -> SPARC.virtualRegSqueeze
48 ArchSPARC64 -> panic "targetVirtualRegSqueeze ArchSPARC64"
49 ArchPPC_64 _ -> PPC.virtualRegSqueeze
50 ArchARM _ _ _ -> panic "targetVirtualRegSqueeze ArchARM"
51 ArchARM64 -> panic "targetVirtualRegSqueeze ArchARM64"
52 ArchAlpha -> panic "targetVirtualRegSqueeze ArchAlpha"
53 ArchMipseb -> panic "targetVirtualRegSqueeze ArchMipseb"
54 ArchMipsel -> panic "targetVirtualRegSqueeze ArchMipsel"
55 ArchJavaScript-> panic "targetVirtualRegSqueeze ArchJavaScript"
56 ArchUnknown -> panic "targetVirtualRegSqueeze ArchUnknown"
57
58
59 targetRealRegSqueeze :: Platform -> RegClass -> RealReg -> Int
60 targetRealRegSqueeze platform
61 = case platformArch platform of
62 ArchX86 -> X86.realRegSqueeze
63 ArchX86_64 -> X86.realRegSqueeze
64 ArchPPC -> PPC.realRegSqueeze
65 ArchSPARC -> SPARC.realRegSqueeze
66 ArchSPARC64 -> panic "targetRealRegSqueeze ArchSPARC64"
67 ArchPPC_64 _ -> PPC.realRegSqueeze
68 ArchARM _ _ _ -> panic "targetRealRegSqueeze ArchARM"
69 ArchARM64 -> panic "targetRealRegSqueeze ArchARM64"
70 ArchAlpha -> panic "targetRealRegSqueeze ArchAlpha"
71 ArchMipseb -> panic "targetRealRegSqueeze ArchMipseb"
72 ArchMipsel -> panic "targetRealRegSqueeze ArchMipsel"
73 ArchJavaScript-> panic "targetRealRegSqueeze ArchJavaScript"
74 ArchUnknown -> panic "targetRealRegSqueeze ArchUnknown"
75
76 targetClassOfRealReg :: Platform -> RealReg -> RegClass
77 targetClassOfRealReg platform
78 = case platformArch platform of
79 ArchX86 -> X86.classOfRealReg platform
80 ArchX86_64 -> X86.classOfRealReg platform
81 ArchPPC -> PPC.classOfRealReg
82 ArchSPARC -> SPARC.classOfRealReg
83 ArchSPARC64 -> panic "targetClassOfRealReg ArchSPARC64"
84 ArchPPC_64 _ -> PPC.classOfRealReg
85 ArchARM _ _ _ -> panic "targetClassOfRealReg ArchARM"
86 ArchARM64 -> panic "targetClassOfRealReg ArchARM64"
87 ArchAlpha -> panic "targetClassOfRealReg ArchAlpha"
88 ArchMipseb -> panic "targetClassOfRealReg ArchMipseb"
89 ArchMipsel -> panic "targetClassOfRealReg ArchMipsel"
90 ArchJavaScript-> panic "targetClassOfRealReg ArchJavaScript"
91 ArchUnknown -> panic "targetClassOfRealReg ArchUnknown"
92
93 targetMkVirtualReg :: Platform -> Unique -> Format -> VirtualReg
94 targetMkVirtualReg platform
95 = case platformArch platform of
96 ArchX86 -> X86.mkVirtualReg
97 ArchX86_64 -> X86.mkVirtualReg
98 ArchPPC -> PPC.mkVirtualReg
99 ArchSPARC -> SPARC.mkVirtualReg
100 ArchSPARC64 -> panic "targetMkVirtualReg ArchSPARC64"
101 ArchPPC_64 _ -> PPC.mkVirtualReg
102 ArchARM _ _ _ -> panic "targetMkVirtualReg ArchARM"
103 ArchARM64 -> panic "targetMkVirtualReg ArchARM64"
104 ArchAlpha -> panic "targetMkVirtualReg ArchAlpha"
105 ArchMipseb -> panic "targetMkVirtualReg ArchMipseb"
106 ArchMipsel -> panic "targetMkVirtualReg ArchMipsel"
107 ArchJavaScript-> panic "targetMkVirtualReg ArchJavaScript"
108 ArchUnknown -> panic "targetMkVirtualReg ArchUnknown"
109
110 targetRegDotColor :: Platform -> RealReg -> SDoc
111 targetRegDotColor platform
112 = case platformArch platform of
113 ArchX86 -> X86.regDotColor platform
114 ArchX86_64 -> X86.regDotColor platform
115 ArchPPC -> PPC.regDotColor
116 ArchSPARC -> SPARC.regDotColor
117 ArchSPARC64 -> panic "targetRegDotColor ArchSPARC64"
118 ArchPPC_64 _ -> PPC.regDotColor
119 ArchARM _ _ _ -> panic "targetRegDotColor ArchARM"
120 ArchARM64 -> panic "targetRegDotColor ArchARM64"
121 ArchAlpha -> panic "targetRegDotColor ArchAlpha"
122 ArchMipseb -> panic "targetRegDotColor ArchMipseb"
123 ArchMipsel -> panic "targetRegDotColor ArchMipsel"
124 ArchJavaScript-> panic "targetRegDotColor ArchJavaScript"
125 ArchUnknown -> panic "targetRegDotColor ArchUnknown"
126
127
128 targetClassOfReg :: Platform -> Reg -> RegClass
129 targetClassOfReg platform reg
130 = case reg of
131 RegVirtual vr -> classOfVirtualReg vr
132 RegReal rr -> targetClassOfRealReg platform rr