2 -----------------------------------------------------------------------------
4 -- Generating machine code (instruction selection)
6 -- (c) The University of Glasgow 1996-2004
8 -----------------------------------------------------------------------------
10 -- This is a big module, but, if you pay attention to
11 -- (a) the sectioning, (b) the type signatures, and
12 -- (c) the #if blah_TARGET_ARCH} things, the
13 -- structure should not be too overwhelming.
17 generateJumpTableForInstr,
23 #include "HsVersions.h"
24 #include "nativeGen/NCG.h"
25 #include "../includes/MachDeps.h"
40 -- Our intermediate code:
42 import PprCmm ( pprExpr )
47 import StaticFlags ( opt_PIC )
53 import Control.Monad ( mapAndUnzipM )
60 -- -----------------------------------------------------------------------------
61 -- Top-level of the instruction selector
63 -- | 'InstrBlock's are the insn sequences generated by the insn selectors.
64 -- They are really trees of insns to facilitate fast appending, where a
65 -- left-to-right traversal (pre-order?) yields the insns in the correct
70 -> NatM [NatCmmTop Instr]
72 cmmTopCodeGen (CmmProc info lab (ListGraph blocks)) = do
73 (nat_blocks,statics) <- mapAndUnzipM basicBlockCodeGen blocks
74 picBaseMb <- getPicBaseMaybeNat
75 dflags <- getDynFlagsNat
76 let proc = CmmProc info lab (ListGraph $ concat nat_blocks)
77 tops = proc : concat statics
78 os = platformOS $ targetPlatform dflags
80 Just picBase -> initializePicBase_ppc ArchPPC os picBase tops
81 Nothing -> return tops
83 cmmTopCodeGen (CmmData sec dat) = do
84 return [CmmData sec dat] -- no translation, we just use CmmStatic
88 -> NatM ( [NatBasicBlock Instr]
91 basicBlockCodeGen (BasicBlock id stmts) = do
92 instrs <- stmtsToInstrs stmts
93 -- code generation may introduce new basic block boundaries, which
94 -- are indicated by the NEWBLOCK instruction. We must split up the
95 -- instruction stream into basic blocks again. Also, we extract
98 (top,other_blocks,statics) = foldrOL mkBlocks ([],[],[]) instrs
100 mkBlocks (NEWBLOCK id) (instrs,blocks,statics)
101 = ([], BasicBlock id instrs : blocks, statics)
102 mkBlocks (LDATA sec dat) (instrs,blocks,statics)
103 = (instrs, blocks, CmmData sec dat:statics)
104 mkBlocks instr (instrs,blocks,statics)
105 = (instr:instrs, blocks, statics)
107 return (BasicBlock id top : other_blocks, statics)
109 stmtsToInstrs :: [CmmStmt] -> NatM InstrBlock
111 = do instrss <- mapM stmtToInstrs stmts
112 return (concatOL instrss)
114 stmtToInstrs :: CmmStmt -> NatM InstrBlock
115 stmtToInstrs stmt = do
116 dflags <- getDynFlagsNat
118 CmmNop -> return nilOL
119 CmmComment s -> return (unitOL (COMMENT s))
122 | isFloatType ty -> assignReg_FltCode size reg src
123 | target32Bit (targetPlatform dflags) &&
124 isWord64 ty -> assignReg_I64Code reg src
125 | otherwise -> assignReg_IntCode size reg src
126 where ty = cmmRegType reg
127 size = cmmTypeSize ty
130 | isFloatType ty -> assignMem_FltCode size addr src
131 | target32Bit (targetPlatform dflags) &&
132 isWord64 ty -> assignMem_I64Code addr src
133 | otherwise -> assignMem_IntCode size addr src
134 where ty = cmmExprType src
135 size = cmmTypeSize ty
137 CmmCall target result_regs args _ _
138 -> genCCall target result_regs args
140 CmmBranch id -> genBranch id
141 CmmCondBranch arg id -> genCondJump id arg
142 CmmSwitch arg ids -> genSwitch arg ids
143 CmmJump arg _ -> genJump arg
145 panic "stmtToInstrs: return statement should have been cps'd away"
148 --------------------------------------------------------------------------------
149 -- | 'InstrBlock's are the insn sequences generated by the insn selectors.
150 -- They are really trees of insns to facilitate fast appending, where a
151 -- left-to-right traversal yields the insns in the correct order.
157 -- | Register's passed up the tree. If the stix code forces the register
158 -- to live in a pre-decided machine register, it comes out as @Fixed@;
159 -- otherwise, it comes out as @Any@, and the parent can decide which
160 -- register to put it in.
163 = Fixed Size Reg InstrBlock
164 | Any Size (Reg -> InstrBlock)
167 swizzleRegisterRep :: Register -> Size -> Register
168 swizzleRegisterRep (Fixed _ reg code) size = Fixed size reg code
169 swizzleRegisterRep (Any _ codefn) size = Any size codefn
172 -- | Grab the Reg for a CmmReg
173 getRegisterReg :: CmmReg -> Reg
175 getRegisterReg (CmmLocal (LocalReg u pk))
176 = RegVirtual $ mkVirtualReg u (cmmTypeSize pk)
178 getRegisterReg (CmmGlobal mid)
179 = case globalRegMaybe mid of
181 Nothing -> pprPanic "getRegisterReg-memory" (ppr $ CmmGlobal mid)
182 -- By this stage, the only MagicIds remaining should be the
183 -- ones which map to a real machine register on this
184 -- platform. Hence ...
188 Now, given a tree (the argument to an CmmLoad) that references memory,
189 produce a suitable addressing mode.
191 A Rule of the Game (tm) for Amodes: use of the addr bit must
192 immediately follow use of the code part, since the code part puts
193 values in registers which the addr then refers to. So you can't put
194 anything in between, lest it overwrite some of those registers. If
195 you need to do some other computation between the code part and use of
196 the addr bit, first store the effective address from the amode in a
197 temporary, then do the other computation, and then use the temporary:
201 ... other computation ...
206 -- | Convert a BlockId to some CmmStatic data
207 jumpTableEntry :: Maybe BlockId -> CmmStatic
208 jumpTableEntry Nothing = CmmStaticLit (CmmInt 0 wordWidth)
209 jumpTableEntry (Just blockid) = CmmStaticLit (CmmLabel blockLabel)
210 where blockLabel = mkAsmTempLabel (getUnique blockid)
214 -- -----------------------------------------------------------------------------
215 -- General things for putting together code sequences
217 -- Expand CmmRegOff. ToDo: should we do it this way around, or convert
218 -- CmmExprs into CmmRegOff?
219 mangleIndexTree :: CmmExpr -> CmmExpr
220 mangleIndexTree (CmmRegOff reg off)
221 = CmmMachOp (MO_Add width) [CmmReg reg, CmmLit (CmmInt (fromIntegral off) width)]
222 where width = typeWidth (cmmRegType reg)
225 = panic "PPC.CodeGen.mangleIndexTree: no match"
227 -- -----------------------------------------------------------------------------
228 -- Code gen for 64-bit arithmetic on 32-bit platforms
231 Simple support for generating 64-bit code (ie, 64 bit values and 64
232 bit assignments) on 32-bit platforms. Unlike the main code generator
233 we merely shoot for generating working code as simply as possible, and
234 pay little attention to code quality. Specifically, there is no
235 attempt to deal cleverly with the fixed-vs-floating register
236 distinction; all values are generated into (pairs of) floating
237 registers, even if this would mean some redundant reg-reg moves as a
238 result. Only one of the VRegUniques is returned, since it will be
239 of the VRegUniqueLo form, and the upper-half VReg can be determined
240 by applying getHiVRegFromLo to it.
243 data ChildCode64 -- a.k.a "Register64"
246 Reg -- the lower 32-bit temporary which contains the
247 -- result; use getHiVRegFromLo to find the other
248 -- VRegUnique. Rules of this simplified insn
249 -- selection game are therefore that the returned
250 -- Reg may be modified
253 -- | The dual to getAnyReg: compute an expression into a register, but
254 -- we don't mind which one it is.
255 getSomeReg :: CmmExpr -> NatM (Reg, InstrBlock)
257 r <- getRegister expr
260 tmp <- getNewRegNat rep
261 return (tmp, code tmp)
265 getI64Amodes :: CmmExpr -> NatM (AddrMode, AddrMode, InstrBlock)
266 getI64Amodes addrTree = do
267 Amode hi_addr addr_code <- getAmode addrTree
268 case addrOffset hi_addr 4 of
269 Just lo_addr -> return (hi_addr, lo_addr, addr_code)
270 Nothing -> do (hi_ptr, code) <- getSomeReg addrTree
271 return (AddrRegImm hi_ptr (ImmInt 0),
272 AddrRegImm hi_ptr (ImmInt 4),
276 assignMem_I64Code :: CmmExpr -> CmmExpr -> NatM InstrBlock
277 assignMem_I64Code addrTree valueTree = do
278 (hi_addr, lo_addr, addr_code) <- getI64Amodes addrTree
279 ChildCode64 vcode rlo <- iselExpr64 valueTree
281 rhi = getHiVRegFromLo rlo
284 mov_hi = ST II32 rhi hi_addr
285 mov_lo = ST II32 rlo lo_addr
287 return (vcode `appOL` addr_code `snocOL` mov_lo `snocOL` mov_hi)
290 assignReg_I64Code :: CmmReg -> CmmExpr -> NatM InstrBlock
291 assignReg_I64Code (CmmLocal (LocalReg u_dst _)) valueTree = do
292 ChildCode64 vcode r_src_lo <- iselExpr64 valueTree
294 r_dst_lo = RegVirtual $ mkVirtualReg u_dst II32
295 r_dst_hi = getHiVRegFromLo r_dst_lo
296 r_src_hi = getHiVRegFromLo r_src_lo
297 mov_lo = MR r_dst_lo r_src_lo
298 mov_hi = MR r_dst_hi r_src_hi
301 vcode `snocOL` mov_lo `snocOL` mov_hi
304 assignReg_I64Code _ _
305 = panic "assignReg_I64Code(powerpc): invalid lvalue"
308 iselExpr64 :: CmmExpr -> NatM ChildCode64
309 iselExpr64 (CmmLoad addrTree ty) | isWord64 ty = do
310 (hi_addr, lo_addr, addr_code) <- getI64Amodes addrTree
311 (rlo, rhi) <- getNewRegPairNat II32
312 let mov_hi = LD II32 rhi hi_addr
313 mov_lo = LD II32 rlo lo_addr
314 return $ ChildCode64 (addr_code `snocOL` mov_lo `snocOL` mov_hi)
317 iselExpr64 (CmmReg (CmmLocal (LocalReg vu ty))) | isWord64 ty
318 = return (ChildCode64 nilOL (RegVirtual $ mkVirtualReg vu II32))
320 iselExpr64 (CmmLit (CmmInt i _)) = do
321 (rlo,rhi) <- getNewRegPairNat II32
323 half0 = fromIntegral (fromIntegral i :: Word16)
324 half1 = fromIntegral ((fromIntegral i `shiftR` 16) :: Word16)
325 half2 = fromIntegral ((fromIntegral i `shiftR` 32) :: Word16)
326 half3 = fromIntegral ((fromIntegral i `shiftR` 48) :: Word16)
329 LIS rlo (ImmInt half1),
330 OR rlo rlo (RIImm $ ImmInt half0),
331 LIS rhi (ImmInt half3),
332 OR rlo rlo (RIImm $ ImmInt half2)
335 return (ChildCode64 code rlo)
337 iselExpr64 (CmmMachOp (MO_Add _) [e1,e2]) = do
338 ChildCode64 code1 r1lo <- iselExpr64 e1
339 ChildCode64 code2 r2lo <- iselExpr64 e2
340 (rlo,rhi) <- getNewRegPairNat II32
342 r1hi = getHiVRegFromLo r1lo
343 r2hi = getHiVRegFromLo r2lo
346 toOL [ ADDC rlo r1lo r2lo,
349 return (ChildCode64 code rlo)
351 iselExpr64 (CmmMachOp (MO_UU_Conv W32 W64) [expr]) = do
352 (expr_reg,expr_code) <- getSomeReg expr
353 (rlo, rhi) <- getNewRegPairNat II32
354 let mov_hi = LI rhi (ImmInt 0)
355 mov_lo = MR rlo expr_reg
356 return $ ChildCode64 (expr_code `snocOL` mov_lo `snocOL` mov_hi)
359 = pprPanic "iselExpr64(powerpc)" (ppr expr)
363 getRegister :: CmmExpr -> NatM Register
364 getRegister e = do dflags <- getDynFlagsNat
365 getRegister' dflags e
367 getRegister' :: DynFlags -> CmmExpr -> NatM Register
369 getRegister' _ (CmmReg (CmmGlobal PicBaseReg))
371 reg <- getPicBaseNat archWordSize
372 return (Fixed archWordSize reg nilOL)
374 getRegister' _ (CmmReg reg)
375 = return (Fixed (cmmTypeSize (cmmRegType reg))
376 (getRegisterReg reg) nilOL)
378 getRegister' dflags tree@(CmmRegOff _ _)
379 = getRegister' dflags (mangleIndexTree tree)
381 -- for 32-bit architectuers, support some 64 -> 32 bit conversions:
382 -- TO_W_(x), TO_W_(x >> 32)
384 getRegister' dflags (CmmMachOp (MO_UU_Conv W64 W32)
385 [CmmMachOp (MO_U_Shr W64) [x,CmmLit (CmmInt 32 _)]])
386 | target32Bit (targetPlatform dflags) = do
387 ChildCode64 code rlo <- iselExpr64 x
388 return $ Fixed II32 (getHiVRegFromLo rlo) code
390 getRegister' dflags (CmmMachOp (MO_SS_Conv W64 W32)
391 [CmmMachOp (MO_U_Shr W64) [x,CmmLit (CmmInt 32 _)]])
392 | target32Bit (targetPlatform dflags) = do
393 ChildCode64 code rlo <- iselExpr64 x
394 return $ Fixed II32 (getHiVRegFromLo rlo) code
396 getRegister' dflags (CmmMachOp (MO_UU_Conv W64 W32) [x])
397 | target32Bit (targetPlatform dflags) = do
398 ChildCode64 code rlo <- iselExpr64 x
399 return $ Fixed II32 rlo code
401 getRegister' dflags (CmmMachOp (MO_SS_Conv W64 W32) [x])
402 | target32Bit (targetPlatform dflags) = do
403 ChildCode64 code rlo <- iselExpr64 x
404 return $ Fixed II32 rlo code
406 getRegister' _ (CmmLoad mem pk)
409 Amode addr addr_code <- getAmode mem
410 let code dst = ASSERT((targetClassOfReg dst == RcDouble) == isFloatType pk)
411 addr_code `snocOL` LD size dst addr
412 return (Any size code)
413 where size = cmmTypeSize pk
415 -- catch simple cases of zero- or sign-extended load
416 getRegister' _ (CmmMachOp (MO_UU_Conv W8 W32) [CmmLoad mem _]) = do
417 Amode addr addr_code <- getAmode mem
418 return (Any II32 (\dst -> addr_code `snocOL` LD II8 dst addr))
420 -- Note: there is no Load Byte Arithmetic instruction, so no signed case here
422 getRegister' _ (CmmMachOp (MO_UU_Conv W16 W32) [CmmLoad mem _]) = do
423 Amode addr addr_code <- getAmode mem
424 return (Any II32 (\dst -> addr_code `snocOL` LD II16 dst addr))
426 getRegister' _ (CmmMachOp (MO_SS_Conv W16 W32) [CmmLoad mem _]) = do
427 Amode addr addr_code <- getAmode mem
428 return (Any II32 (\dst -> addr_code `snocOL` LA II16 dst addr))
430 getRegister' dflags (CmmMachOp mop [x]) -- unary MachOps
432 MO_Not rep -> triv_ucode_int rep NOT
434 MO_F_Neg w -> triv_ucode_float w FNEG
435 MO_S_Neg w -> triv_ucode_int w NEG
437 MO_FF_Conv W64 W32 -> trivialUCode FF32 FRSP x
438 MO_FF_Conv W32 W64 -> conversionNop FF64 x
440 MO_FS_Conv from to -> coerceFP2Int from to x
441 MO_SF_Conv from to -> coerceInt2FP from to x
444 | from == to -> conversionNop (intSize to) x
446 -- narrowing is a nop: we treat the high bits as undefined
447 MO_SS_Conv W32 to -> conversionNop (intSize to) x
448 MO_SS_Conv W16 W8 -> conversionNop II8 x
449 MO_SS_Conv W8 to -> triv_ucode_int to (EXTS II8)
450 MO_SS_Conv W16 to -> triv_ucode_int to (EXTS II16)
453 | from == to -> conversionNop (intSize to) x
454 -- narrowing is a nop: we treat the high bits as undefined
455 MO_UU_Conv W32 to -> conversionNop (intSize to) x
456 MO_UU_Conv W16 W8 -> conversionNop II8 x
457 MO_UU_Conv W8 to -> trivialCode to False AND x (CmmLit (CmmInt 255 W32))
458 MO_UU_Conv W16 to -> trivialCode to False AND x (CmmLit (CmmInt 65535 W32))
459 _ -> panic "PPC.CodeGen.getRegister: no match"
462 triv_ucode_int width instr = trivialUCode (intSize width) instr x
463 triv_ucode_float width instr = trivialUCode (floatSize width) instr x
465 conversionNop new_size expr
466 = do e_code <- getRegister' dflags expr
467 return (swizzleRegisterRep e_code new_size)
469 getRegister' _ (CmmMachOp mop [x, y]) -- dyadic PrimOps
471 MO_F_Eq _ -> condFltReg EQQ x y
472 MO_F_Ne _ -> condFltReg NE x y
473 MO_F_Gt _ -> condFltReg GTT x y
474 MO_F_Ge _ -> condFltReg GE x y
475 MO_F_Lt _ -> condFltReg LTT x y
476 MO_F_Le _ -> condFltReg LE x y
478 MO_Eq rep -> condIntReg EQQ (extendUExpr rep x) (extendUExpr rep y)
479 MO_Ne rep -> condIntReg NE (extendUExpr rep x) (extendUExpr rep y)
481 MO_S_Gt rep -> condIntReg GTT (extendSExpr rep x) (extendSExpr rep y)
482 MO_S_Ge rep -> condIntReg GE (extendSExpr rep x) (extendSExpr rep y)
483 MO_S_Lt rep -> condIntReg LTT (extendSExpr rep x) (extendSExpr rep y)
484 MO_S_Le rep -> condIntReg LE (extendSExpr rep x) (extendSExpr rep y)
486 MO_U_Gt rep -> condIntReg GU (extendUExpr rep x) (extendUExpr rep y)
487 MO_U_Ge rep -> condIntReg GEU (extendUExpr rep x) (extendUExpr rep y)
488 MO_U_Lt rep -> condIntReg LU (extendUExpr rep x) (extendUExpr rep y)
489 MO_U_Le rep -> condIntReg LEU (extendUExpr rep x) (extendUExpr rep y)
491 MO_F_Add w -> triv_float w FADD
492 MO_F_Sub w -> triv_float w FSUB
493 MO_F_Mul w -> triv_float w FMUL
494 MO_F_Quot w -> triv_float w FDIV
496 -- optimize addition with 32-bit immediate
500 CmmLit (CmmInt imm immrep) | Just _ <- makeImmediate W32 True (-imm)
501 -> trivialCode W32 True ADD x (CmmLit $ CmmInt imm immrep)
504 (src, srcCode) <- getSomeReg x
505 let imm = litToImm lit
506 code dst = srcCode `appOL` toOL [
507 ADDIS dst src (HA imm),
508 ADD dst dst (RIImm (LO imm))
510 return (Any II32 code)
511 _ -> trivialCode W32 True ADD x y
513 MO_Add rep -> trivialCode rep True ADD x y
515 case y of -- subfi ('substract from' with immediate) doesn't exist
516 CmmLit (CmmInt imm immrep) | Just _ <- makeImmediate rep True (-imm)
517 -> trivialCode rep True ADD x (CmmLit $ CmmInt (-imm) immrep)
518 _ -> trivialCodeNoImm' (intSize rep) SUBF y x
520 MO_Mul rep -> trivialCode rep True MULLW x y
522 MO_S_MulMayOflo W32 -> trivialCodeNoImm' II32 MULLW_MayOflo x y
524 MO_S_MulMayOflo _ -> panic "S_MulMayOflo (rep /= II32): not implemented"
525 MO_U_MulMayOflo _ -> panic "U_MulMayOflo: not implemented"
527 MO_S_Quot rep -> trivialCodeNoImm' (intSize rep) DIVW (extendSExpr rep x) (extendSExpr rep y)
528 MO_U_Quot rep -> trivialCodeNoImm' (intSize rep) DIVWU (extendUExpr rep x) (extendUExpr rep y)
530 MO_S_Rem rep -> remainderCode rep DIVW (extendSExpr rep x) (extendSExpr rep y)
531 MO_U_Rem rep -> remainderCode rep DIVWU (extendUExpr rep x) (extendUExpr rep y)
533 MO_And rep -> trivialCode rep False AND x y
534 MO_Or rep -> trivialCode rep False OR x y
535 MO_Xor rep -> trivialCode rep False XOR x y
537 MO_Shl rep -> trivialCode rep False SLW x y
538 MO_S_Shr rep -> trivialCode rep False SRAW (extendSExpr rep x) y
539 MO_U_Shr rep -> trivialCode rep False SRW (extendUExpr rep x) y
540 _ -> panic "PPC.CodeGen.getRegister: no match"
543 triv_float :: Width -> (Size -> Reg -> Reg -> Reg -> Instr) -> NatM Register
544 triv_float width instr = trivialCodeNoImm (floatSize width) instr x y
546 getRegister' _ (CmmLit (CmmInt i rep))
547 | Just imm <- makeImmediate rep True i
549 code dst = unitOL (LI dst imm)
551 return (Any (intSize rep) code)
553 getRegister' _ (CmmLit (CmmFloat f frep)) = do
554 lbl <- getNewLabelNat
555 dflags <- getDynFlagsNat
556 dynRef <- cmmMakeDynamicReference dflags addImportNat DataReference lbl
557 Amode addr addr_code <- getAmode dynRef
558 let size = floatSize frep
560 LDATA ReadOnlyData [CmmDataLabel lbl,
561 CmmStaticLit (CmmFloat f frep)]
562 `consOL` (addr_code `snocOL` LD size dst addr)
563 return (Any size code)
565 getRegister' _ (CmmLit lit)
566 = let rep = cmmLitType lit
570 ADD dst dst (RIImm (LO imm))
572 in return (Any (cmmTypeSize rep) code)
574 getRegister' _ other = pprPanic "getRegister(ppc)" (pprExpr other)
576 -- extend?Rep: wrap integer expression of type rep
577 -- in a conversion to II32
578 extendSExpr :: Width -> CmmExpr -> CmmExpr
579 extendSExpr W32 x = x
580 extendSExpr rep x = CmmMachOp (MO_SS_Conv rep W32) [x]
582 extendUExpr :: Width -> CmmExpr -> CmmExpr
583 extendUExpr W32 x = x
584 extendUExpr rep x = CmmMachOp (MO_UU_Conv rep W32) [x]
586 -- -----------------------------------------------------------------------------
587 -- The 'Amode' type: Memory addressing modes passed up the tree.
590 = Amode AddrMode InstrBlock
593 Now, given a tree (the argument to an CmmLoad) that references memory,
594 produce a suitable addressing mode.
596 A Rule of the Game (tm) for Amodes: use of the addr bit must
597 immediately follow use of the code part, since the code part puts
598 values in registers which the addr then refers to. So you can't put
599 anything in between, lest it overwrite some of those registers. If
600 you need to do some other computation between the code part and use of
601 the addr bit, first store the effective address from the amode in a
602 temporary, then do the other computation, and then use the temporary:
606 ... other computation ...
610 getAmode :: CmmExpr -> NatM Amode
611 getAmode tree@(CmmRegOff _ _) = getAmode (mangleIndexTree tree)
613 getAmode (CmmMachOp (MO_Sub W32) [x, CmmLit (CmmInt i _)])
614 | Just off <- makeImmediate W32 True (-i)
616 (reg, code) <- getSomeReg x
617 return (Amode (AddrRegImm reg off) code)
620 getAmode (CmmMachOp (MO_Add W32) [x, CmmLit (CmmInt i _)])
621 | Just off <- makeImmediate W32 True i
623 (reg, code) <- getSomeReg x
624 return (Amode (AddrRegImm reg off) code)
626 -- optimize addition with 32-bit immediate
628 getAmode (CmmMachOp (MO_Add W32) [x, CmmLit lit])
630 tmp <- getNewRegNat II32
631 (src, srcCode) <- getSomeReg x
632 let imm = litToImm lit
633 code = srcCode `snocOL` ADDIS tmp src (HA imm)
634 return (Amode (AddrRegImm tmp (LO imm)) code)
636 getAmode (CmmLit lit)
638 tmp <- getNewRegNat II32
639 let imm = litToImm lit
640 code = unitOL (LIS tmp (HA imm))
641 return (Amode (AddrRegImm tmp (LO imm)) code)
643 getAmode (CmmMachOp (MO_Add W32) [x, y])
645 (regX, codeX) <- getSomeReg x
646 (regY, codeY) <- getSomeReg y
647 return (Amode (AddrRegReg regX regY) (codeX `appOL` codeY))
651 (reg, code) <- getSomeReg other
654 return (Amode (AddrRegImm reg off) code)
658 -- The 'CondCode' type: Condition codes passed up the tree.
660 = CondCode Bool Cond InstrBlock
662 -- Set up a condition code for a conditional branch.
664 getCondCode :: CmmExpr -> NatM CondCode
666 -- almost the same as everywhere else - but we need to
667 -- extend small integers to 32 bit first
669 getCondCode (CmmMachOp mop [x, y])
671 MO_F_Eq W32 -> condFltCode EQQ x y
672 MO_F_Ne W32 -> condFltCode NE x y
673 MO_F_Gt W32 -> condFltCode GTT x y
674 MO_F_Ge W32 -> condFltCode GE x y
675 MO_F_Lt W32 -> condFltCode LTT x y
676 MO_F_Le W32 -> condFltCode LE x y
678 MO_F_Eq W64 -> condFltCode EQQ x y
679 MO_F_Ne W64 -> condFltCode NE x y
680 MO_F_Gt W64 -> condFltCode GTT x y
681 MO_F_Ge W64 -> condFltCode GE x y
682 MO_F_Lt W64 -> condFltCode LTT x y
683 MO_F_Le W64 -> condFltCode LE x y
685 MO_Eq rep -> condIntCode EQQ (extendUExpr rep x) (extendUExpr rep y)
686 MO_Ne rep -> condIntCode NE (extendUExpr rep x) (extendUExpr rep y)
688 MO_S_Gt rep -> condIntCode GTT (extendSExpr rep x) (extendSExpr rep y)
689 MO_S_Ge rep -> condIntCode GE (extendSExpr rep x) (extendSExpr rep y)
690 MO_S_Lt rep -> condIntCode LTT (extendSExpr rep x) (extendSExpr rep y)
691 MO_S_Le rep -> condIntCode LE (extendSExpr rep x) (extendSExpr rep y)
693 MO_U_Gt rep -> condIntCode GU (extendUExpr rep x) (extendUExpr rep y)
694 MO_U_Ge rep -> condIntCode GEU (extendUExpr rep x) (extendUExpr rep y)
695 MO_U_Lt rep -> condIntCode LU (extendUExpr rep x) (extendUExpr rep y)
696 MO_U_Le rep -> condIntCode LEU (extendUExpr rep x) (extendUExpr rep y)
698 _ -> pprPanic "getCondCode(powerpc)" (pprMachOp mop)
700 getCondCode _ = panic "getCondCode(2)(powerpc)"
704 -- @cond(Int|Flt)Code@: Turn a boolean expression into a condition, to be
705 -- passed back up the tree.
707 condIntCode, condFltCode :: Cond -> CmmExpr -> CmmExpr -> NatM CondCode
709 -- ###FIXME: I16 and I8!
710 condIntCode cond x (CmmLit (CmmInt y rep))
711 | Just src2 <- makeImmediate rep (not $ condUnsigned cond) y
713 (src1, code) <- getSomeReg x
715 code' = code `snocOL`
716 (if condUnsigned cond then CMPL else CMP) II32 src1 (RIImm src2)
717 return (CondCode False cond code')
719 condIntCode cond x y = do
720 (src1, code1) <- getSomeReg x
721 (src2, code2) <- getSomeReg y
723 code' = code1 `appOL` code2 `snocOL`
724 (if condUnsigned cond then CMPL else CMP) II32 src1 (RIReg src2)
725 return (CondCode False cond code')
727 condFltCode cond x y = do
728 (src1, code1) <- getSomeReg x
729 (src2, code2) <- getSomeReg y
731 code' = code1 `appOL` code2 `snocOL` FCMP src1 src2
732 code'' = case cond of -- twiddle CR to handle unordered case
733 GE -> code' `snocOL` CRNOR ltbit eqbit gtbit
734 LE -> code' `snocOL` CRNOR gtbit eqbit ltbit
737 ltbit = 0 ; eqbit = 2 ; gtbit = 1
738 return (CondCode True cond code'')
742 -- -----------------------------------------------------------------------------
743 -- Generating assignments
745 -- Assignments are really at the heart of the whole code generation
746 -- business. Almost all top-level nodes of any real importance are
747 -- assignments, which correspond to loads, stores, or register
748 -- transfers. If we're really lucky, some of the register transfers
749 -- will go away, because we can use the destination register to
750 -- complete the code generation for the right hand side. This only
751 -- fails when the right hand side is forced into a fixed register
752 -- (e.g. the result of a call).
754 assignMem_IntCode :: Size -> CmmExpr -> CmmExpr -> NatM InstrBlock
755 assignReg_IntCode :: Size -> CmmReg -> CmmExpr -> NatM InstrBlock
757 assignMem_FltCode :: Size -> CmmExpr -> CmmExpr -> NatM InstrBlock
758 assignReg_FltCode :: Size -> CmmReg -> CmmExpr -> NatM InstrBlock
760 assignMem_IntCode pk addr src = do
761 (srcReg, code) <- getSomeReg src
762 Amode dstAddr addr_code <- getAmode addr
763 return $ code `appOL` addr_code `snocOL` ST pk srcReg dstAddr
765 -- dst is a reg, but src could be anything
766 assignReg_IntCode _ reg src
770 Any _ code -> code dst
771 Fixed _ freg fcode -> fcode `snocOL` MR dst freg
773 dst = getRegisterReg reg
778 assignMem_FltCode = assignMem_IntCode
779 assignReg_FltCode = assignReg_IntCode
783 genJump :: CmmExpr{-the branch target-} -> NatM InstrBlock
785 genJump (CmmLit (CmmLabel lbl))
786 = return (unitOL $ JMP lbl)
790 (target,code) <- getSomeReg tree
791 return (code `snocOL` MTCTR target `snocOL` BCTR [] Nothing)
794 -- -----------------------------------------------------------------------------
795 -- Unconditional branches
796 genBranch :: BlockId -> NatM InstrBlock
797 genBranch = return . toOL . mkJumpInstr
800 -- -----------------------------------------------------------------------------
804 Conditional jumps are always to local labels, so we can use branch
805 instructions. We peek at the arguments to decide what kind of
808 SPARC: First, we have to ensure that the condition codes are set
809 according to the supplied comparison operation. We generate slightly
810 different code for floating point comparisons, because a floating
811 point operation cannot directly precede a @BF@. We assume the worst
812 and fill that slot with a @NOP@.
814 SPARC: Do not fill the delay slots here; you will confuse the register
820 :: BlockId -- the branch target
821 -> CmmExpr -- the condition on which to branch
824 genCondJump id bool = do
825 CondCode _ cond code <- getCondCode bool
826 return (code `snocOL` BCC cond id)
830 -- -----------------------------------------------------------------------------
831 -- Generating C calls
833 -- Now the biggest nightmare---calls. Most of the nastiness is buried in
834 -- @get_arg@, which moves the arguments to the correct registers/stack
835 -- locations. Apart from that, the code is easy.
837 -- (If applicable) Do not fill the delay slots here; you will confuse the
838 -- register allocator.
840 genCCall :: CmmCallTarget -- function to call
841 -> [HintedCmmFormal] -- where to put the result
842 -> [HintedCmmActual] -- arguments (of mixed type)
844 genCCall target dest_regs argsAndHints
845 = do dflags <- getDynFlagsNat
846 case platformOS (targetPlatform dflags) of
847 OSLinux -> genCCall' GCPLinux target dest_regs argsAndHints
848 OSDarwin -> genCCall' GCPDarwin target dest_regs argsAndHints
849 OSSolaris2 -> panic "PPC.CodeGen.genCCall: not defined for this os"
850 OSMinGW32 -> panic "PPC.CodeGen.genCCall: not defined for this os"
851 OSFreeBSD -> panic "PPC.CodeGen.genCCall: not defined for this os"
852 OSOpenBSD -> panic "PPC.CodeGen.genCCall: not defined for this os"
853 OSUnknown -> panic "PPC.CodeGen.genCCall: not defined for this os"
855 data GenCCallPlatform = GCPLinux | GCPDarwin
859 -> CmmCallTarget -- function to call
860 -> [HintedCmmFormal] -- where to put the result
861 -> [HintedCmmActual] -- arguments (of mixed type)
865 The PowerPC calling convention for Darwin/Mac OS X
866 is described in Apple's document
867 "Inside Mac OS X - Mach-O Runtime Architecture".
869 PowerPC Linux uses the System V Release 4 Calling Convention
870 for PowerPC. It is described in the
871 "System V Application Binary Interface PowerPC Processor Supplement".
873 Both conventions are similar:
874 Parameters may be passed in general-purpose registers starting at r3, in
875 floating point registers starting at f1, or on the stack.
877 But there are substantial differences:
878 * The number of registers used for parameter passing and the exact set of
879 nonvolatile registers differs (see MachRegs.lhs).
880 * On Darwin, stack space is always reserved for parameters, even if they are
881 passed in registers. The called routine may choose to save parameters from
882 registers to the corresponding space on the stack.
883 * On Darwin, a corresponding amount of GPRs is skipped when a floating point
884 parameter is passed in an FPR.
885 * SysV insists on either passing I64 arguments on the stack, or in two GPRs,
886 starting with an odd-numbered GPR. It may skip a GPR to achieve this.
887 Darwin just treats an I64 like two separate II32s (high word first).
888 * I64 and FF64 arguments are 8-byte aligned on the stack for SysV, but only
889 4-byte aligned like everything else on Darwin.
890 * The SysV spec claims that FF32 is represented as FF64 on the stack. GCC on
891 PowerPC Linux does not agree, so neither do we.
893 According to both conventions, The parameter area should be part of the
894 caller's stack frame, allocated in the caller's prologue code (large enough
895 to hold the parameter lists for all called routines). The NCG already
896 uses the stack for register spilling, leaving 64 bytes free at the top.
897 If we need a larger parameter area than that, we just allocate a new stack
898 frame just before ccalling.
902 genCCall' _ (CmmPrim MO_WriteBarrier) _ _
903 = return $ unitOL LWSYNC
905 genCCall' gcp target dest_regs argsAndHints
906 = ASSERT (not $ any (`elem` [II8,II16]) $ map cmmTypeSize argReps)
907 -- we rely on argument promotion in the codeGen
909 (finalStack,passArgumentsCode,usedRegs) <- passArguments
911 allArgRegs allFPArgRegs
915 (labelOrExpr, reduceToFF32) <- case target of
916 CmmCallee (CmmLit (CmmLabel lbl)) _ -> return (Left lbl, False)
917 CmmCallee expr _ -> return (Right expr, False)
918 CmmPrim mop -> outOfLineMachOp mop
920 let codeBefore = move_sp_down finalStack `appOL` passArgumentsCode
921 codeAfter = move_sp_up finalStack `appOL` moveResult reduceToFF32
926 `snocOL` BL lbl usedRegs
929 (dynReg, dynCode) <- getSomeReg dyn
931 `snocOL` MTCTR dynReg
933 `snocOL` BCTRL usedRegs
936 initialStackOffset = case gcp of
939 -- size of linkage area + size of arguments, in bytes
940 stackDelta finalStack = case gcp of
942 roundTo 16 $ (24 +) $ max 32 $ sum $
943 map (widthInBytes . typeWidth) argReps
944 GCPLinux -> roundTo 16 finalStack
946 -- need to remove alignment information
947 argsAndHints' | (CmmPrim mop) <- target,
956 args = map hintlessCmm argsAndHints'
957 argReps = map cmmExprType args
959 roundTo a x | x `mod` a == 0 = x
960 | otherwise = x + a - (x `mod` a)
962 move_sp_down finalStack
964 toOL [STU II32 sp (AddrRegImm sp (ImmInt (-delta))),
967 where delta = stackDelta finalStack
968 move_sp_up finalStack
970 toOL [ADD sp sp (RIImm (ImmInt delta)),
973 where delta = stackDelta finalStack
976 passArguments [] _ _ stackOffset accumCode accumUsed = return (stackOffset, accumCode, accumUsed)
977 passArguments ((arg,arg_ty):args) gprs fprs stackOffset
978 accumCode accumUsed | isWord64 arg_ty =
980 ChildCode64 code vr_lo <- iselExpr64 arg
981 let vr_hi = getHiVRegFromLo vr_lo
985 do let storeWord vr (gpr:_) _ = MR gpr vr
986 storeWord vr [] offset
987 = ST II32 vr (AddrRegImm sp (ImmInt offset))
992 (accumCode `appOL` code
993 `snocOL` storeWord vr_hi gprs stackOffset
994 `snocOL` storeWord vr_lo (drop 1 gprs) (stackOffset+4))
995 ((take 2 gprs) ++ accumUsed)
997 do let stackOffset' = roundTo 8 stackOffset
998 stackCode = accumCode `appOL` code
999 `snocOL` ST II32 vr_hi (AddrRegImm sp (ImmInt stackOffset'))
1000 `snocOL` ST II32 vr_lo (AddrRegImm sp (ImmInt (stackOffset'+4)))
1001 regCode hireg loreg =
1002 accumCode `appOL` code
1003 `snocOL` MR hireg vr_hi
1004 `snocOL` MR loreg vr_lo
1007 hireg : loreg : regs | even (length gprs) ->
1008 passArguments args regs fprs stackOffset
1009 (regCode hireg loreg) (hireg : loreg : accumUsed)
1010 _skipped : hireg : loreg : regs ->
1011 passArguments args regs fprs stackOffset
1012 (regCode hireg loreg) (hireg : loreg : accumUsed)
1013 _ -> -- only one or no regs left
1014 passArguments args [] fprs (stackOffset'+8)
1017 passArguments ((arg,rep):args) gprs fprs stackOffset accumCode accumUsed
1018 | reg : _ <- regs = do
1019 register <- getRegister arg
1020 let code = case register of
1021 Fixed _ freg fcode -> fcode `snocOL` MR reg freg
1022 Any _ acode -> acode reg
1023 stackOffsetRes = case gcp of
1024 -- The Darwin ABI requires that we reserve
1025 -- stack slots for register parameters
1026 GCPDarwin -> stackOffset + stackBytes
1027 -- ... the SysV ABI doesn't.
1028 GCPLinux -> stackOffset
1033 (accumCode `appOL` code)
1036 (vr, code) <- getSomeReg arg
1040 (stackOffset' + stackBytes)
1041 (accumCode `appOL` code `snocOL` ST (cmmTypeSize rep) vr stackSlot)
1044 stackOffset' = case gcp of
1046 -- stackOffset is at least 4-byte aligned
1047 -- The Darwin ABI is happy with that.
1050 -- ... the SysV ABI requires 8-byte
1051 -- alignment for doubles.
1052 | isFloatType rep && typeWidth rep == W64 ->
1053 roundTo 8 stackOffset
1056 stackSlot = AddrRegImm sp (ImmInt stackOffset')
1057 (nGprs, nFprs, stackBytes, regs)
1060 case cmmTypeSize rep of
1061 II32 -> (1, 0, 4, gprs)
1062 -- The Darwin ABI requires that we skip a
1063 -- corresponding number of GPRs when we use
1065 FF32 -> (1, 1, 4, fprs)
1066 FF64 -> (2, 1, 8, fprs)
1067 II8 -> panic "genCCall' passArguments II8"
1068 II16 -> panic "genCCall' passArguments II16"
1069 II64 -> panic "genCCall' passArguments II64"
1070 FF80 -> panic "genCCall' passArguments FF80"
1072 case cmmTypeSize rep of
1073 II32 -> (1, 0, 4, gprs)
1074 -- ... the SysV ABI doesn't.
1075 FF32 -> (0, 1, 4, fprs)
1076 FF64 -> (0, 1, 8, fprs)
1077 II8 -> panic "genCCall' passArguments II8"
1078 II16 -> panic "genCCall' passArguments II16"
1079 II64 -> panic "genCCall' passArguments II64"
1080 FF80 -> panic "genCCall' passArguments FF80"
1082 moveResult reduceToFF32 =
1085 [CmmHinted dest _hint]
1086 | reduceToFF32 && isFloat32 rep -> unitOL (FRSP r_dest f1)
1087 | isFloat32 rep || isFloat64 rep -> unitOL (MR r_dest f1)
1088 | isWord64 rep -> toOL [MR (getHiVRegFromLo r_dest) r3,
1090 | otherwise -> unitOL (MR r_dest r3)
1091 where rep = cmmRegType (CmmLocal dest)
1092 r_dest = getRegisterReg (CmmLocal dest)
1093 _ -> panic "genCCall' moveResult: Bad dest_regs"
1095 outOfLineMachOp mop =
1097 dflags <- getDynFlagsNat
1098 mopExpr <- cmmMakeDynamicReference dflags addImportNat CallReference $
1099 mkForeignLabel functionName Nothing ForeignLabelInThisPackage IsFunction
1100 let mopLabelOrExpr = case mopExpr of
1101 CmmLit (CmmLabel lbl) -> Left lbl
1103 return (mopLabelOrExpr, reduce)
1105 (functionName, reduce) = case mop of
1106 MO_F32_Exp -> (fsLit "exp", True)
1107 MO_F32_Log -> (fsLit "log", True)
1108 MO_F32_Sqrt -> (fsLit "sqrt", True)
1110 MO_F32_Sin -> (fsLit "sin", True)
1111 MO_F32_Cos -> (fsLit "cos", True)
1112 MO_F32_Tan -> (fsLit "tan", True)
1114 MO_F32_Asin -> (fsLit "asin", True)
1115 MO_F32_Acos -> (fsLit "acos", True)
1116 MO_F32_Atan -> (fsLit "atan", True)
1118 MO_F32_Sinh -> (fsLit "sinh", True)
1119 MO_F32_Cosh -> (fsLit "cosh", True)
1120 MO_F32_Tanh -> (fsLit "tanh", True)
1121 MO_F32_Pwr -> (fsLit "pow", True)
1123 MO_F64_Exp -> (fsLit "exp", False)
1124 MO_F64_Log -> (fsLit "log", False)
1125 MO_F64_Sqrt -> (fsLit "sqrt", False)
1127 MO_F64_Sin -> (fsLit "sin", False)
1128 MO_F64_Cos -> (fsLit "cos", False)
1129 MO_F64_Tan -> (fsLit "tan", False)
1131 MO_F64_Asin -> (fsLit "asin", False)
1132 MO_F64_Acos -> (fsLit "acos", False)
1133 MO_F64_Atan -> (fsLit "atan", False)
1135 MO_F64_Sinh -> (fsLit "sinh", False)
1136 MO_F64_Cosh -> (fsLit "cosh", False)
1137 MO_F64_Tanh -> (fsLit "tanh", False)
1138 MO_F64_Pwr -> (fsLit "pow", False)
1140 MO_Memcpy -> (fsLit "memcpy", False)
1141 MO_Memset -> (fsLit "memset", False)
1142 MO_Memmove -> (fsLit "memmove", False)
1144 other -> pprPanic "genCCall(ppc): unknown callish op"
1145 (pprCallishMachOp other)
1148 -- -----------------------------------------------------------------------------
1149 -- Generating a table-branch
1151 genSwitch :: CmmExpr -> [Maybe BlockId] -> NatM InstrBlock
1155 (reg,e_code) <- getSomeReg expr
1156 tmp <- getNewRegNat II32
1157 lbl <- getNewLabelNat
1158 dflags <- getDynFlagsNat
1159 dynRef <- cmmMakeDynamicReference dflags addImportNat DataReference lbl
1160 (tableReg,t_code) <- getSomeReg $ dynRef
1161 let code = e_code `appOL` t_code `appOL` toOL [
1162 SLW tmp reg (RIImm (ImmInt 2)),
1163 LD II32 tmp (AddrRegReg tableReg tmp),
1164 ADD tmp tmp (RIReg tableReg),
1171 (reg,e_code) <- getSomeReg expr
1172 tmp <- getNewRegNat II32
1173 lbl <- getNewLabelNat
1174 let code = e_code `appOL` toOL [
1175 SLW tmp reg (RIImm (ImmInt 2)),
1176 ADDIS tmp tmp (HA (ImmCLbl lbl)),
1177 LD II32 tmp (AddrRegImm tmp (LO (ImmCLbl lbl))),
1183 generateJumpTableForInstr :: Instr -> Maybe (NatCmmTop Instr)
1184 generateJumpTableForInstr (BCTR ids (Just lbl)) =
1186 | opt_PIC = map jumpTableEntryRel ids
1187 | otherwise = map jumpTableEntry ids
1188 where jumpTableEntryRel Nothing
1189 = CmmStaticLit (CmmInt 0 wordWidth)
1190 jumpTableEntryRel (Just blockid)
1191 = CmmStaticLit (CmmLabelDiffOff blockLabel lbl 0)
1192 where blockLabel = mkAsmTempLabel (getUnique blockid)
1193 in Just (CmmData ReadOnlyData (CmmDataLabel lbl : jumpTable))
1194 generateJumpTableForInstr _ = Nothing
1196 -- -----------------------------------------------------------------------------
1197 -- 'condIntReg' and 'condFltReg': condition codes into registers
1199 -- Turn those condition codes into integers now (when they appear on
1200 -- the right hand side of an assignment).
1202 -- (If applicable) Do not fill the delay slots here; you will confuse the
1203 -- register allocator.
1205 condIntReg, condFltReg :: Cond -> CmmExpr -> CmmExpr -> NatM Register
1207 condReg :: NatM CondCode -> NatM Register
1208 condReg getCond = do
1209 CondCode _ cond cond_code <- getCond
1211 {- code dst = cond_code `appOL` toOL [
1220 code dst = cond_code
1224 RLWINM dst dst (bit + 1) 31 31
1227 negate_code | do_negate = unitOL (CRNOR bit bit bit)
1230 (bit, do_negate) = case cond of
1243 _ -> panic "PPC.CodeGen.codeReg: no match"
1245 return (Any II32 code)
1247 condIntReg cond x y = condReg (condIntCode cond x y)
1248 condFltReg cond x y = condReg (condFltCode cond x y)
1252 -- -----------------------------------------------------------------------------
1253 -- 'trivial*Code': deal with trivial instructions
1255 -- Trivial (dyadic: 'trivialCode', floating-point: 'trivialFCode',
1256 -- unary: 'trivialUCode', unary fl-pt:'trivialUFCode') instructions.
1257 -- Only look for constants on the right hand side, because that's
1258 -- where the generic optimizer will have put them.
1260 -- Similarly, for unary instructions, we don't have to worry about
1261 -- matching an StInt as the argument, because genericOpt will already
1262 -- have handled the constant-folding.
1267 Wolfgang's PowerPC version of The Rules:
1269 A slightly modified version of The Rules to take advantage of the fact
1270 that PowerPC instructions work on all registers and don't implicitly
1271 clobber any fixed registers.
1273 * The only expression for which getRegister returns Fixed is (CmmReg reg).
1275 * If getRegister returns Any, then the code it generates may modify only:
1276 (a) fresh temporaries
1277 (b) the destination register
1278 It may *not* modify global registers, unless the global
1279 register happens to be the destination register.
1280 It may not clobber any other registers. In fact, only ccalls clobber any
1282 Also, it may not modify the counter register (used by genCCall).
1284 Corollary: If a getRegister for a subexpression returns Fixed, you need
1285 not move it to a fresh temporary before evaluating the next subexpression.
1286 The Fixed register won't be modified.
1287 Therefore, we don't need a counterpart for the x86's getStableReg on PPC.
1289 * SDM's First Rule is valid for PowerPC, too: subexpressions can depend on
1290 the value of the destination register.
1296 -> (Reg -> Reg -> RI -> Instr)
1301 trivialCode rep signed instr x (CmmLit (CmmInt y _))
1302 | Just imm <- makeImmediate rep signed y
1304 (src1, code1) <- getSomeReg x
1305 let code dst = code1 `snocOL` instr dst src1 (RIImm imm)
1306 return (Any (intSize rep) code)
1308 trivialCode rep _ instr x y = do
1309 (src1, code1) <- getSomeReg x
1310 (src2, code2) <- getSomeReg y
1311 let code dst = code1 `appOL` code2 `snocOL` instr dst src1 (RIReg src2)
1312 return (Any (intSize rep) code)
1314 trivialCodeNoImm' :: Size -> (Reg -> Reg -> Reg -> Instr)
1315 -> CmmExpr -> CmmExpr -> NatM Register
1316 trivialCodeNoImm' size instr x y = do
1317 (src1, code1) <- getSomeReg x
1318 (src2, code2) <- getSomeReg y
1319 let code dst = code1 `appOL` code2 `snocOL` instr dst src1 src2
1320 return (Any size code)
1322 trivialCodeNoImm :: Size -> (Size -> Reg -> Reg -> Reg -> Instr)
1323 -> CmmExpr -> CmmExpr -> NatM Register
1324 trivialCodeNoImm size instr x y = trivialCodeNoImm' size (instr size) x y
1329 -> (Reg -> Reg -> Instr)
1332 trivialUCode rep instr x = do
1333 (src, code) <- getSomeReg x
1334 let code' dst = code `snocOL` instr dst src
1335 return (Any rep code')
1337 -- There is no "remainder" instruction on the PPC, so we have to do
1339 -- The "div" parameter is the division instruction to use (DIVW or DIVWU)
1341 remainderCode :: Width -> (Reg -> Reg -> Reg -> Instr)
1342 -> CmmExpr -> CmmExpr -> NatM Register
1343 remainderCode rep div x y = do
1344 (src1, code1) <- getSomeReg x
1345 (src2, code2) <- getSomeReg y
1346 let code dst = code1 `appOL` code2 `appOL` toOL [
1348 MULLW dst dst (RIReg src2),
1351 return (Any (intSize rep) code)
1354 coerceInt2FP :: Width -> Width -> CmmExpr -> NatM Register
1355 coerceInt2FP fromRep toRep x = do
1356 (src, code) <- getSomeReg x
1357 lbl <- getNewLabelNat
1358 itmp <- getNewRegNat II32
1359 ftmp <- getNewRegNat FF64
1360 dflags <- getDynFlagsNat
1361 dynRef <- cmmMakeDynamicReference dflags addImportNat DataReference lbl
1362 Amode addr addr_code <- getAmode dynRef
1364 code' dst = code `appOL` maybe_exts `appOL` toOL [
1367 CmmStaticLit (CmmInt 0x43300000 W32),
1368 CmmStaticLit (CmmInt 0x80000000 W32)],
1369 XORIS itmp src (ImmInt 0x8000),
1370 ST II32 itmp (spRel 3),
1371 LIS itmp (ImmInt 0x4330),
1372 ST II32 itmp (spRel 2),
1373 LD FF64 ftmp (spRel 2)
1374 ] `appOL` addr_code `appOL` toOL [
1376 FSUB FF64 dst ftmp dst
1377 ] `appOL` maybe_frsp dst
1379 maybe_exts = case fromRep of
1380 W8 -> unitOL $ EXTS II8 src src
1381 W16 -> unitOL $ EXTS II16 src src
1383 _ -> panic "PPC.CodeGen.coerceInt2FP: no match"
1387 W32 -> unitOL $ FRSP dst dst
1389 _ -> panic "PPC.CodeGen.coerceInt2FP: no match"
1391 return (Any (floatSize toRep) code')
1393 coerceFP2Int :: Width -> Width -> CmmExpr -> NatM Register
1394 coerceFP2Int _ toRep x = do
1395 -- the reps don't really matter: F*->FF64 and II32->I* are no-ops
1396 (src, code) <- getSomeReg x
1397 tmp <- getNewRegNat FF64
1399 code' dst = code `appOL` toOL [
1400 -- convert to int in FP reg
1402 -- store value (64bit) from FP to stack
1403 ST FF64 tmp (spRel 2),
1404 -- read low word of value (high word is undefined)
1405 LD II32 dst (spRel 3)]
1406 return (Any (intSize toRep) code')