1 -----------------------------------------------------------------------------
3 -- Machine-specific parts of the register allocator
5 -- (c) The University of Glasgow 1996-2004
7 -----------------------------------------------------------------------------
35 #include "nativeGen/NCG.h"
36 #include "HsVersions.h"
43 import Constants ( rESERVED_C_STACK_BYTES )
46 data RegUsage = RU [Reg] [Reg]
51 regUsage :: Instr -> RegUsage
52 regUsage instr = case instr of
53 SPILL reg _ -> usage ([reg], [])
54 RELOAD _ reg -> usage ([], [reg])
56 LD _ reg addr -> usage (regAddr addr, [reg])
57 LA _ reg addr -> usage (regAddr addr, [reg])
58 ST _ reg addr -> usage (reg : regAddr addr, [])
59 STU _ reg addr -> usage (reg : regAddr addr, [])
60 LIS reg _ -> usage ([], [reg])
61 LI reg _ -> usage ([], [reg])
62 MR reg1 reg2 -> usage ([reg2], [reg1])
63 CMP _ reg ri -> usage (reg : regRI ri,[])
64 CMPL _ reg ri -> usage (reg : regRI ri,[])
67 MTCTR reg -> usage ([reg],[])
69 BL _ params -> usage (params, callClobberedRegs)
70 BCTRL params -> usage (params, callClobberedRegs)
71 ADD reg1 reg2 ri -> usage (reg2 : regRI ri, [reg1])
72 ADDC reg1 reg2 reg3-> usage ([reg2,reg3], [reg1])
73 ADDE reg1 reg2 reg3-> usage ([reg2,reg3], [reg1])
74 ADDIS reg1 reg2 _ -> usage ([reg2], [reg1])
75 SUBF reg1 reg2 reg3-> usage ([reg2,reg3], [reg1])
76 MULLW reg1 reg2 ri -> usage (reg2 : regRI ri, [reg1])
77 DIVW reg1 reg2 reg3-> usage ([reg2,reg3], [reg1])
78 DIVWU reg1 reg2 reg3-> usage ([reg2,reg3], [reg1])
79 MULLW_MayOflo reg1 reg2 reg3
80 -> usage ([reg2,reg3], [reg1])
81 AND reg1 reg2 ri -> usage (reg2 : regRI ri, [reg1])
82 OR reg1 reg2 ri -> usage (reg2 : regRI ri, [reg1])
83 XOR reg1 reg2 ri -> usage (reg2 : regRI ri, [reg1])
84 XORIS reg1 reg2 _ -> usage ([reg2], [reg1])
85 EXTS _ reg1 reg2 -> usage ([reg2], [reg1])
86 NEG reg1 reg2 -> usage ([reg2], [reg1])
87 NOT reg1 reg2 -> usage ([reg2], [reg1])
88 SLW reg1 reg2 ri -> usage (reg2 : regRI ri, [reg1])
89 SRW reg1 reg2 ri -> usage (reg2 : regRI ri, [reg1])
90 SRAW reg1 reg2 ri -> usage (reg2 : regRI ri, [reg1])
91 RLWINM reg1 reg2 _ _ _
92 -> usage ([reg2], [reg1])
93 FADD _ r1 r2 r3 -> usage ([r2,r3], [r1])
94 FSUB _ r1 r2 r3 -> usage ([r2,r3], [r1])
95 FMUL _ r1 r2 r3 -> usage ([r2,r3], [r1])
96 FDIV _ r1 r2 r3 -> usage ([r2,r3], [r1])
97 FNEG r1 r2 -> usage ([r2], [r1])
98 FCMP r1 r2 -> usage ([r1,r2], [])
99 FCTIWZ r1 r2 -> usage ([r2], [r1])
100 FRSP r1 r2 -> usage ([r2], [r1])
101 MFCR reg -> usage ([], [reg])
102 MFLR reg -> usage ([], [reg])
103 FETCHPC reg -> usage ([], [reg])
106 usage (src, dst) = RU (filter interesting src)
107 (filter interesting dst)
108 regAddr (AddrRegReg r1 r2) = [r1, r2]
109 regAddr (AddrRegImm r1 _) = [r1]
111 regRI (RIReg r) = [r]
114 interesting :: Reg -> Bool
115 interesting (VirtualRegI _) = True
116 interesting (VirtualRegHi _) = True
117 interesting (VirtualRegF _) = True
118 interesting (VirtualRegD _) = True
119 interesting (RealReg i) = isFastTrue (freeReg i)
122 -- -----------------------------------------------------------------------------
123 -- 'patchRegs' function
125 -- 'patchRegs' takes an instruction and applies the given mapping to
126 -- all the register references.
128 patchRegs :: Instr -> (Reg -> Reg) -> Instr
129 patchRegs instr env = case instr of
130 SPILL reg slot -> SPILL (env reg) slot
131 RELOAD slot reg -> RELOAD slot (env reg)
133 LD sz reg addr -> LD sz (env reg) (fixAddr addr)
134 LA sz reg addr -> LA sz (env reg) (fixAddr addr)
135 ST sz reg addr -> ST sz (env reg) (fixAddr addr)
136 STU sz reg addr -> STU sz (env reg) (fixAddr addr)
137 LIS reg imm -> LIS (env reg) imm
138 LI reg imm -> LI (env reg) imm
139 MR reg1 reg2 -> MR (env reg1) (env reg2)
140 CMP sz reg ri -> CMP sz (env reg) (fixRI ri)
141 CMPL sz reg ri -> CMPL sz (env reg) (fixRI ri)
142 BCC cond lbl -> BCC cond lbl
143 BCCFAR cond lbl -> BCCFAR cond lbl
144 MTCTR reg -> MTCTR (env reg)
145 BCTR targets -> BCTR targets
146 BL imm argRegs -> BL imm argRegs -- argument regs
147 BCTRL argRegs -> BCTRL argRegs -- cannot be remapped
148 ADD reg1 reg2 ri -> ADD (env reg1) (env reg2) (fixRI ri)
149 ADDC reg1 reg2 reg3-> ADDC (env reg1) (env reg2) (env reg3)
150 ADDE reg1 reg2 reg3-> ADDE (env reg1) (env reg2) (env reg3)
151 ADDIS reg1 reg2 imm -> ADDIS (env reg1) (env reg2) imm
152 SUBF reg1 reg2 reg3-> SUBF (env reg1) (env reg2) (env reg3)
153 MULLW reg1 reg2 ri -> MULLW (env reg1) (env reg2) (fixRI ri)
154 DIVW reg1 reg2 reg3-> DIVW (env reg1) (env reg2) (env reg3)
155 DIVWU reg1 reg2 reg3-> DIVWU (env reg1) (env reg2) (env reg3)
156 MULLW_MayOflo reg1 reg2 reg3
157 -> MULLW_MayOflo (env reg1) (env reg2) (env reg3)
158 AND reg1 reg2 ri -> AND (env reg1) (env reg2) (fixRI ri)
159 OR reg1 reg2 ri -> OR (env reg1) (env reg2) (fixRI ri)
160 XOR reg1 reg2 ri -> XOR (env reg1) (env reg2) (fixRI ri)
161 XORIS reg1 reg2 imm -> XORIS (env reg1) (env reg2) imm
162 EXTS sz reg1 reg2 -> EXTS sz (env reg1) (env reg2)
163 NEG reg1 reg2 -> NEG (env reg1) (env reg2)
164 NOT reg1 reg2 -> NOT (env reg1) (env reg2)
165 SLW reg1 reg2 ri -> SLW (env reg1) (env reg2) (fixRI ri)
166 SRW reg1 reg2 ri -> SRW (env reg1) (env reg2) (fixRI ri)
167 SRAW reg1 reg2 ri -> SRAW (env reg1) (env reg2) (fixRI ri)
168 RLWINM reg1 reg2 sh mb me
169 -> RLWINM (env reg1) (env reg2) sh mb me
170 FADD sz r1 r2 r3 -> FADD sz (env r1) (env r2) (env r3)
171 FSUB sz r1 r2 r3 -> FSUB sz (env r1) (env r2) (env r3)
172 FMUL sz r1 r2 r3 -> FMUL sz (env r1) (env r2) (env r3)
173 FDIV sz r1 r2 r3 -> FDIV sz (env r1) (env r2) (env r3)
174 FNEG r1 r2 -> FNEG (env r1) (env r2)
175 FCMP r1 r2 -> FCMP (env r1) (env r2)
176 FCTIWZ r1 r2 -> FCTIWZ (env r1) (env r2)
177 FRSP r1 r2 -> FRSP (env r1) (env r2)
178 MFCR reg -> MFCR (env reg)
179 MFLR reg -> MFLR (env reg)
180 FETCHPC reg -> FETCHPC (env reg)
183 fixAddr (AddrRegReg r1 r2) = AddrRegReg (env r1) (env r2)
184 fixAddr (AddrRegImm r1 i) = AddrRegImm (env r1) i
186 fixRI (RIReg r) = RIReg (env r)
191 jumpDests :: Instr -> [BlockId] -> [BlockId]
195 BCCFAR _ id -> id : acc
196 BCTR targets -> targets ++ acc
200 -- | Check whether a particular instruction is a jump, branch or call instruction (jumpish)
201 -- We can't just use jumpDests above because the jump might take its arg,
202 -- so the instr won't contain a blockid.
204 isJumpish :: Instr -> Bool
215 -- | Change the destination of this jump instruction
216 -- Used in joinToTargets in the linear allocator, when emitting fixup code
218 patchJump :: Instr -> BlockId -> BlockId -> Instr
219 patchJump insn old new
222 | id == old -> BCC cc new
225 | id == old -> BCCFAR cc new
227 BCTR _ -> error "Cannot patch BCTR"
232 isRegRegMove :: Instr -> Maybe (Reg,Reg)
233 isRegRegMove (MR dst src) = Just (src,dst)
234 isRegRegMove _ = Nothing
237 data JumpDest = DestBlockId BlockId | DestImm Imm
239 canShortcut :: Instr -> Maybe JumpDest
240 canShortcut _ = Nothing
242 shortcutJump :: (BlockId -> Maybe JumpDest) -> Instr -> Instr
243 shortcutJump _ other = other
248 -- -----------------------------------------------------------------------------
249 -- Generating spill instructions
252 :: Reg -- register to spill
253 -> Int -- current stack delta
254 -> Int -- spill slot to use
256 mkSpillInstr reg delta slot
257 = let off = spillSlotToOffset slot
259 let sz = case regClass reg of
262 RcFloat -> panic "PPC.RegInfo.mkSpillInstr: no match"
263 in ST sz reg (AddrRegImm sp (ImmInt (off-delta)))
267 :: Reg -- register to load
268 -> Int -- current stack delta
269 -> Int -- spill slot to use
271 mkLoadInstr reg delta slot
272 = let off = spillSlotToOffset slot
274 let sz = case regClass reg of
277 RcFloat -> panic "PPC.RegInfo.mkSpillInstr: no match"
278 in LD sz reg (AddrRegImm sp (ImmInt (off-delta)))
285 mkRegRegMoveInstr src dst
293 mkBranchInstr id = [BCC ALWAYS id]
301 maxSpillSlots = ((rESERVED_C_STACK_BYTES - 64) `div` spillSlotSize) - 1
303 -- convert a spill slot number to a *byte* offset, with no sign:
304 -- decide on a per arch basis whether you are spilling above or below
305 -- the C stack pointer.
306 spillSlotToOffset :: Int -> Int
307 spillSlotToOffset slot
308 | slot >= 0 && slot < maxSpillSlots
309 = 64 + spillSlotSize * slot
311 = pprPanic "spillSlotToOffset:"
312 ( text "invalid spill location: " <> int slot
313 $$ text "maxSpillSlots: " <> int maxSpillSlots)