never executed always true always false
1 {-# OPTIONS_GHC -fno-warn-orphans #-}
2 module GHC.CmmToAsm.AArch64.Regs where
3
4 import GHC.Prelude
5
6 import GHC.Platform.Reg
7 import GHC.Platform.Reg.Class
8 import GHC.CmmToAsm.Format
9
10 import GHC.Cmm
11 import GHC.Cmm.CLabel ( CLabel )
12 import GHC.Types.Unique
13
14 import GHC.Platform.Regs
15 import GHC.Utils.Outputable
16 import GHC.Utils.Panic
17 import GHC.Platform
18
19 allMachRegNos :: [RegNo]
20 allMachRegNos = [0..31] ++ [32..63]
21 -- allocatableRegs is allMachRegNos with the fixed-use regs removed.
22 -- i.e., these are the regs for which we are prepared to allow the
23 -- register allocator to attempt to map VRegs to.
24 allocatableRegs :: Platform -> [RealReg]
25 allocatableRegs platform
26 = let isFree i = freeReg platform i
27 in map RealRegSingle $ filter isFree allMachRegNos
28
29
30 -- argRegs is the set of regs which are read for an n-argument call to C.
31 allGpArgRegs :: [Reg]
32 allGpArgRegs = map regSingle [0..7]
33 allFpArgRegs :: [Reg]
34 allFpArgRegs = map regSingle [32..39]
35
36 -- STG:
37 -- 19: Base
38 -- 20: Sp
39 -- 21: Hp
40 -- 22-27: R1-R6
41 -- 28: SpLim
42
43 -- This is the STG Sp reg.
44 -- sp :: Reg
45 -- sp = regSingle 20
46
47 -- addressing modes ------------------------------------------------------------
48
49 data AddrMode
50 = AddrRegReg Reg Reg
51 | AddrRegImm Reg Imm
52 | AddrReg Reg
53 deriving (Eq, Show)
54
55 -- -----------------------------------------------------------------------------
56 -- Immediates
57
58 data Imm
59 = ImmInt Int
60 | ImmInteger Integer -- Sigh.
61 | ImmCLbl CLabel -- AbstractC Label (with baggage)
62 | ImmLit SDoc -- Simple string
63 | ImmIndex CLabel Int
64 | ImmFloat Rational
65 | ImmDouble Rational
66 | ImmConstantSum Imm Imm
67 | ImmConstantDiff Imm Imm
68 deriving (Eq, Show)
69
70 instance Show SDoc where
71 show = showPprUnsafe . ppr
72
73 instance Eq SDoc where
74 lhs == rhs = show lhs == show rhs
75
76 strImmLit :: String -> Imm
77 strImmLit s = ImmLit (text s)
78
79
80 litToImm :: CmmLit -> Imm
81 litToImm (CmmInt i w) = ImmInteger (narrowS w i)
82 -- narrow to the width: a CmmInt might be out of
83 -- range, but we assume that ImmInteger only contains
84 -- in-range values. A signed value should be fine here.
85 litToImm (CmmFloat f W32) = ImmFloat f
86 litToImm (CmmFloat f W64) = ImmDouble f
87 litToImm (CmmLabel l) = ImmCLbl l
88 litToImm (CmmLabelOff l off) = ImmIndex l off
89 litToImm (CmmLabelDiffOff l1 l2 off _)
90 = ImmConstantSum
91 (ImmConstantDiff (ImmCLbl l1) (ImmCLbl l2))
92 (ImmInt off)
93 litToImm _ = panic "AArch64.Regs.litToImm: no match"
94
95
96 -- == To satisfy GHC.CmmToAsm.Reg.Target =======================================
97
98 -- squeese functions for the graph allocator -----------------------------------
99 -- | regSqueeze_class reg
100 -- Calculate the maximum number of register colors that could be
101 -- denied to a node of this class due to having this reg
102 -- as a neighbour.
103 --
104 {-# INLINE virtualRegSqueeze #-}
105 virtualRegSqueeze :: RegClass -> VirtualReg -> Int
106 virtualRegSqueeze cls vr
107 = case cls of
108 RcInteger
109 -> case vr of
110 VirtualRegI{} -> 1
111 VirtualRegHi{} -> 1
112 _other -> 0
113
114 RcDouble
115 -> case vr of
116 VirtualRegD{} -> 1
117 VirtualRegF{} -> 0
118 _other -> 0
119
120 _other -> 0
121
122 {-# INLINE realRegSqueeze #-}
123 realRegSqueeze :: RegClass -> RealReg -> Int
124 realRegSqueeze cls rr
125 = case cls of
126 RcInteger
127 -> case rr of
128 RealRegSingle regNo
129 | regNo < 32 -> 1 -- first fp reg is 32
130 | otherwise -> 0
131
132 RealRegPair{} -> 0
133
134 RcDouble
135 -> case rr of
136 RealRegSingle regNo
137 | regNo < 32 -> 0
138 | otherwise -> 1
139
140 RealRegPair{} -> 0
141
142 _other -> 0
143
144 mkVirtualReg :: Unique -> Format -> VirtualReg
145 mkVirtualReg u format
146 | not (isFloatFormat format) = VirtualRegI u
147 | otherwise
148 = case format of
149 FF32 -> VirtualRegD u
150 FF64 -> VirtualRegD u
151 _ -> panic "AArch64.mkVirtualReg"
152
153 {-# INLINE classOfRealReg #-}
154 classOfRealReg :: RealReg -> RegClass
155 classOfRealReg (RealRegSingle i)
156 | i < 32 = RcInteger
157 | otherwise = RcDouble
158
159 classOfRealReg (RealRegPair{})
160 = panic "regClass(ppr): no reg pairs on this architecture"
161
162 regDotColor :: RealReg -> SDoc
163 regDotColor reg
164 = case classOfRealReg reg of
165 RcInteger -> text "blue"
166 RcFloat -> text "red"
167 RcDouble -> text "green"