28 #include "nativeGen/NCG.h"
29 #include "HsVersions.h"
37 import Constants ( rESERVED_C_STACK_BYTES )
41 -- -----------------------------------------------------------------------------
44 -- @regUsage@ returns the sets of src and destination registers used
45 -- by a particular instruction. Machine registers that are
46 -- pre-allocated to stgRegs are filtered out, because they are
47 -- uninteresting from a register allocation standpoint. (We wouldn't
48 -- want them to end up on the free list!) As far as we are concerned,
49 -- the fixed registers simply don't exist (for allocation purposes,
52 -- regUsage doesn't need to do any trickery for jumps and such. Just
53 -- state precisely the regs read and written by that insn. The
54 -- consequences of control flow transfers, as far as register
55 -- allocation goes, are taken care of by the register allocator.
57 data RegUsage = RU [Reg] [Reg]
63 regUsage :: Instr -> RegUsage
64 regUsage instr = case instr of
65 MOV _ src dst -> usageRW src dst
66 MOVZxL _ src dst -> usageRW src dst
67 MOVSxL _ src dst -> usageRW src dst
68 LEA _ src dst -> usageRW src dst
69 ADD _ src dst -> usageRM src dst
70 ADC _ src dst -> usageRM src dst
71 SUB _ src dst -> usageRM src dst
72 IMUL _ src dst -> usageRM src dst
73 IMUL2 _ src -> mkRU (eax:use_R src) [eax,edx]
74 MUL _ src dst -> usageRM src dst
75 DIV _ op -> mkRU (eax:edx:use_R op) [eax,edx]
76 IDIV _ op -> mkRU (eax:edx:use_R op) [eax,edx]
77 AND _ src dst -> usageRM src dst
78 OR _ src dst -> usageRM src dst
80 XOR _ (OpReg src) (OpReg dst)
81 | src == dst -> mkRU [] [dst]
83 XOR _ src dst -> usageRM src dst
85 NEGI _ op -> usageM op
86 SHL _ imm dst -> usageRM imm dst
87 SAR _ imm dst -> usageRM imm dst
88 SHR _ imm dst -> usageRM imm dst
89 BT _ _ src -> mkRUR (use_R src)
91 PUSH _ op -> mkRUR (use_R op)
92 POP _ op -> mkRU [] (def_W op)
93 TEST _ src dst -> mkRUR (use_R src ++ use_R dst)
94 CMP _ src dst -> mkRUR (use_R src ++ use_R dst)
95 SETCC _ op -> mkRU [] (def_W op)
97 JXX_GBL _ _ -> mkRU [] []
98 JMP op -> mkRUR (use_R op)
99 JMP_TBL op _ -> mkRUR (use_R op)
100 CALL (Left _) params -> mkRU params callClobberedRegs
101 CALL (Right reg) params -> mkRU (reg:params) callClobberedRegs
102 CLTD _ -> mkRU [eax] [edx]
106 GMOV src dst -> mkRU [src] [dst]
107 GLD _ src dst -> mkRU (use_EA src) [dst]
108 GST _ src dst -> mkRUR (src : use_EA dst)
110 GLDZ dst -> mkRU [] [dst]
111 GLD1 dst -> mkRU [] [dst]
113 GFTOI src dst -> mkRU [src] [dst]
114 GDTOI src dst -> mkRU [src] [dst]
116 GITOF src dst -> mkRU [src] [dst]
117 GITOD src dst -> mkRU [src] [dst]
119 GADD _ s1 s2 dst -> mkRU [s1,s2] [dst]
120 GSUB _ s1 s2 dst -> mkRU [s1,s2] [dst]
121 GMUL _ s1 s2 dst -> mkRU [s1,s2] [dst]
122 GDIV _ s1 s2 dst -> mkRU [s1,s2] [dst]
124 GCMP _ src1 src2 -> mkRUR [src1,src2]
125 GABS _ src dst -> mkRU [src] [dst]
126 GNEG _ src dst -> mkRU [src] [dst]
127 GSQRT _ src dst -> mkRU [src] [dst]
128 GSIN _ _ _ src dst -> mkRU [src] [dst]
129 GCOS _ _ _ src dst -> mkRU [src] [dst]
130 GTAN _ _ _ src dst -> mkRU [src] [dst]
133 #if x86_64_TARGET_ARCH
134 CVTSS2SD src dst -> mkRU [src] [dst]
135 CVTSD2SS src dst -> mkRU [src] [dst]
136 CVTTSS2SIQ src dst -> mkRU (use_R src) [dst]
137 CVTTSD2SIQ src dst -> mkRU (use_R src) [dst]
138 CVTSI2SS src dst -> mkRU (use_R src) [dst]
139 CVTSI2SD src dst -> mkRU (use_R src) [dst]
140 FDIV _ src dst -> usageRM src dst
143 FETCHGOT reg -> mkRU [] [reg]
144 FETCHPC reg -> mkRU [] [reg]
148 SPILL reg _ -> mkRU [reg] []
149 RELOAD _ reg -> mkRU [] [reg]
151 _other -> panic "regUsage: unrecognised instr"
154 -- 2 operand form; first operand Read; second Written
155 usageRW :: Operand -> Operand -> RegUsage
156 usageRW op (OpReg reg) = mkRU (use_R op) [reg]
157 usageRW op (OpAddr ea) = mkRUR (use_R op ++ use_EA ea)
158 usageRW _ _ = panic "X86.RegInfo.usageRW: no match"
160 -- 2 operand form; first operand Read; second Modified
161 usageRM :: Operand -> Operand -> RegUsage
162 usageRM op (OpReg reg) = mkRU (use_R op ++ [reg]) [reg]
163 usageRM op (OpAddr ea) = mkRUR (use_R op ++ use_EA ea)
164 usageRM _ _ = panic "X86.RegInfo.usageRM: no match"
166 -- 1 operand form; operand Modified
167 usageM :: Operand -> RegUsage
168 usageM (OpReg reg) = mkRU [reg] [reg]
169 usageM (OpAddr ea) = mkRUR (use_EA ea)
170 usageM _ = panic "X86.RegInfo.usageM: no match"
172 -- Registers defd when an operand is written.
173 def_W (OpReg reg) = [reg]
174 def_W (OpAddr _ ) = []
175 def_W _ = panic "X86.RegInfo.def_W: no match"
177 -- Registers used when an operand is read.
178 use_R (OpReg reg) = [reg]
180 use_R (OpAddr ea) = use_EA ea
182 -- Registers used to compute an effective address.
183 use_EA (ImmAddr _ _) = []
184 use_EA (AddrBaseIndex base index _) =
185 use_base base $! use_index index
186 where use_base (EABaseReg r) x = r : x
188 use_index EAIndexNone = []
189 use_index (EAIndex i _) = [i]
191 mkRUR src = src' `seq` RU src' []
192 where src' = filter interesting src
194 mkRU src dst = src' `seq` dst' `seq` RU src' dst'
195 where src' = filter interesting src
196 dst' = filter interesting dst
198 interesting :: Reg -> Bool
199 interesting (VirtualRegI _) = True
200 interesting (VirtualRegHi _) = True
201 interesting (VirtualRegF _) = True
202 interesting (VirtualRegD _) = True
203 interesting (RealReg i) = isFastTrue (freeReg i)
208 -- -----------------------------------------------------------------------------
209 -- 'patchRegs' function
211 -- 'patchRegs' takes an instruction and applies the given mapping to
212 -- all the register references.
214 patchRegs :: Instr -> (Reg -> Reg) -> Instr
215 patchRegs instr env = case instr of
216 MOV sz src dst -> patch2 (MOV sz) src dst
217 MOVZxL sz src dst -> patch2 (MOVZxL sz) src dst
218 MOVSxL sz src dst -> patch2 (MOVSxL sz) src dst
219 LEA sz src dst -> patch2 (LEA sz) src dst
220 ADD sz src dst -> patch2 (ADD sz) src dst
221 ADC sz src dst -> patch2 (ADC sz) src dst
222 SUB sz src dst -> patch2 (SUB sz) src dst
223 IMUL sz src dst -> patch2 (IMUL sz) src dst
224 IMUL2 sz src -> patch1 (IMUL2 sz) src
225 MUL sz src dst -> patch2 (MUL sz) src dst
226 IDIV sz op -> patch1 (IDIV sz) op
227 DIV sz op -> patch1 (DIV sz) op
228 AND sz src dst -> patch2 (AND sz) src dst
229 OR sz src dst -> patch2 (OR sz) src dst
230 XOR sz src dst -> patch2 (XOR sz) src dst
231 NOT sz op -> patch1 (NOT sz) op
232 NEGI sz op -> patch1 (NEGI sz) op
233 SHL sz imm dst -> patch1 (SHL sz imm) dst
234 SAR sz imm dst -> patch1 (SAR sz imm) dst
235 SHR sz imm dst -> patch1 (SHR sz imm) dst
236 BT sz imm src -> patch1 (BT sz imm) src
237 TEST sz src dst -> patch2 (TEST sz) src dst
238 CMP sz src dst -> patch2 (CMP sz) src dst
239 PUSH sz op -> patch1 (PUSH sz) op
240 POP sz op -> patch1 (POP sz) op
241 SETCC cond op -> patch1 (SETCC cond) op
242 JMP op -> patch1 JMP op
243 JMP_TBL op ids -> patch1 JMP_TBL op $ ids
246 GMOV src dst -> GMOV (env src) (env dst)
247 GLD sz src dst -> GLD sz (lookupAddr src) (env dst)
248 GST sz src dst -> GST sz (env src) (lookupAddr dst)
250 GLDZ dst -> GLDZ (env dst)
251 GLD1 dst -> GLD1 (env dst)
253 GFTOI src dst -> GFTOI (env src) (env dst)
254 GDTOI src dst -> GDTOI (env src) (env dst)
256 GITOF src dst -> GITOF (env src) (env dst)
257 GITOD src dst -> GITOD (env src) (env dst)
259 GADD sz s1 s2 dst -> GADD sz (env s1) (env s2) (env dst)
260 GSUB sz s1 s2 dst -> GSUB sz (env s1) (env s2) (env dst)
261 GMUL sz s1 s2 dst -> GMUL sz (env s1) (env s2) (env dst)
262 GDIV sz s1 s2 dst -> GDIV sz (env s1) (env s2) (env dst)
264 GCMP sz src1 src2 -> GCMP sz (env src1) (env src2)
265 GABS sz src dst -> GABS sz (env src) (env dst)
266 GNEG sz src dst -> GNEG sz (env src) (env dst)
267 GSQRT sz src dst -> GSQRT sz (env src) (env dst)
268 GSIN sz l1 l2 src dst -> GSIN sz l1 l2 (env src) (env dst)
269 GCOS sz l1 l2 src dst -> GCOS sz l1 l2 (env src) (env dst)
270 GTAN sz l1 l2 src dst -> GTAN sz l1 l2 (env src) (env dst)
273 #if x86_64_TARGET_ARCH
274 CVTSS2SD src dst -> CVTSS2SD (env src) (env dst)
275 CVTSD2SS src dst -> CVTSD2SS (env src) (env dst)
276 CVTTSS2SIQ src dst -> CVTTSS2SIQ (patchOp src) (env dst)
277 CVTTSD2SIQ src dst -> CVTTSD2SIQ (patchOp src) (env dst)
278 CVTSI2SS src dst -> CVTSI2SS (patchOp src) (env dst)
279 CVTSI2SD src dst -> CVTSI2SD (patchOp src) (env dst)
280 FDIV sz src dst -> FDIV sz (patchOp src) (patchOp dst)
283 CALL (Left _) _ -> instr
284 CALL (Right reg) p -> CALL (Right (env reg)) p
286 FETCHGOT reg -> FETCHGOT (env reg)
287 FETCHPC reg -> FETCHPC (env reg)
292 SPILL reg slot -> SPILL (env reg) slot
293 RELOAD slot reg -> RELOAD slot (env reg)
299 _other -> panic "patchRegs: unrecognised instr"
302 patch1 insn op = insn $! patchOp op
303 patch2 insn src dst = (insn $! patchOp src) $! patchOp dst
305 patchOp (OpReg reg) = OpReg $! env reg
306 patchOp (OpImm imm) = OpImm imm
307 patchOp (OpAddr ea) = OpAddr $! lookupAddr ea
309 lookupAddr (ImmAddr imm off) = ImmAddr imm off
310 lookupAddr (AddrBaseIndex base index disp)
311 = ((AddrBaseIndex $! lookupBase base) $! lookupIndex index) disp
313 lookupBase EABaseNone = EABaseNone
314 lookupBase EABaseRip = EABaseRip
315 lookupBase (EABaseReg r) = EABaseReg (env r)
317 lookupIndex EAIndexNone = EAIndexNone
318 lookupIndex (EAIndex r i) = EAIndex (env r) i
321 -- -----------------------------------------------------------------------------
322 -- Determine the possible destinations from the current instruction.
324 -- (we always assume that the next instruction is also a valid destination;
325 -- if this isn't the case then the jump should be at the end of the basic
328 jumpDests :: Instr -> [BlockId] -> [BlockId]
332 JMP_TBL _ ids -> ids ++ acc
336 isJumpish :: Instr -> Bool
346 -- | Change the destination of this jump instruction
347 -- Used in joinToTargets in the linear allocator, when emitting fixup code
349 patchJump :: Instr -> BlockId -> BlockId -> Instr
350 patchJump insn old new
352 JXX cc id | id == old -> JXX cc new
353 JMP_TBL _ _ -> error "Cannot patch JMP_TBL"
357 -- -----------------------------------------------------------------------------
358 -- Detecting reg->reg moves
360 -- The register allocator attempts to eliminate reg->reg moves whenever it can,
361 -- by assigning the src and dest temporaries to the same real register.
363 isRegRegMove :: Instr -> Maybe (Reg,Reg)
364 isRegRegMove (MOV _ (OpReg r1) (OpReg r2)) = Just (r1,r2)
365 isRegRegMove _ = Nothing
369 data JumpDest = DestBlockId BlockId | DestImm Imm
372 canShortcut :: Instr -> Maybe JumpDest
373 canShortcut (JXX ALWAYS id) = Just (DestBlockId id)
374 canShortcut (JMP (OpImm imm)) = Just (DestImm imm)
375 canShortcut _ = Nothing
378 shortcutJump :: (BlockId -> Maybe JumpDest) -> Instr -> Instr
379 shortcutJump fn insn@(JXX cc id) =
382 Just (DestBlockId id') -> shortcutJump fn (JXX cc id')
383 Just (DestImm imm) -> shortcutJump fn (JXX_GBL cc imm)
385 shortcutJump _ other = other
389 -- -----------------------------------------------------------------------------
390 -- Generating spill instructions
393 :: Reg -- register to spill
394 -> Int -- current stack delta
395 -> Int -- spill slot to use
399 mkSpillInstr reg delta slot
400 = let off = spillSlotToOffset slot
402 let off_w = (off-delta) `div` 4
403 in case regClass reg of
404 RcInteger -> MOV II32 (OpReg reg) (OpAddr (spRel off_w))
405 _ -> GST FF80 reg (spRel off_w) {- RcFloat/RcDouble -}
407 #elif x86_64_TARGET_ARCH
408 mkSpillInstr reg delta slot
409 = let off = spillSlotToOffset slot
411 let off_w = (off-delta) `div` 8
412 in case regClass reg of
413 RcInteger -> MOV II64 (OpReg reg) (OpAddr (spRel off_w))
414 RcDouble -> MOV FF64 (OpReg reg) (OpAddr (spRel off_w))
415 RcFloat -> panic "mkSpillInstr/RcFloat"
416 -- ToDo: will it work to always spill as a double?
417 -- does that cause a stall if the data was a float?
420 = panic "X86.RegInfo.mkSpillInstr: not defined for this architecture."
425 :: Reg -- register to load
426 -> Int -- current stack delta
427 -> Int -- spill slot to use
430 mkLoadInstr reg delta slot
431 = let off = spillSlotToOffset slot
433 let off_w = (off-delta) `div` 4
434 in case regClass reg of {
435 RcInteger -> MOV II32 (OpAddr (spRel off_w)) (OpReg reg);
436 _ -> GLD FF80 (spRel off_w) reg} {- RcFloat/RcDouble -}
437 #elif x86_64_TARGET_ARCH
438 mkLoadInstr reg delta slot
439 = let off = spillSlotToOffset slot
441 let off_w = (off-delta) `div` 8
442 in case regClass reg of
443 RcInteger -> MOV II64 (OpAddr (spRel off_w)) (OpReg reg)
444 _ -> MOV FF64 (OpAddr (spRel off_w)) (OpReg reg)
447 = panic "X86.RegInfo.mkLoadInstr: not defined for this architecture."
456 mkRegRegMoveInstr src dst
457 = case regClass src of
458 RcInteger -> MOV wordSize (OpReg src) (OpReg dst)
460 RcDouble -> GMOV src dst
461 RcFloat -> panic "X86.RegInfo.mkRegRegMoveInstr: no match"
463 RcDouble -> MOV FF64 (OpReg src) (OpReg dst)
464 RcFloat -> panic "X86.RegInfo.mkRegRegMoveInstr: no match"
472 mkBranchInstr id = [JXX ALWAYS id]
476 spillSlotSize = IF_ARCH_i386(12, 8)
479 maxSpillSlots = ((rESERVED_C_STACK_BYTES - 64) `div` spillSlotSize) - 1
481 -- convert a spill slot number to a *byte* offset, with no sign:
482 -- decide on a per arch basis whether you are spilling above or below
483 -- the C stack pointer.
484 spillSlotToOffset :: Int -> Int
485 spillSlotToOffset slot
486 | slot >= 0 && slot < maxSpillSlots
487 = 64 + spillSlotSize * slot
489 = pprPanic "spillSlotToOffset:"
490 ( text "invalid spill location: " <> int slot
491 $$ text "maxSpillSlots: " <> int maxSpillSlots)