f0d382d0d68a5109909b6628a32da38b260bd98c
[ghc.git] / compiler / nativeGen / TargetReg.hs
1
2 {-# OPTIONS -fno-warn-tabs #-}
3 -- The above warning supression flag is a temporary kludge.
4 -- While working on this module you are encouraged to remove it and
5 -- detab the module (please do the detabbing in a separate patch). See
6 --     http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#TabsvsSpaces
7 -- for details
8
9 -- | Hard wired things related to registers.
10 --      This is module is preventing the native code generator being able to 
11 --      emit code for non-host architectures.
12 --
13 --      TODO: Do a better job of the overloading, and eliminate this module.
14 --      We'd probably do better with a Register type class, and hook this to 
15 --      Instruction somehow.
16 --
17 --      TODO: We should also make arch specific versions of RegAlloc.Graph.TrivColorable
18
19 module TargetReg (
20         targetVirtualRegSqueeze,
21         targetRealRegSqueeze,
22         targetClassOfRealReg,
23         targetMkVirtualReg,
24         targetWordSize,
25         targetRegDotColor,
26         targetClassOfReg
27 )
28
29 where
30
31 #include "HsVersions.h"
32
33 import Reg
34 import RegClass
35 import Size
36
37 import CmmType  (wordWidth)
38 import Outputable
39 import Unique
40 import FastTypes
41 import Platform
42
43 import qualified X86.Regs       as X86
44 import qualified X86.RegInfo    as X86
45
46 import qualified PPC.Regs       as PPC
47
48 import qualified SPARC.Regs     as SPARC
49
50 targetVirtualRegSqueeze :: Platform -> RegClass -> VirtualReg -> FastInt
51 targetVirtualRegSqueeze platform
52     = case platformArch platform of
53       ArchX86       -> X86.virtualRegSqueeze
54       ArchX86_64    -> X86.virtualRegSqueeze
55       ArchPPC       -> PPC.virtualRegSqueeze
56       ArchSPARC     -> SPARC.virtualRegSqueeze
57       ArchPPC_64    -> panic "targetVirtualRegSqueeze ArchPPC_64"
58       ArchARM _ _ _ -> panic "targetVirtualRegSqueeze ArchARM"
59       ArchUnknown   -> panic "targetVirtualRegSqueeze ArchUnknown"
60
61 targetRealRegSqueeze :: Platform -> RegClass -> RealReg -> FastInt
62 targetRealRegSqueeze platform
63     = case platformArch platform of
64       ArchX86       -> X86.realRegSqueeze
65       ArchX86_64    -> X86.realRegSqueeze
66       ArchPPC       -> PPC.realRegSqueeze
67       ArchSPARC     -> SPARC.realRegSqueeze
68       ArchPPC_64    -> panic "targetRealRegSqueeze ArchPPC_64"
69       ArchARM _ _ _ -> panic "targetRealRegSqueeze ArchARM"
70       ArchUnknown   -> panic "targetRealRegSqueeze ArchUnknown"
71
72 targetClassOfRealReg :: Platform -> RealReg -> RegClass
73 targetClassOfRealReg platform
74     = case platformArch platform of
75       ArchX86       -> X86.classOfRealReg platform
76       ArchX86_64    -> X86.classOfRealReg platform
77       ArchPPC       -> PPC.classOfRealReg
78       ArchSPARC     -> SPARC.classOfRealReg
79       ArchPPC_64    -> panic "targetClassOfRealReg ArchPPC_64"
80       ArchARM _ _ _ -> panic "targetClassOfRealReg ArchARM"
81       ArchUnknown   -> panic "targetClassOfRealReg ArchUnknown"
82
83 -- TODO: This should look at targetPlatform too
84 targetWordSize :: Size
85 targetWordSize = intSize wordWidth
86
87 targetMkVirtualReg :: Platform -> Unique -> Size -> VirtualReg
88 targetMkVirtualReg platform
89     = case platformArch platform of
90       ArchX86       -> X86.mkVirtualReg
91       ArchX86_64    -> X86.mkVirtualReg
92       ArchPPC       -> PPC.mkVirtualReg
93       ArchSPARC     -> SPARC.mkVirtualReg
94       ArchPPC_64    -> panic "targetMkVirtualReg ArchPPC_64"
95       ArchARM _ _ _ -> panic "targetMkVirtualReg ArchARM"
96       ArchUnknown   -> panic "targetMkVirtualReg ArchUnknown"
97
98 targetRegDotColor :: Platform -> RealReg -> SDoc
99 targetRegDotColor platform
100     = case platformArch platform of
101       ArchX86       -> X86.regDotColor platform
102       ArchX86_64    -> X86.regDotColor platform
103       ArchPPC       -> PPC.regDotColor
104       ArchSPARC     -> SPARC.regDotColor
105       ArchPPC_64    -> panic "targetRegDotColor ArchPPC_64"
106       ArchARM _ _ _ -> panic "targetRegDotColor ArchARM"
107       ArchUnknown   -> panic "targetRegDotColor ArchUnknown"
108
109
110 targetClassOfReg :: Platform -> Reg -> RegClass
111 targetClassOfReg platform reg
112  = case reg of
113    RegVirtual vr -> classOfVirtualReg vr
114    RegReal rr -> targetClassOfRealReg platform rr
115
116