e618e189b815c40e9a1f8661b86cd39756c559c7
[ghc.git] / compiler / nativeGen / PPC / Instr.hs
1 {-# LANGUAGE CPP #-}
2
3 -----------------------------------------------------------------------------
4 --
5 -- Machine-dependent assembly language
6 --
7 -- (c) The University of Glasgow 1993-2004
8 --
9 -----------------------------------------------------------------------------
10
11 #include "HsVersions.h"
12 #include "nativeGen/NCG.h"
13
14 module PPC.Instr (
15 archWordFormat,
16 RI(..),
17 Instr(..),
18 stackFrameHeaderSize,
19 maxSpillSlots,
20 allocMoreStack,
21 makeFarBranches
22 )
23
24 where
25
26 import GhcPrelude
27
28 import PPC.Regs
29 import PPC.Cond
30 import Instruction
31 import Format
32 import TargetReg
33 import RegClass
34 import Reg
35
36 import CodeGen.Platform
37 import BlockId
38 import Hoopl.Collections
39 import Hoopl.Label
40 import DynFlags
41 import Cmm
42 import CmmInfo
43 import FastString
44 import CLabel
45 import Outputable
46 import Platform
47 import UniqFM (listToUFM, lookupUFM)
48 import UniqSupply
49
50 import Control.Monad (replicateM)
51 import Data.Maybe (fromMaybe)
52
53 --------------------------------------------------------------------------------
54 -- Format of a PPC memory address.
55 --
56 archWordFormat :: Bool -> Format
57 archWordFormat is32Bit
58 | is32Bit = II32
59 | otherwise = II64
60
61
62 -- | Instruction instance for powerpc
63 instance Instruction Instr where
64 regUsageOfInstr = ppc_regUsageOfInstr
65 patchRegsOfInstr = ppc_patchRegsOfInstr
66 isJumpishInstr = ppc_isJumpishInstr
67 jumpDestsOfInstr = ppc_jumpDestsOfInstr
68 patchJumpInstr = ppc_patchJumpInstr
69 mkSpillInstr = ppc_mkSpillInstr
70 mkLoadInstr = ppc_mkLoadInstr
71 takeDeltaInstr = ppc_takeDeltaInstr
72 isMetaInstr = ppc_isMetaInstr
73 mkRegRegMoveInstr _ = ppc_mkRegRegMoveInstr
74 takeRegRegMoveInstr = ppc_takeRegRegMoveInstr
75 mkJumpInstr = ppc_mkJumpInstr
76 mkStackAllocInstr = ppc_mkStackAllocInstr
77 mkStackDeallocInstr = ppc_mkStackDeallocInstr
78
79
80 ppc_mkStackAllocInstr :: Platform -> Int -> [Instr]
81 ppc_mkStackAllocInstr platform amount
82 = ppc_mkStackAllocInstr' platform (-amount)
83
84 ppc_mkStackDeallocInstr :: Platform -> Int -> [Instr]
85 ppc_mkStackDeallocInstr platform amount
86 = ppc_mkStackAllocInstr' platform amount
87
88 ppc_mkStackAllocInstr' :: Platform -> Int -> [Instr]
89 ppc_mkStackAllocInstr' platform amount
90 | fits16Bits amount
91 = [ LD fmt r0 (AddrRegImm sp zero)
92 , STU fmt r0 (AddrRegImm sp immAmount)
93 ]
94 | otherwise
95 = [ LD fmt r0 (AddrRegImm sp zero)
96 , ADDIS tmp sp (HA immAmount)
97 , ADD tmp tmp (RIImm (LO immAmount))
98 , STU fmt r0 (AddrRegReg sp tmp)
99 ]
100 where
101 fmt = intFormat $ widthFromBytes ((platformWordSize platform) `quot` 8)
102 zero = ImmInt 0
103 tmp = tmpReg platform
104 immAmount = ImmInt amount
105
106 --
107 -- See note [extra spill slots] in X86/Instr.hs
108 --
109 allocMoreStack
110 :: Platform
111 -> Int
112 -> NatCmmDecl statics PPC.Instr.Instr
113 -> UniqSM (NatCmmDecl statics PPC.Instr.Instr, [(BlockId,BlockId)])
114
115 allocMoreStack _ _ top@(CmmData _ _) = return (top,[])
116 allocMoreStack platform slots (CmmProc info lbl live (ListGraph code)) = do
117 let
118 infos = mapKeys info
119 entries = case code of
120 [] -> infos
121 BasicBlock entry _ : _ -- first block is the entry point
122 | entry `elem` infos -> infos
123 | otherwise -> entry : infos
124
125 uniqs <- replicateM (length entries) getUniqueM
126
127 let
128 delta = ((x + stackAlign - 1) `quot` stackAlign) * stackAlign -- round up
129 where x = slots * spillSlotSize -- sp delta
130
131 alloc = mkStackAllocInstr platform delta
132 dealloc = mkStackDeallocInstr platform delta
133
134 retargetList = (zip entries (map mkBlockId uniqs))
135
136 new_blockmap :: LabelMap BlockId
137 new_blockmap = mapFromList retargetList
138
139 insert_stack_insns (BasicBlock id insns)
140 | Just new_blockid <- mapLookup id new_blockmap
141 = [ BasicBlock id $ alloc ++ [BCC ALWAYS new_blockid Nothing]
142 , BasicBlock new_blockid block'
143 ]
144 | otherwise
145 = [ BasicBlock id block' ]
146 where
147 block' = foldr insert_dealloc [] insns
148
149 insert_dealloc insn r
150 -- BCTR might or might not be a non-local jump. For
151 -- "labeled-goto" we use JMP, and for "computed-goto" we
152 -- use MTCTR followed by BCTR. See 'PPC.CodeGen.genJump'.
153 = case insn of
154 JMP _ -> dealloc ++ (insn : r)
155 BCTR [] Nothing -> dealloc ++ (insn : r)
156 BCTR ids label -> BCTR (map (fmap retarget) ids) label : r
157 BCCFAR cond b p -> BCCFAR cond (retarget b) p : r
158 BCC cond b p -> BCC cond (retarget b) p : r
159 _ -> insn : r
160 -- BL and BCTRL are call-like instructions rather than
161 -- jumps, and are used only for C calls.
162
163 retarget :: BlockId -> BlockId
164 retarget b
165 = fromMaybe b (mapLookup b new_blockmap)
166
167 new_code
168 = concatMap insert_stack_insns code
169
170 -- in
171 return (CmmProc info lbl live (ListGraph new_code),retargetList)
172
173
174 -- -----------------------------------------------------------------------------
175 -- Machine's assembly language
176
177 -- We have a few common "instructions" (nearly all the pseudo-ops) but
178 -- mostly all of 'Instr' is machine-specific.
179
180 -- Register or immediate
181 data RI
182 = RIReg Reg
183 | RIImm Imm
184
185 data Instr
186 -- comment pseudo-op
187 = COMMENT FastString
188
189 -- some static data spat out during code
190 -- generation. Will be extracted before
191 -- pretty-printing.
192 | LDATA Section CmmStatics
193
194 -- start a new basic block. Useful during
195 -- codegen, removed later. Preceding
196 -- instruction should be a jump, as per the
197 -- invariants for a BasicBlock (see Cmm).
198 | NEWBLOCK BlockId
199
200 -- specify current stack offset for
201 -- benefit of subsequent passes
202 | DELTA Int
203
204 -- Loads and stores.
205 | LD Format Reg AddrMode -- Load format, dst, src
206 | LDFAR Format Reg AddrMode -- Load format, dst, src 32 bit offset
207 | LDR Format Reg AddrMode -- Load and reserve format, dst, src
208 | LA Format Reg AddrMode -- Load arithmetic format, dst, src
209 | ST Format Reg AddrMode -- Store format, src, dst
210 | STFAR Format Reg AddrMode -- Store format, src, dst 32 bit offset
211 | STU Format Reg AddrMode -- Store with Update format, src, dst
212 | STC Format Reg AddrMode -- Store conditional format, src, dst
213 | LIS Reg Imm -- Load Immediate Shifted dst, src
214 | LI Reg Imm -- Load Immediate dst, src
215 | MR Reg Reg -- Move Register dst, src -- also for fmr
216
217 | CMP Format Reg RI -- format, src1, src2
218 | CMPL Format Reg RI -- format, src1, src2
219
220 | BCC Cond BlockId (Maybe Bool) -- cond, block, hint
221 | BCCFAR Cond BlockId (Maybe Bool) -- cond, block, hint
222 -- hint:
223 -- Just True: branch likely taken
224 -- Just False: branch likely not taken
225 -- Nothing: no hint
226 | JMP CLabel -- same as branch,
227 -- but with CLabel instead of block ID
228 | MTCTR Reg
229 | BCTR [Maybe BlockId] (Maybe CLabel) -- with list of local destinations, and jump table location if necessary
230 | BL CLabel [Reg] -- with list of argument regs
231 | BCTRL [Reg]
232
233 | ADD Reg Reg RI -- dst, src1, src2
234 | ADDO Reg Reg Reg -- add and set overflow
235 | ADDC Reg Reg Reg -- (carrying) dst, src1, src2
236 | ADDE Reg Reg Reg -- (extended) dst, src1, src2
237 | ADDZE Reg Reg -- (to zero extended) dst, src
238 | ADDIS Reg Reg Imm -- Add Immediate Shifted dst, src1, src2
239 | SUBF Reg Reg Reg -- dst, src1, src2 ; dst = src2 - src1
240 | SUBFO Reg Reg Reg -- subtract from and set overflow
241 | SUBFC Reg Reg RI -- (carrying) dst, src1, src2 ;
242 -- dst = src2 - src1
243 | SUBFE Reg Reg Reg -- (extended) dst, src1, src2 ;
244 -- dst = src2 - src1
245 | MULL Format Reg Reg RI
246 | MULLO Format Reg Reg Reg -- multiply and set overflow
247 | MFOV Format Reg -- move overflow bit (1|33) to register
248 -- pseudo-instruction; pretty printed as
249 -- mfxer dst
250 -- extr[w|d]i dst, dst, 1, [1|33]
251 | MULHU Format Reg Reg Reg
252 | DIV Format Bool Reg Reg Reg
253 | AND Reg Reg RI -- dst, src1, src2
254 | ANDC Reg Reg Reg -- AND with complement, dst = src1 & ~ src2
255 | NAND Reg Reg Reg -- dst, src1, src2
256 | OR Reg Reg RI -- dst, src1, src2
257 | ORIS Reg Reg Imm -- OR Immediate Shifted dst, src1, src2
258 | XOR Reg Reg RI -- dst, src1, src2
259 | XORIS Reg Reg Imm -- XOR Immediate Shifted dst, src1, src2
260
261 | EXTS Format Reg Reg
262 | CNTLZ Format Reg Reg
263
264 | NEG Reg Reg
265 | NOT Reg Reg
266
267 | SL Format Reg Reg RI -- shift left
268 | SR Format Reg Reg RI -- shift right
269 | SRA Format Reg Reg RI -- shift right arithmetic
270
271 | RLWINM Reg Reg Int Int Int -- Rotate Left Word Immediate then AND with Mask
272 | CLRLI Format Reg Reg Int -- clear left immediate (extended mnemonic)
273 | CLRRI Format Reg Reg Int -- clear right immediate (extended mnemonic)
274
275 | FADD Format Reg Reg Reg
276 | FSUB Format Reg Reg Reg
277 | FMUL Format Reg Reg Reg
278 | FDIV Format Reg Reg Reg
279 | FABS Reg Reg -- abs is the same for single and double
280 | FNEG Reg Reg -- negate is the same for single and double prec.
281
282 | FCMP Reg Reg
283
284 | FCTIWZ Reg Reg -- convert to integer word
285 | FCTIDZ Reg Reg -- convert to integer double word
286 | FCFID Reg Reg -- convert from integer double word
287 | FRSP Reg Reg -- reduce to single precision
288 -- (but destination is a FP register)
289
290 | CRNOR Int Int Int -- condition register nor
291 | MFCR Reg -- move from condition register
292
293 | MFLR Reg -- move from link register
294 | FETCHPC Reg -- pseudo-instruction:
295 -- bcl to next insn, mflr reg
296 | HWSYNC -- heavy weight sync
297 | ISYNC -- instruction synchronize
298 | LWSYNC -- memory barrier
299 | NOP -- no operation, PowerPC 64 bit
300 -- needs this as place holder to
301 -- reload TOC pointer
302
303 -- | Get the registers that are being used by this instruction.
304 -- regUsage doesn't need to do any trickery for jumps and such.
305 -- Just state precisely the regs read and written by that insn.
306 -- The consequences of control flow transfers, as far as register
307 -- allocation goes, are taken care of by the register allocator.
308 --
309 ppc_regUsageOfInstr :: Platform -> Instr -> RegUsage
310 ppc_regUsageOfInstr platform instr
311 = case instr of
312 LD _ reg addr -> usage (regAddr addr, [reg])
313 LDFAR _ reg addr -> usage (regAddr addr, [reg])
314 LDR _ reg addr -> usage (regAddr addr, [reg])
315 LA _ reg addr -> usage (regAddr addr, [reg])
316 ST _ reg addr -> usage (reg : regAddr addr, [])
317 STFAR _ reg addr -> usage (reg : regAddr addr, [])
318 STU _ reg addr -> usage (reg : regAddr addr, [])
319 STC _ reg addr -> usage (reg : regAddr addr, [])
320 LIS reg _ -> usage ([], [reg])
321 LI reg _ -> usage ([], [reg])
322 MR reg1 reg2 -> usage ([reg2], [reg1])
323 CMP _ reg ri -> usage (reg : regRI ri,[])
324 CMPL _ reg ri -> usage (reg : regRI ri,[])
325 BCC _ _ _ -> noUsage
326 BCCFAR _ _ _ -> noUsage
327 MTCTR reg -> usage ([reg],[])
328 BCTR _ _ -> noUsage
329 BL _ params -> usage (params, callClobberedRegs platform)
330 BCTRL params -> usage (params, callClobberedRegs platform)
331
332 ADD reg1 reg2 ri -> usage (reg2 : regRI ri, [reg1])
333 ADDO reg1 reg2 reg3 -> usage ([reg2,reg3], [reg1])
334 ADDC reg1 reg2 reg3 -> usage ([reg2,reg3], [reg1])
335 ADDE reg1 reg2 reg3 -> usage ([reg2,reg3], [reg1])
336 ADDZE reg1 reg2 -> usage ([reg2], [reg1])
337 ADDIS reg1 reg2 _ -> usage ([reg2], [reg1])
338 SUBF reg1 reg2 reg3 -> usage ([reg2,reg3], [reg1])
339 SUBFO reg1 reg2 reg3 -> usage ([reg2,reg3], [reg1])
340 SUBFC reg1 reg2 ri -> usage (reg2 : regRI ri, [reg1])
341 SUBFE reg1 reg2 reg3 -> usage ([reg2,reg3], [reg1])
342 MULL _ reg1 reg2 ri -> usage (reg2 : regRI ri, [reg1])
343 MULLO _ reg1 reg2 reg3 -> usage ([reg2,reg3], [reg1])
344 MFOV _ reg -> usage ([], [reg])
345 MULHU _ reg1 reg2 reg3 -> usage ([reg2,reg3], [reg1])
346 DIV _ _ reg1 reg2 reg3
347 -> usage ([reg2,reg3], [reg1])
348
349 AND reg1 reg2 ri -> usage (reg2 : regRI ri, [reg1])
350 ANDC reg1 reg2 reg3 -> usage ([reg2,reg3], [reg1])
351 NAND reg1 reg2 reg3 -> usage ([reg2,reg3], [reg1])
352 OR reg1 reg2 ri -> usage (reg2 : regRI ri, [reg1])
353 ORIS reg1 reg2 _ -> usage ([reg2], [reg1])
354 XOR reg1 reg2 ri -> usage (reg2 : regRI ri, [reg1])
355 XORIS reg1 reg2 _ -> usage ([reg2], [reg1])
356 EXTS _ reg1 reg2 -> usage ([reg2], [reg1])
357 CNTLZ _ reg1 reg2 -> usage ([reg2], [reg1])
358 NEG reg1 reg2 -> usage ([reg2], [reg1])
359 NOT reg1 reg2 -> usage ([reg2], [reg1])
360 SL _ reg1 reg2 ri -> usage (reg2 : regRI ri, [reg1])
361 SR _ reg1 reg2 ri -> usage (reg2 : regRI ri, [reg1])
362 SRA _ reg1 reg2 ri -> usage (reg2 : regRI ri, [reg1])
363 RLWINM reg1 reg2 _ _ _ -> usage ([reg2], [reg1])
364 CLRLI _ reg1 reg2 _ -> usage ([reg2], [reg1])
365 CLRRI _ reg1 reg2 _ -> usage ([reg2], [reg1])
366
367 FADD _ r1 r2 r3 -> usage ([r2,r3], [r1])
368 FSUB _ r1 r2 r3 -> usage ([r2,r3], [r1])
369 FMUL _ r1 r2 r3 -> usage ([r2,r3], [r1])
370 FDIV _ r1 r2 r3 -> usage ([r2,r3], [r1])
371 FABS r1 r2 -> usage ([r2], [r1])
372 FNEG r1 r2 -> usage ([r2], [r1])
373 FCMP r1 r2 -> usage ([r1,r2], [])
374 FCTIWZ r1 r2 -> usage ([r2], [r1])
375 FCTIDZ r1 r2 -> usage ([r2], [r1])
376 FCFID r1 r2 -> usage ([r2], [r1])
377 FRSP r1 r2 -> usage ([r2], [r1])
378 MFCR reg -> usage ([], [reg])
379 MFLR reg -> usage ([], [reg])
380 FETCHPC reg -> usage ([], [reg])
381 _ -> noUsage
382 where
383 usage (src, dst) = RU (filter (interesting platform) src)
384 (filter (interesting platform) dst)
385 regAddr (AddrRegReg r1 r2) = [r1, r2]
386 regAddr (AddrRegImm r1 _) = [r1]
387
388 regRI (RIReg r) = [r]
389 regRI _ = []
390
391 interesting :: Platform -> Reg -> Bool
392 interesting _ (RegVirtual _) = True
393 interesting platform (RegReal (RealRegSingle i)) = freeReg platform i
394 interesting _ (RegReal (RealRegPair{}))
395 = panic "PPC.Instr.interesting: no reg pairs on this arch"
396
397
398
399 -- | Apply a given mapping to all the register references in this
400 -- instruction.
401 ppc_patchRegsOfInstr :: Instr -> (Reg -> Reg) -> Instr
402 ppc_patchRegsOfInstr instr env
403 = case instr of
404 LD fmt reg addr -> LD fmt (env reg) (fixAddr addr)
405 LDFAR fmt reg addr -> LDFAR fmt (env reg) (fixAddr addr)
406 LDR fmt reg addr -> LDR fmt (env reg) (fixAddr addr)
407 LA fmt reg addr -> LA fmt (env reg) (fixAddr addr)
408 ST fmt reg addr -> ST fmt (env reg) (fixAddr addr)
409 STFAR fmt reg addr -> STFAR fmt (env reg) (fixAddr addr)
410 STU fmt reg addr -> STU fmt (env reg) (fixAddr addr)
411 STC fmt reg addr -> STC fmt (env reg) (fixAddr addr)
412 LIS reg imm -> LIS (env reg) imm
413 LI reg imm -> LI (env reg) imm
414 MR reg1 reg2 -> MR (env reg1) (env reg2)
415 CMP fmt reg ri -> CMP fmt (env reg) (fixRI ri)
416 CMPL fmt reg ri -> CMPL fmt (env reg) (fixRI ri)
417 BCC cond lbl p -> BCC cond lbl p
418 BCCFAR cond lbl p -> BCCFAR cond lbl p
419 MTCTR reg -> MTCTR (env reg)
420 BCTR targets lbl -> BCTR targets lbl
421 BL imm argRegs -> BL imm argRegs -- argument regs
422 BCTRL argRegs -> BCTRL argRegs -- cannot be remapped
423 ADD reg1 reg2 ri -> ADD (env reg1) (env reg2) (fixRI ri)
424 ADDO reg1 reg2 reg3 -> ADDO (env reg1) (env reg2) (env reg3)
425 ADDC reg1 reg2 reg3 -> ADDC (env reg1) (env reg2) (env reg3)
426 ADDE reg1 reg2 reg3 -> ADDE (env reg1) (env reg2) (env reg3)
427 ADDZE reg1 reg2 -> ADDZE (env reg1) (env reg2)
428 ADDIS reg1 reg2 imm -> ADDIS (env reg1) (env reg2) imm
429 SUBF reg1 reg2 reg3 -> SUBF (env reg1) (env reg2) (env reg3)
430 SUBFO reg1 reg2 reg3 -> SUBFO (env reg1) (env reg2) (env reg3)
431 SUBFC reg1 reg2 ri -> SUBFC (env reg1) (env reg2) (fixRI ri)
432 SUBFE reg1 reg2 reg3 -> SUBFE (env reg1) (env reg2) (env reg3)
433 MULL fmt reg1 reg2 ri
434 -> MULL fmt (env reg1) (env reg2) (fixRI ri)
435 MULLO fmt reg1 reg2 reg3
436 -> MULLO fmt (env reg1) (env reg2) (env reg3)
437 MFOV fmt reg -> MFOV fmt (env reg)
438 MULHU fmt reg1 reg2 reg3
439 -> MULHU fmt (env reg1) (env reg2) (env reg3)
440 DIV fmt sgn reg1 reg2 reg3
441 -> DIV fmt sgn (env reg1) (env reg2) (env reg3)
442
443 AND reg1 reg2 ri -> AND (env reg1) (env reg2) (fixRI ri)
444 ANDC reg1 reg2 reg3 -> ANDC (env reg1) (env reg2) (env reg3)
445 NAND reg1 reg2 reg3 -> NAND (env reg1) (env reg2) (env reg3)
446 OR reg1 reg2 ri -> OR (env reg1) (env reg2) (fixRI ri)
447 ORIS reg1 reg2 imm -> ORIS (env reg1) (env reg2) imm
448 XOR reg1 reg2 ri -> XOR (env reg1) (env reg2) (fixRI ri)
449 XORIS reg1 reg2 imm -> XORIS (env reg1) (env reg2) imm
450 EXTS fmt reg1 reg2 -> EXTS fmt (env reg1) (env reg2)
451 CNTLZ fmt reg1 reg2 -> CNTLZ fmt (env reg1) (env reg2)
452 NEG reg1 reg2 -> NEG (env reg1) (env reg2)
453 NOT reg1 reg2 -> NOT (env reg1) (env reg2)
454 SL fmt reg1 reg2 ri
455 -> SL fmt (env reg1) (env reg2) (fixRI ri)
456 SR fmt reg1 reg2 ri
457 -> SR fmt (env reg1) (env reg2) (fixRI ri)
458 SRA fmt reg1 reg2 ri
459 -> SRA fmt (env reg1) (env reg2) (fixRI ri)
460 RLWINM reg1 reg2 sh mb me
461 -> RLWINM (env reg1) (env reg2) sh mb me
462 CLRLI fmt reg1 reg2 n -> CLRLI fmt (env reg1) (env reg2) n
463 CLRRI fmt reg1 reg2 n -> CLRRI fmt (env reg1) (env reg2) n
464 FADD fmt r1 r2 r3 -> FADD fmt (env r1) (env r2) (env r3)
465 FSUB fmt r1 r2 r3 -> FSUB fmt (env r1) (env r2) (env r3)
466 FMUL fmt r1 r2 r3 -> FMUL fmt (env r1) (env r2) (env r3)
467 FDIV fmt r1 r2 r3 -> FDIV fmt (env r1) (env r2) (env r3)
468 FABS r1 r2 -> FABS (env r1) (env r2)
469 FNEG r1 r2 -> FNEG (env r1) (env r2)
470 FCMP r1 r2 -> FCMP (env r1) (env r2)
471 FCTIWZ r1 r2 -> FCTIWZ (env r1) (env r2)
472 FCTIDZ r1 r2 -> FCTIDZ (env r1) (env r2)
473 FCFID r1 r2 -> FCFID (env r1) (env r2)
474 FRSP r1 r2 -> FRSP (env r1) (env r2)
475 MFCR reg -> MFCR (env reg)
476 MFLR reg -> MFLR (env reg)
477 FETCHPC reg -> FETCHPC (env reg)
478 _ -> instr
479 where
480 fixAddr (AddrRegReg r1 r2) = AddrRegReg (env r1) (env r2)
481 fixAddr (AddrRegImm r1 i) = AddrRegImm (env r1) i
482
483 fixRI (RIReg r) = RIReg (env r)
484 fixRI other = other
485
486
487 --------------------------------------------------------------------------------
488 -- | Checks whether this instruction is a jump/branch instruction.
489 -- One that can change the flow of control in a way that the
490 -- register allocator needs to worry about.
491 ppc_isJumpishInstr :: Instr -> Bool
492 ppc_isJumpishInstr instr
493 = case instr of
494 BCC{} -> True
495 BCCFAR{} -> True
496 BCTR{} -> True
497 BCTRL{} -> True
498 BL{} -> True
499 JMP{} -> True
500 _ -> False
501
502
503 -- | Checks whether this instruction is a jump/branch instruction.
504 -- One that can change the flow of control in a way that the
505 -- register allocator needs to worry about.
506 ppc_jumpDestsOfInstr :: Instr -> [BlockId]
507 ppc_jumpDestsOfInstr insn
508 = case insn of
509 BCC _ id _ -> [id]
510 BCCFAR _ id _ -> [id]
511 BCTR targets _ -> [id | Just id <- targets]
512 _ -> []
513
514
515 -- | Change the destination of this jump instruction.
516 -- Used in the linear allocator when adding fixup blocks for join
517 -- points.
518 ppc_patchJumpInstr :: Instr -> (BlockId -> BlockId) -> Instr
519 ppc_patchJumpInstr insn patchF
520 = case insn of
521 BCC cc id p -> BCC cc (patchF id) p
522 BCCFAR cc id p -> BCCFAR cc (patchF id) p
523 BCTR ids lbl -> BCTR (map (fmap patchF) ids) lbl
524 _ -> insn
525
526
527 -- -----------------------------------------------------------------------------
528
529 -- | An instruction to spill a register into a spill slot.
530 ppc_mkSpillInstr
531 :: DynFlags
532 -> Reg -- register to spill
533 -> Int -- current stack delta
534 -> Int -- spill slot to use
535 -> Instr
536
537 ppc_mkSpillInstr dflags reg delta slot
538 = let platform = targetPlatform dflags
539 off = spillSlotToOffset dflags slot
540 arch = platformArch platform
541 in
542 let fmt = case targetClassOfReg platform reg of
543 RcInteger -> case arch of
544 ArchPPC -> II32
545 _ -> II64
546 RcDouble -> FF64
547 _ -> panic "PPC.Instr.mkSpillInstr: no match"
548 instr = case makeImmediate W32 True (off-delta) of
549 Just _ -> ST
550 Nothing -> STFAR -- pseudo instruction: 32 bit offsets
551
552 in instr fmt reg (AddrRegImm sp (ImmInt (off-delta)))
553
554
555 ppc_mkLoadInstr
556 :: DynFlags
557 -> Reg -- register to load
558 -> Int -- current stack delta
559 -> Int -- spill slot to use
560 -> Instr
561
562 ppc_mkLoadInstr dflags reg delta slot
563 = let platform = targetPlatform dflags
564 off = spillSlotToOffset dflags slot
565 arch = platformArch platform
566 in
567 let fmt = case targetClassOfReg platform reg of
568 RcInteger -> case arch of
569 ArchPPC -> II32
570 _ -> II64
571 RcDouble -> FF64
572 _ -> panic "PPC.Instr.mkLoadInstr: no match"
573 instr = case makeImmediate W32 True (off-delta) of
574 Just _ -> LD
575 Nothing -> LDFAR -- pseudo instruction: 32 bit offsets
576
577 in instr fmt reg (AddrRegImm sp (ImmInt (off-delta)))
578
579
580 -- | The size of a minimal stackframe header including minimal
581 -- parameter save area.
582 stackFrameHeaderSize :: DynFlags -> Int
583 stackFrameHeaderSize dflags
584 = case platformOS platform of
585 OSAIX -> 24 + 8 * 4
586 _ -> case platformArch platform of
587 -- header + parameter save area
588 ArchPPC -> 64 -- TODO: check ABI spec
589 ArchPPC_64 ELF_V1 -> 48 + 8 * 8
590 ArchPPC_64 ELF_V2 -> 32 + 8 * 8
591 _ -> panic "PPC.stackFrameHeaderSize: not defined for this OS"
592 where platform = targetPlatform dflags
593
594 -- | The maximum number of bytes required to spill a register. PPC32
595 -- has 32-bit GPRs and 64-bit FPRs, while PPC64 has 64-bit GPRs and
596 -- 64-bit FPRs. So the maximum is 8 regardless of platforms unlike
597 -- x86. Note that AltiVec's vector registers are 128-bit wide so we
598 -- must not use this to spill them.
599 spillSlotSize :: Int
600 spillSlotSize = 8
601
602 -- | The number of spill slots available without allocating more.
603 maxSpillSlots :: DynFlags -> Int
604 maxSpillSlots dflags
605 = ((rESERVED_C_STACK_BYTES dflags - stackFrameHeaderSize dflags)
606 `div` spillSlotSize) - 1
607 -- = 0 -- useful for testing allocMoreStack
608
609 -- | The number of bytes that the stack pointer should be aligned
610 -- to. This is 16 both on PPC32 and PPC64 ELF (see ELF processor
611 -- specific supplements).
612 stackAlign :: Int
613 stackAlign = 16
614
615 -- | Convert a spill slot number to a *byte* offset, with no sign.
616 spillSlotToOffset :: DynFlags -> Int -> Int
617 spillSlotToOffset dflags slot
618 = stackFrameHeaderSize dflags + spillSlotSize * slot
619
620
621 --------------------------------------------------------------------------------
622 -- | See if this instruction is telling us the current C stack delta
623 ppc_takeDeltaInstr
624 :: Instr
625 -> Maybe Int
626
627 ppc_takeDeltaInstr instr
628 = case instr of
629 DELTA i -> Just i
630 _ -> Nothing
631
632
633 ppc_isMetaInstr
634 :: Instr
635 -> Bool
636
637 ppc_isMetaInstr instr
638 = case instr of
639 COMMENT{} -> True
640 LDATA{} -> True
641 NEWBLOCK{} -> True
642 DELTA{} -> True
643 _ -> False
644
645
646 -- | Copy the value in a register to another one.
647 -- Must work for all register classes.
648 ppc_mkRegRegMoveInstr
649 :: Reg
650 -> Reg
651 -> Instr
652
653 ppc_mkRegRegMoveInstr src dst
654 = MR dst src
655
656
657 -- | Make an unconditional jump instruction.
658 ppc_mkJumpInstr
659 :: BlockId
660 -> [Instr]
661
662 ppc_mkJumpInstr id
663 = [BCC ALWAYS id Nothing]
664
665
666 -- | Take the source and destination from this reg -> reg move instruction
667 -- or Nothing if it's not one
668 ppc_takeRegRegMoveInstr :: Instr -> Maybe (Reg,Reg)
669 ppc_takeRegRegMoveInstr (MR dst src) = Just (src,dst)
670 ppc_takeRegRegMoveInstr _ = Nothing
671
672 -- -----------------------------------------------------------------------------
673 -- Making far branches
674
675 -- Conditional branches on PowerPC are limited to +-32KB; if our Procs get too
676 -- big, we have to work around this limitation.
677
678 makeFarBranches
679 :: LabelMap CmmStatics
680 -> [NatBasicBlock Instr]
681 -> [NatBasicBlock Instr]
682 makeFarBranches info_env blocks
683 | last blockAddresses < nearLimit = blocks
684 | otherwise = zipWith handleBlock blockAddresses blocks
685 where
686 blockAddresses = scanl (+) 0 $ map blockLen blocks
687 blockLen (BasicBlock _ instrs) = length instrs
688
689 handleBlock addr (BasicBlock id instrs)
690 = BasicBlock id (zipWith makeFar [addr..] instrs)
691
692 makeFar _ (BCC ALWAYS tgt _) = BCC ALWAYS tgt Nothing
693 makeFar addr (BCC cond tgt p)
694 | abs (addr - targetAddr) >= nearLimit
695 = BCCFAR cond tgt p
696 | otherwise
697 = BCC cond tgt p
698 where Just targetAddr = lookupUFM blockAddressMap tgt
699 makeFar _ other = other
700
701 -- 8192 instructions are allowed; let's keep some distance, as
702 -- we have a few pseudo-insns that are pretty-printed as
703 -- multiple instructions, and it's just not worth the effort
704 -- to calculate things exactly
705 nearLimit = 7000 - mapSize info_env * maxRetInfoTableSizeW
706
707 blockAddressMap = listToUFM $ zip (map blockId blocks) blockAddresses