3 -----------------------------------------------------------------------------
5 -- Generating machine code (instruction selection)
7 -- (c) The University of Glasgow 1996-2004
9 -----------------------------------------------------------------------------
11 -- This is a big module, but, if you pay attention to
12 -- (a) the sectioning, (b) the type signatures, and
13 -- (c) the #if blah_TARGET_ARCH} things, the
14 -- structure should not be too overwhelming.
18 generateJumpTableForInstr,
24 #include "HsVersions.h"
25 #include "nativeGen/NCG.h"
26 #include "../includes/MachDeps.h"
42 -- Our intermediate code:
44 import PprCmm ( pprExpr )
49 import StaticFlags ( opt_PIC )
51 import qualified Outputable as O
56 import Control.Monad ( mapAndUnzipM )
61 #if darwin_TARGET_OS || linux_TARGET_OS
66 -- -----------------------------------------------------------------------------
67 -- Top-level of the instruction selector
69 -- | 'InstrBlock's are the insn sequences generated by the insn selectors.
70 -- They are really trees of insns to facilitate fast appending, where a
71 -- left-to-right traversal (pre-order?) yields the insns in the correct
77 -> NatM [NatCmmTop Instr]
79 cmmTopCodeGen dflags (CmmProc info lab (ListGraph blocks)) = do
80 (nat_blocks,statics) <- mapAndUnzipM basicBlockCodeGen blocks
81 picBaseMb <- getPicBaseMaybeNat
82 let proc = CmmProc info lab (ListGraph $ concat nat_blocks)
83 tops = proc : concat statics
84 os = platformOS $ targetPlatform dflags
86 Just picBase -> initializePicBase_ppc ArchPPC os picBase tops
87 Nothing -> return tops
89 cmmTopCodeGen dflags (CmmData sec dat) = do
90 return [CmmData sec dat] -- no translation, we just use CmmStatic
94 -> NatM ( [NatBasicBlock Instr]
97 basicBlockCodeGen (BasicBlock id stmts) = do
98 instrs <- stmtsToInstrs stmts
99 -- code generation may introduce new basic block boundaries, which
100 -- are indicated by the NEWBLOCK instruction. We must split up the
101 -- instruction stream into basic blocks again. Also, we extract
104 (top,other_blocks,statics) = foldrOL mkBlocks ([],[],[]) instrs
106 mkBlocks (NEWBLOCK id) (instrs,blocks,statics)
107 = ([], BasicBlock id instrs : blocks, statics)
108 mkBlocks (LDATA sec dat) (instrs,blocks,statics)
109 = (instrs, blocks, CmmData sec dat:statics)
110 mkBlocks instr (instrs,blocks,statics)
111 = (instr:instrs, blocks, statics)
113 return (BasicBlock id top : other_blocks, statics)
115 stmtsToInstrs :: [CmmStmt] -> NatM InstrBlock
117 = do instrss <- mapM stmtToInstrs stmts
118 return (concatOL instrss)
120 stmtToInstrs :: CmmStmt -> NatM InstrBlock
121 stmtToInstrs stmt = case stmt of
122 CmmNop -> return nilOL
123 CmmComment s -> return (unitOL (COMMENT s))
126 | isFloatType ty -> assignReg_FltCode size reg src
127 #if WORD_SIZE_IN_BITS==32
128 | isWord64 ty -> assignReg_I64Code reg src
130 | otherwise -> assignReg_IntCode size reg src
131 where ty = cmmRegType reg
132 size = cmmTypeSize ty
135 | isFloatType ty -> assignMem_FltCode size addr src
136 #if WORD_SIZE_IN_BITS==32
137 | isWord64 ty -> assignMem_I64Code addr src
139 | otherwise -> assignMem_IntCode size addr src
140 where ty = cmmExprType src
141 size = cmmTypeSize ty
143 CmmCall target result_regs args _ _
144 -> genCCall target result_regs args
146 CmmBranch id -> genBranch id
147 CmmCondBranch arg id -> genCondJump id arg
148 CmmSwitch arg ids -> genSwitch arg ids
149 CmmJump arg params -> genJump arg
151 panic "stmtToInstrs: return statement should have been cps'd away"
154 --------------------------------------------------------------------------------
155 -- | 'InstrBlock's are the insn sequences generated by the insn selectors.
156 -- They are really trees of insns to facilitate fast appending, where a
157 -- left-to-right traversal yields the insns in the correct order.
163 -- | Register's passed up the tree. If the stix code forces the register
164 -- to live in a pre-decided machine register, it comes out as @Fixed@;
165 -- otherwise, it comes out as @Any@, and the parent can decide which
166 -- register to put it in.
169 = Fixed Size Reg InstrBlock
170 | Any Size (Reg -> InstrBlock)
173 swizzleRegisterRep :: Register -> Size -> Register
174 swizzleRegisterRep (Fixed _ reg code) size = Fixed size reg code
175 swizzleRegisterRep (Any _ codefn) size = Any size codefn
178 -- | Grab the Reg for a CmmReg
179 getRegisterReg :: CmmReg -> Reg
181 getRegisterReg (CmmLocal (LocalReg u pk))
182 = RegVirtual $ mkVirtualReg u (cmmTypeSize pk)
184 getRegisterReg (CmmGlobal mid)
185 = case globalRegMaybe mid of
187 Nothing -> pprPanic "getRegisterReg-memory" (ppr $ CmmGlobal mid)
188 -- By this stage, the only MagicIds remaining should be the
189 -- ones which map to a real machine register on this
190 -- platform. Hence ...
194 Now, given a tree (the argument to an CmmLoad) that references memory,
195 produce a suitable addressing mode.
197 A Rule of the Game (tm) for Amodes: use of the addr bit must
198 immediately follow use of the code part, since the code part puts
199 values in registers which the addr then refers to. So you can't put
200 anything in between, lest it overwrite some of those registers. If
201 you need to do some other computation between the code part and use of
202 the addr bit, first store the effective address from the amode in a
203 temporary, then do the other computation, and then use the temporary:
207 ... other computation ...
212 -- | Check whether an integer will fit in 32 bits.
213 -- A CmmInt is intended to be truncated to the appropriate
214 -- number of bits, so here we truncate it to Int64. This is
215 -- important because e.g. -1 as a CmmInt might be either
216 -- -1 or 18446744073709551615.
218 is32BitInteger :: Integer -> Bool
219 is32BitInteger i = i64 <= 0x7fffffff && i64 >= -0x80000000
220 where i64 = fromIntegral i :: Int64
223 -- | Convert a BlockId to some CmmStatic data
224 jumpTableEntry :: Maybe BlockId -> CmmStatic
225 jumpTableEntry Nothing = CmmStaticLit (CmmInt 0 wordWidth)
226 jumpTableEntry (Just blockid) = CmmStaticLit (CmmLabel blockLabel)
227 where blockLabel = mkAsmTempLabel (getUnique blockid)
231 -- -----------------------------------------------------------------------------
232 -- General things for putting together code sequences
234 -- Expand CmmRegOff. ToDo: should we do it this way around, or convert
235 -- CmmExprs into CmmRegOff?
236 mangleIndexTree :: CmmExpr -> CmmExpr
237 mangleIndexTree (CmmRegOff reg off)
238 = CmmMachOp (MO_Add width) [CmmReg reg, CmmLit (CmmInt (fromIntegral off) width)]
239 where width = typeWidth (cmmRegType reg)
242 = panic "PPC.CodeGen.mangleIndexTree: no match"
244 -- -----------------------------------------------------------------------------
245 -- Code gen for 64-bit arithmetic on 32-bit platforms
248 Simple support for generating 64-bit code (ie, 64 bit values and 64
249 bit assignments) on 32-bit platforms. Unlike the main code generator
250 we merely shoot for generating working code as simply as possible, and
251 pay little attention to code quality. Specifically, there is no
252 attempt to deal cleverly with the fixed-vs-floating register
253 distinction; all values are generated into (pairs of) floating
254 registers, even if this would mean some redundant reg-reg moves as a
255 result. Only one of the VRegUniques is returned, since it will be
256 of the VRegUniqueLo form, and the upper-half VReg can be determined
257 by applying getHiVRegFromLo to it.
260 data ChildCode64 -- a.k.a "Register64"
263 Reg -- the lower 32-bit temporary which contains the
264 -- result; use getHiVRegFromLo to find the other
265 -- VRegUnique. Rules of this simplified insn
266 -- selection game are therefore that the returned
267 -- Reg may be modified
270 -- | The dual to getAnyReg: compute an expression into a register, but
271 -- we don't mind which one it is.
272 getSomeReg :: CmmExpr -> NatM (Reg, InstrBlock)
274 r <- getRegister expr
277 tmp <- getNewRegNat rep
278 return (tmp, code tmp)
282 getI64Amodes :: CmmExpr -> NatM (AddrMode, AddrMode, InstrBlock)
283 getI64Amodes addrTree = do
284 Amode hi_addr addr_code <- getAmode addrTree
285 case addrOffset hi_addr 4 of
286 Just lo_addr -> return (hi_addr, lo_addr, addr_code)
287 Nothing -> do (hi_ptr, code) <- getSomeReg addrTree
288 return (AddrRegImm hi_ptr (ImmInt 0),
289 AddrRegImm hi_ptr (ImmInt 4),
293 assignMem_I64Code :: CmmExpr -> CmmExpr -> NatM InstrBlock
294 assignMem_I64Code addrTree valueTree = do
295 (hi_addr, lo_addr, addr_code) <- getI64Amodes addrTree
296 ChildCode64 vcode rlo <- iselExpr64 valueTree
298 rhi = getHiVRegFromLo rlo
301 mov_hi = ST II32 rhi hi_addr
302 mov_lo = ST II32 rlo lo_addr
304 return (vcode `appOL` addr_code `snocOL` mov_lo `snocOL` mov_hi)
307 assignReg_I64Code :: CmmReg -> CmmExpr -> NatM InstrBlock
308 assignReg_I64Code (CmmLocal (LocalReg u_dst pk)) valueTree = do
309 ChildCode64 vcode r_src_lo <- iselExpr64 valueTree
311 r_dst_lo = RegVirtual $ mkVirtualReg u_dst II32
312 r_dst_hi = getHiVRegFromLo r_dst_lo
313 r_src_hi = getHiVRegFromLo r_src_lo
314 mov_lo = MR r_dst_lo r_src_lo
315 mov_hi = MR r_dst_hi r_src_hi
318 vcode `snocOL` mov_lo `snocOL` mov_hi
321 assignReg_I64Code lvalue valueTree
322 = panic "assignReg_I64Code(powerpc): invalid lvalue"
325 iselExpr64 :: CmmExpr -> NatM ChildCode64
326 iselExpr64 (CmmLoad addrTree ty) | isWord64 ty = do
327 (hi_addr, lo_addr, addr_code) <- getI64Amodes addrTree
328 (rlo, rhi) <- getNewRegPairNat II32
329 let mov_hi = LD II32 rhi hi_addr
330 mov_lo = LD II32 rlo lo_addr
331 return $ ChildCode64 (addr_code `snocOL` mov_lo `snocOL` mov_hi)
334 iselExpr64 (CmmReg (CmmLocal (LocalReg vu ty))) | isWord64 ty
335 = return (ChildCode64 nilOL (RegVirtual $ mkVirtualReg vu II32))
337 iselExpr64 (CmmLit (CmmInt i _)) = do
338 (rlo,rhi) <- getNewRegPairNat II32
340 half0 = fromIntegral (fromIntegral i :: Word16)
341 half1 = fromIntegral ((fromIntegral i `shiftR` 16) :: Word16)
342 half2 = fromIntegral ((fromIntegral i `shiftR` 32) :: Word16)
343 half3 = fromIntegral ((fromIntegral i `shiftR` 48) :: Word16)
346 LIS rlo (ImmInt half1),
347 OR rlo rlo (RIImm $ ImmInt half0),
348 LIS rhi (ImmInt half3),
349 OR rlo rlo (RIImm $ ImmInt half2)
352 return (ChildCode64 code rlo)
354 iselExpr64 (CmmMachOp (MO_Add _) [e1,e2]) = do
355 ChildCode64 code1 r1lo <- iselExpr64 e1
356 ChildCode64 code2 r2lo <- iselExpr64 e2
357 (rlo,rhi) <- getNewRegPairNat II32
359 r1hi = getHiVRegFromLo r1lo
360 r2hi = getHiVRegFromLo r2lo
363 toOL [ ADDC rlo r1lo r2lo,
366 return (ChildCode64 code rlo)
368 iselExpr64 (CmmMachOp (MO_UU_Conv W32 W64) [expr]) = do
369 (expr_reg,expr_code) <- getSomeReg expr
370 (rlo, rhi) <- getNewRegPairNat II32
371 let mov_hi = LI rhi (ImmInt 0)
372 mov_lo = MR rlo expr_reg
373 return $ ChildCode64 (expr_code `snocOL` mov_lo `snocOL` mov_hi)
376 = pprPanic "iselExpr64(powerpc)" (ppr expr)
380 getRegister :: CmmExpr -> NatM Register
382 getRegister (CmmReg (CmmGlobal PicBaseReg))
384 reg <- getPicBaseNat archWordSize
385 return (Fixed archWordSize reg nilOL)
387 getRegister (CmmReg reg)
388 = return (Fixed (cmmTypeSize (cmmRegType reg))
389 (getRegisterReg reg) nilOL)
391 getRegister tree@(CmmRegOff _ _)
392 = getRegister (mangleIndexTree tree)
395 #if WORD_SIZE_IN_BITS==32
396 -- for 32-bit architectuers, support some 64 -> 32 bit conversions:
397 -- TO_W_(x), TO_W_(x >> 32)
399 getRegister (CmmMachOp (MO_UU_Conv W64 W32)
400 [CmmMachOp (MO_U_Shr W64) [x,CmmLit (CmmInt 32 _)]]) = do
401 ChildCode64 code rlo <- iselExpr64 x
402 return $ Fixed II32 (getHiVRegFromLo rlo) code
404 getRegister (CmmMachOp (MO_SS_Conv W64 W32)
405 [CmmMachOp (MO_U_Shr W64) [x,CmmLit (CmmInt 32 _)]]) = do
406 ChildCode64 code rlo <- iselExpr64 x
407 return $ Fixed II32 (getHiVRegFromLo rlo) code
409 getRegister (CmmMachOp (MO_UU_Conv W64 W32) [x]) = do
410 ChildCode64 code rlo <- iselExpr64 x
411 return $ Fixed II32 rlo code
413 getRegister (CmmMachOp (MO_SS_Conv W64 W32) [x]) = do
414 ChildCode64 code rlo <- iselExpr64 x
415 return $ Fixed II32 rlo code
420 getRegister (CmmLoad mem pk)
423 Amode addr addr_code <- getAmode mem
424 let code dst = ASSERT((targetClassOfReg dst == RcDouble) == isFloatType pk)
425 addr_code `snocOL` LD size dst addr
426 return (Any size code)
427 where size = cmmTypeSize pk
429 -- catch simple cases of zero- or sign-extended load
430 getRegister (CmmMachOp (MO_UU_Conv W8 W32) [CmmLoad mem _]) = do
431 Amode addr addr_code <- getAmode mem
432 return (Any II32 (\dst -> addr_code `snocOL` LD II8 dst addr))
434 -- Note: there is no Load Byte Arithmetic instruction, so no signed case here
436 getRegister (CmmMachOp (MO_UU_Conv W16 W32) [CmmLoad mem _]) = do
437 Amode addr addr_code <- getAmode mem
438 return (Any II32 (\dst -> addr_code `snocOL` LD II16 dst addr))
440 getRegister (CmmMachOp (MO_SS_Conv W16 W32) [CmmLoad mem _]) = do
441 Amode addr addr_code <- getAmode mem
442 return (Any II32 (\dst -> addr_code `snocOL` LA II16 dst addr))
444 getRegister (CmmMachOp mop [x]) -- unary MachOps
446 MO_Not rep -> triv_ucode_int rep NOT
448 MO_F_Neg w -> triv_ucode_float w FNEG
449 MO_S_Neg w -> triv_ucode_int w NEG
451 MO_FF_Conv W64 W32 -> trivialUCode FF32 FRSP x
452 MO_FF_Conv W32 W64 -> conversionNop FF64 x
454 MO_FS_Conv from to -> coerceFP2Int from to x
455 MO_SF_Conv from to -> coerceInt2FP from to x
458 | from == to -> conversionNop (intSize to) x
460 -- narrowing is a nop: we treat the high bits as undefined
461 MO_SS_Conv W32 to -> conversionNop (intSize to) x
462 MO_SS_Conv W16 W8 -> conversionNop II8 x
463 MO_SS_Conv W8 to -> triv_ucode_int to (EXTS II8)
464 MO_SS_Conv W16 to -> triv_ucode_int to (EXTS II16)
467 | from == to -> conversionNop (intSize to) x
468 -- narrowing is a nop: we treat the high bits as undefined
469 MO_UU_Conv W32 to -> conversionNop (intSize to) x
470 MO_UU_Conv W16 W8 -> conversionNop II8 x
471 MO_UU_Conv W8 to -> trivialCode to False AND x (CmmLit (CmmInt 255 W32))
472 MO_UU_Conv W16 to -> trivialCode to False AND x (CmmLit (CmmInt 65535 W32))
473 _ -> panic "PPC.CodeGen.getRegister: no match"
476 triv_ucode_int width instr = trivialUCode (intSize width) instr x
477 triv_ucode_float width instr = trivialUCode (floatSize width) instr x
479 conversionNop new_size expr
480 = do e_code <- getRegister expr
481 return (swizzleRegisterRep e_code new_size)
483 getRegister (CmmMachOp mop [x, y]) -- dyadic PrimOps
485 MO_F_Eq w -> condFltReg EQQ x y
486 MO_F_Ne w -> condFltReg NE x y
487 MO_F_Gt w -> condFltReg GTT x y
488 MO_F_Ge w -> condFltReg GE x y
489 MO_F_Lt w -> condFltReg LTT x y
490 MO_F_Le w -> condFltReg LE x y
492 MO_Eq rep -> condIntReg EQQ (extendUExpr rep x) (extendUExpr rep y)
493 MO_Ne rep -> condIntReg NE (extendUExpr rep x) (extendUExpr rep y)
495 MO_S_Gt rep -> condIntReg GTT (extendSExpr rep x) (extendSExpr rep y)
496 MO_S_Ge rep -> condIntReg GE (extendSExpr rep x) (extendSExpr rep y)
497 MO_S_Lt rep -> condIntReg LTT (extendSExpr rep x) (extendSExpr rep y)
498 MO_S_Le rep -> condIntReg LE (extendSExpr rep x) (extendSExpr rep y)
500 MO_U_Gt rep -> condIntReg GU (extendUExpr rep x) (extendUExpr rep y)
501 MO_U_Ge rep -> condIntReg GEU (extendUExpr rep x) (extendUExpr rep y)
502 MO_U_Lt rep -> condIntReg LU (extendUExpr rep x) (extendUExpr rep y)
503 MO_U_Le rep -> condIntReg LEU (extendUExpr rep x) (extendUExpr rep y)
505 MO_F_Add w -> triv_float w FADD
506 MO_F_Sub w -> triv_float w FSUB
507 MO_F_Mul w -> triv_float w FMUL
508 MO_F_Quot w -> triv_float w FDIV
510 -- optimize addition with 32-bit immediate
514 CmmLit (CmmInt imm immrep) | Just _ <- makeImmediate W32 True (-imm)
515 -> trivialCode W32 True ADD x (CmmLit $ CmmInt imm immrep)
518 (src, srcCode) <- getSomeReg x
519 let imm = litToImm lit
520 code dst = srcCode `appOL` toOL [
521 ADDIS dst src (HA imm),
522 ADD dst dst (RIImm (LO imm))
524 return (Any II32 code)
525 _ -> trivialCode W32 True ADD x y
527 MO_Add rep -> trivialCode rep True ADD x y
529 case y of -- subfi ('substract from' with immediate) doesn't exist
530 CmmLit (CmmInt imm immrep) | Just _ <- makeImmediate rep True (-imm)
531 -> trivialCode rep True ADD x (CmmLit $ CmmInt (-imm) immrep)
532 _ -> trivialCodeNoImm' (intSize rep) SUBF y x
534 MO_Mul rep -> trivialCode rep True MULLW x y
536 MO_S_MulMayOflo W32 -> trivialCodeNoImm' II32 MULLW_MayOflo x y
538 MO_S_MulMayOflo rep -> panic "S_MulMayOflo (rep /= II32): not implemented"
539 MO_U_MulMayOflo rep -> panic "U_MulMayOflo: not implemented"
541 MO_S_Quot rep -> trivialCodeNoImm' (intSize rep) DIVW (extendSExpr rep x) (extendSExpr rep y)
542 MO_U_Quot rep -> trivialCodeNoImm' (intSize rep) DIVWU (extendUExpr rep x) (extendUExpr rep y)
544 MO_S_Rem rep -> remainderCode rep DIVW (extendSExpr rep x) (extendSExpr rep y)
545 MO_U_Rem rep -> remainderCode rep DIVWU (extendUExpr rep x) (extendUExpr rep y)
547 MO_And rep -> trivialCode rep False AND x y
548 MO_Or rep -> trivialCode rep False OR x y
549 MO_Xor rep -> trivialCode rep False XOR x y
551 MO_Shl rep -> trivialCode rep False SLW x y
552 MO_S_Shr rep -> trivialCode rep False SRAW (extendSExpr rep x) y
553 MO_U_Shr rep -> trivialCode rep False SRW (extendUExpr rep x) y
554 _ -> panic "PPC.CodeGen.getRegister: no match"
557 triv_float :: Width -> (Size -> Reg -> Reg -> Reg -> Instr) -> NatM Register
558 triv_float width instr = trivialCodeNoImm (floatSize width) instr x y
560 getRegister (CmmLit (CmmInt i rep))
561 | Just imm <- makeImmediate rep True i
563 code dst = unitOL (LI dst imm)
565 return (Any (intSize rep) code)
567 getRegister (CmmLit (CmmFloat f frep)) = do
568 lbl <- getNewLabelNat
569 dflags <- getDynFlagsNat
570 dynRef <- cmmMakeDynamicReference dflags addImportNat DataReference lbl
571 Amode addr addr_code <- getAmode dynRef
572 let size = floatSize frep
574 LDATA ReadOnlyData [CmmDataLabel lbl,
575 CmmStaticLit (CmmFloat f frep)]
576 `consOL` (addr_code `snocOL` LD size dst addr)
577 return (Any size code)
579 getRegister (CmmLit lit)
580 = let rep = cmmLitType lit
584 ADD dst dst (RIImm (LO imm))
586 in return (Any (cmmTypeSize rep) code)
588 getRegister other = pprPanic "getRegister(ppc)" (pprExpr other)
590 -- extend?Rep: wrap integer expression of type rep
591 -- in a conversion to II32
592 extendSExpr W32 x = x
593 extendSExpr rep x = CmmMachOp (MO_SS_Conv rep W32) [x]
594 extendUExpr W32 x = x
595 extendUExpr rep x = CmmMachOp (MO_UU_Conv rep W32) [x]
597 -- -----------------------------------------------------------------------------
598 -- The 'Amode' type: Memory addressing modes passed up the tree.
601 = Amode AddrMode InstrBlock
604 Now, given a tree (the argument to an CmmLoad) that references memory,
605 produce a suitable addressing mode.
607 A Rule of the Game (tm) for Amodes: use of the addr bit must
608 immediately follow use of the code part, since the code part puts
609 values in registers which the addr then refers to. So you can't put
610 anything in between, lest it overwrite some of those registers. If
611 you need to do some other computation between the code part and use of
612 the addr bit, first store the effective address from the amode in a
613 temporary, then do the other computation, and then use the temporary:
617 ... other computation ...
621 getAmode :: CmmExpr -> NatM Amode
622 getAmode tree@(CmmRegOff _ _) = getAmode (mangleIndexTree tree)
624 getAmode (CmmMachOp (MO_Sub W32) [x, CmmLit (CmmInt i _)])
625 | Just off <- makeImmediate W32 True (-i)
627 (reg, code) <- getSomeReg x
628 return (Amode (AddrRegImm reg off) code)
631 getAmode (CmmMachOp (MO_Add W32) [x, CmmLit (CmmInt i _)])
632 | Just off <- makeImmediate W32 True i
634 (reg, code) <- getSomeReg x
635 return (Amode (AddrRegImm reg off) code)
637 -- optimize addition with 32-bit immediate
639 getAmode (CmmMachOp (MO_Add W32) [x, CmmLit lit])
641 tmp <- getNewRegNat II32
642 (src, srcCode) <- getSomeReg x
643 let imm = litToImm lit
644 code = srcCode `snocOL` ADDIS tmp src (HA imm)
645 return (Amode (AddrRegImm tmp (LO imm)) code)
647 getAmode (CmmLit lit)
649 tmp <- getNewRegNat II32
650 let imm = litToImm lit
651 code = unitOL (LIS tmp (HA imm))
652 return (Amode (AddrRegImm tmp (LO imm)) code)
654 getAmode (CmmMachOp (MO_Add W32) [x, y])
656 (regX, codeX) <- getSomeReg x
657 (regY, codeY) <- getSomeReg y
658 return (Amode (AddrRegReg regX regY) (codeX `appOL` codeY))
662 (reg, code) <- getSomeReg other
665 return (Amode (AddrRegImm reg off) code)
669 -- The 'CondCode' type: Condition codes passed up the tree.
671 = CondCode Bool Cond InstrBlock
673 -- Set up a condition code for a conditional branch.
675 getCondCode :: CmmExpr -> NatM CondCode
677 -- almost the same as everywhere else - but we need to
678 -- extend small integers to 32 bit first
680 getCondCode (CmmMachOp mop [x, y])
682 MO_F_Eq W32 -> condFltCode EQQ x y
683 MO_F_Ne W32 -> condFltCode NE x y
684 MO_F_Gt W32 -> condFltCode GTT x y
685 MO_F_Ge W32 -> condFltCode GE x y
686 MO_F_Lt W32 -> condFltCode LTT x y
687 MO_F_Le W32 -> condFltCode LE x y
689 MO_F_Eq W64 -> condFltCode EQQ x y
690 MO_F_Ne W64 -> condFltCode NE x y
691 MO_F_Gt W64 -> condFltCode GTT x y
692 MO_F_Ge W64 -> condFltCode GE x y
693 MO_F_Lt W64 -> condFltCode LTT x y
694 MO_F_Le W64 -> condFltCode LE x y
696 MO_Eq rep -> condIntCode EQQ (extendUExpr rep x) (extendUExpr rep y)
697 MO_Ne rep -> condIntCode NE (extendUExpr rep x) (extendUExpr rep y)
699 MO_S_Gt rep -> condIntCode GTT (extendSExpr rep x) (extendSExpr rep y)
700 MO_S_Ge rep -> condIntCode GE (extendSExpr rep x) (extendSExpr rep y)
701 MO_S_Lt rep -> condIntCode LTT (extendSExpr rep x) (extendSExpr rep y)
702 MO_S_Le rep -> condIntCode LE (extendSExpr rep x) (extendSExpr rep y)
704 MO_U_Gt rep -> condIntCode GU (extendUExpr rep x) (extendUExpr rep y)
705 MO_U_Ge rep -> condIntCode GEU (extendUExpr rep x) (extendUExpr rep y)
706 MO_U_Lt rep -> condIntCode LU (extendUExpr rep x) (extendUExpr rep y)
707 MO_U_Le rep -> condIntCode LEU (extendUExpr rep x) (extendUExpr rep y)
709 other -> pprPanic "getCondCode(powerpc)" (pprMachOp mop)
711 getCondCode other = panic "getCondCode(2)(powerpc)"
715 -- @cond(Int|Flt)Code@: Turn a boolean expression into a condition, to be
716 -- passed back up the tree.
718 condIntCode, condFltCode :: Cond -> CmmExpr -> CmmExpr -> NatM CondCode
720 -- ###FIXME: I16 and I8!
721 condIntCode cond x (CmmLit (CmmInt y rep))
722 | Just src2 <- makeImmediate rep (not $ condUnsigned cond) y
724 (src1, code) <- getSomeReg x
726 code' = code `snocOL`
727 (if condUnsigned cond then CMPL else CMP) II32 src1 (RIImm src2)
728 return (CondCode False cond code')
730 condIntCode cond x y = do
731 (src1, code1) <- getSomeReg x
732 (src2, code2) <- getSomeReg y
734 code' = code1 `appOL` code2 `snocOL`
735 (if condUnsigned cond then CMPL else CMP) II32 src1 (RIReg src2)
736 return (CondCode False cond code')
738 condFltCode cond x y = do
739 (src1, code1) <- getSomeReg x
740 (src2, code2) <- getSomeReg y
742 code' = code1 `appOL` code2 `snocOL` FCMP src1 src2
743 code'' = case cond of -- twiddle CR to handle unordered case
744 GE -> code' `snocOL` CRNOR ltbit eqbit gtbit
745 LE -> code' `snocOL` CRNOR gtbit eqbit ltbit
748 ltbit = 0 ; eqbit = 2 ; gtbit = 1
749 return (CondCode True cond code'')
753 -- -----------------------------------------------------------------------------
754 -- Generating assignments
756 -- Assignments are really at the heart of the whole code generation
757 -- business. Almost all top-level nodes of any real importance are
758 -- assignments, which correspond to loads, stores, or register
759 -- transfers. If we're really lucky, some of the register transfers
760 -- will go away, because we can use the destination register to
761 -- complete the code generation for the right hand side. This only
762 -- fails when the right hand side is forced into a fixed register
763 -- (e.g. the result of a call).
765 assignMem_IntCode :: Size -> CmmExpr -> CmmExpr -> NatM InstrBlock
766 assignReg_IntCode :: Size -> CmmReg -> CmmExpr -> NatM InstrBlock
768 assignMem_FltCode :: Size -> CmmExpr -> CmmExpr -> NatM InstrBlock
769 assignReg_FltCode :: Size -> CmmReg -> CmmExpr -> NatM InstrBlock
771 assignMem_IntCode pk addr src = do
772 (srcReg, code) <- getSomeReg src
773 Amode dstAddr addr_code <- getAmode addr
774 return $ code `appOL` addr_code `snocOL` ST pk srcReg dstAddr
776 -- dst is a reg, but src could be anything
777 assignReg_IntCode _ reg src
781 Any _ code -> code dst
782 Fixed _ freg fcode -> fcode `snocOL` MR dst freg
784 dst = getRegisterReg reg
789 assignMem_FltCode = assignMem_IntCode
790 assignReg_FltCode = assignReg_IntCode
794 genJump :: CmmExpr{-the branch target-} -> NatM InstrBlock
796 genJump (CmmLit (CmmLabel lbl))
797 = return (unitOL $ JMP lbl)
801 (target,code) <- getSomeReg tree
802 return (code `snocOL` MTCTR target `snocOL` BCTR [] Nothing)
805 -- -----------------------------------------------------------------------------
806 -- Unconditional branches
807 genBranch :: BlockId -> NatM InstrBlock
808 genBranch = return . toOL . mkJumpInstr
811 -- -----------------------------------------------------------------------------
815 Conditional jumps are always to local labels, so we can use branch
816 instructions. We peek at the arguments to decide what kind of
819 SPARC: First, we have to ensure that the condition codes are set
820 according to the supplied comparison operation. We generate slightly
821 different code for floating point comparisons, because a floating
822 point operation cannot directly precede a @BF@. We assume the worst
823 and fill that slot with a @NOP@.
825 SPARC: Do not fill the delay slots here; you will confuse the register
831 :: BlockId -- the branch target
832 -> CmmExpr -- the condition on which to branch
835 genCondJump id bool = do
836 CondCode _ cond code <- getCondCode bool
837 return (code `snocOL` BCC cond id)
841 -- -----------------------------------------------------------------------------
842 -- Generating C calls
844 -- Now the biggest nightmare---calls. Most of the nastiness is buried in
845 -- @get_arg@, which moves the arguments to the correct registers/stack
846 -- locations. Apart from that, the code is easy.
848 -- (If applicable) Do not fill the delay slots here; you will confuse the
849 -- register allocator.
852 :: CmmCallTarget -- function to call
853 -> HintedCmmFormals -- where to put the result
854 -> HintedCmmActuals -- arguments (of mixed type)
858 #if darwin_TARGET_OS || linux_TARGET_OS
860 The PowerPC calling convention for Darwin/Mac OS X
861 is described in Apple's document
862 "Inside Mac OS X - Mach-O Runtime Architecture".
864 PowerPC Linux uses the System V Release 4 Calling Convention
865 for PowerPC. It is described in the
866 "System V Application Binary Interface PowerPC Processor Supplement".
868 Both conventions are similar:
869 Parameters may be passed in general-purpose registers starting at r3, in
870 floating point registers starting at f1, or on the stack.
872 But there are substantial differences:
873 * The number of registers used for parameter passing and the exact set of
874 nonvolatile registers differs (see MachRegs.lhs).
875 * On Darwin, stack space is always reserved for parameters, even if they are
876 passed in registers. The called routine may choose to save parameters from
877 registers to the corresponding space on the stack.
878 * On Darwin, a corresponding amount of GPRs is skipped when a floating point
879 parameter is passed in an FPR.
880 * SysV insists on either passing I64 arguments on the stack, or in two GPRs,
881 starting with an odd-numbered GPR. It may skip a GPR to achieve this.
882 Darwin just treats an I64 like two separate II32s (high word first).
883 * I64 and FF64 arguments are 8-byte aligned on the stack for SysV, but only
884 4-byte aligned like everything else on Darwin.
885 * The SysV spec claims that FF32 is represented as FF64 on the stack. GCC on
886 PowerPC Linux does not agree, so neither do we.
888 According to both conventions, The parameter area should be part of the
889 caller's stack frame, allocated in the caller's prologue code (large enough
890 to hold the parameter lists for all called routines). The NCG already
891 uses the stack for register spilling, leaving 64 bytes free at the top.
892 If we need a larger parameter area than that, we just allocate a new stack
893 frame just before ccalling.
897 genCCall (CmmPrim MO_WriteBarrier) _ _
898 = return $ unitOL LWSYNC
900 genCCall target dest_regs argsAndHints
901 = ASSERT (not $ any (`elem` [II8,II16]) $ map cmmTypeSize argReps)
902 -- we rely on argument promotion in the codeGen
904 (finalStack,passArgumentsCode,usedRegs) <- passArguments
906 allArgRegs allFPArgRegs
910 (labelOrExpr, reduceToFF32) <- case target of
911 CmmCallee (CmmLit (CmmLabel lbl)) conv -> return (Left lbl, False)
912 CmmCallee expr conv -> return (Right expr, False)
913 CmmPrim mop -> outOfLineFloatOp mop
915 let codeBefore = move_sp_down finalStack `appOL` passArgumentsCode
916 codeAfter = move_sp_up finalStack `appOL` moveResult reduceToFF32
921 `snocOL` BL lbl usedRegs
924 (dynReg, dynCode) <- getSomeReg dyn
926 `snocOL` MTCTR dynReg
928 `snocOL` BCTRL usedRegs
932 initialStackOffset = 24
933 -- size of linkage area + size of arguments, in bytes
934 stackDelta _finalStack = roundTo 16 $ (24 +) $ max 32 $ sum $
935 map (widthInBytes . typeWidth) argReps
936 #elif linux_TARGET_OS
937 initialStackOffset = 8
938 stackDelta finalStack = roundTo 16 finalStack
940 args = map hintlessCmm argsAndHints
941 argReps = map cmmExprType args
943 roundTo a x | x `mod` a == 0 = x
944 | otherwise = x + a - (x `mod` a)
946 move_sp_down finalStack
948 toOL [STU II32 sp (AddrRegImm sp (ImmInt (-delta))),
951 where delta = stackDelta finalStack
952 move_sp_up finalStack
954 toOL [ADD sp sp (RIImm (ImmInt delta)),
957 where delta = stackDelta finalStack
960 passArguments [] _ _ stackOffset accumCode accumUsed = return (stackOffset, accumCode, accumUsed)
961 passArguments ((arg,arg_ty):args) gprs fprs stackOffset
962 accumCode accumUsed | isWord64 arg_ty =
964 ChildCode64 code vr_lo <- iselExpr64 arg
965 let vr_hi = getHiVRegFromLo vr_lo
972 (accumCode `appOL` code
973 `snocOL` storeWord vr_hi gprs stackOffset
974 `snocOL` storeWord vr_lo (drop 1 gprs) (stackOffset+4))
975 ((take 2 gprs) ++ accumUsed)
977 storeWord vr (gpr:_) offset = MR gpr vr
978 storeWord vr [] offset = ST II32 vr (AddrRegImm sp (ImmInt offset))
980 #elif linux_TARGET_OS
981 let stackOffset' = roundTo 8 stackOffset
982 stackCode = accumCode `appOL` code
983 `snocOL` ST II32 vr_hi (AddrRegImm sp (ImmInt stackOffset'))
984 `snocOL` ST II32 vr_lo (AddrRegImm sp (ImmInt (stackOffset'+4)))
985 regCode hireg loreg =
986 accumCode `appOL` code
987 `snocOL` MR hireg vr_hi
988 `snocOL` MR loreg vr_lo
991 hireg : loreg : regs | even (length gprs) ->
992 passArguments args regs fprs stackOffset
993 (regCode hireg loreg) (hireg : loreg : accumUsed)
994 _skipped : hireg : loreg : regs ->
995 passArguments args regs fprs stackOffset
996 (regCode hireg loreg) (hireg : loreg : accumUsed)
997 _ -> -- only one or no regs left
998 passArguments args [] fprs (stackOffset'+8)
1002 passArguments ((arg,rep):args) gprs fprs stackOffset accumCode accumUsed
1003 | reg : _ <- regs = do
1004 register <- getRegister arg
1005 let code = case register of
1006 Fixed _ freg fcode -> fcode `snocOL` MR reg freg
1007 Any _ acode -> acode reg
1011 #if darwin_TARGET_OS
1012 -- The Darwin ABI requires that we reserve stack slots for register parameters
1013 (stackOffset + stackBytes)
1014 #elif linux_TARGET_OS
1015 -- ... the SysV ABI doesn't.
1018 (accumCode `appOL` code)
1021 (vr, code) <- getSomeReg arg
1025 (stackOffset' + stackBytes)
1026 (accumCode `appOL` code `snocOL` ST (cmmTypeSize rep) vr stackSlot)
1029 #if darwin_TARGET_OS
1030 -- stackOffset is at least 4-byte aligned
1031 -- The Darwin ABI is happy with that.
1032 stackOffset' = stackOffset
1034 -- ... the SysV ABI requires 8-byte alignment for doubles.
1035 stackOffset' | isFloatType rep && typeWidth rep == W64 =
1036 roundTo 8 stackOffset
1037 | otherwise = stackOffset
1039 stackSlot = AddrRegImm sp (ImmInt stackOffset')
1040 (nGprs, nFprs, stackBytes, regs) = case cmmTypeSize rep of
1041 II32 -> (1, 0, 4, gprs)
1042 #if darwin_TARGET_OS
1043 -- The Darwin ABI requires that we skip a corresponding number of GPRs when
1045 FF32 -> (1, 1, 4, fprs)
1046 FF64 -> (2, 1, 8, fprs)
1047 #elif linux_TARGET_OS
1048 -- ... the SysV ABI doesn't.
1049 FF32 -> (0, 1, 4, fprs)
1050 FF64 -> (0, 1, 8, fprs)
1053 moveResult reduceToFF32 =
1056 [CmmHinted dest _hint]
1057 | reduceToFF32 && isFloat32 rep -> unitOL (FRSP r_dest f1)
1058 | isFloat32 rep || isFloat64 rep -> unitOL (MR r_dest f1)
1059 | isWord64 rep -> toOL [MR (getHiVRegFromLo r_dest) r3,
1061 | otherwise -> unitOL (MR r_dest r3)
1062 where rep = cmmRegType (CmmLocal dest)
1063 r_dest = getRegisterReg (CmmLocal dest)
1065 outOfLineFloatOp mop =
1067 dflags <- getDynFlagsNat
1068 mopExpr <- cmmMakeDynamicReference dflags addImportNat CallReference $
1069 mkForeignLabel functionName Nothing ForeignLabelInThisPackage IsFunction
1070 let mopLabelOrExpr = case mopExpr of
1071 CmmLit (CmmLabel lbl) -> Left lbl
1073 return (mopLabelOrExpr, reduce)
1075 (functionName, reduce) = case mop of
1076 MO_F32_Exp -> (fsLit "exp", True)
1077 MO_F32_Log -> (fsLit "log", True)
1078 MO_F32_Sqrt -> (fsLit "sqrt", True)
1080 MO_F32_Sin -> (fsLit "sin", True)
1081 MO_F32_Cos -> (fsLit "cos", True)
1082 MO_F32_Tan -> (fsLit "tan", True)
1084 MO_F32_Asin -> (fsLit "asin", True)
1085 MO_F32_Acos -> (fsLit "acos", True)
1086 MO_F32_Atan -> (fsLit "atan", True)
1088 MO_F32_Sinh -> (fsLit "sinh", True)
1089 MO_F32_Cosh -> (fsLit "cosh", True)
1090 MO_F32_Tanh -> (fsLit "tanh", True)
1091 MO_F32_Pwr -> (fsLit "pow", True)
1093 MO_F64_Exp -> (fsLit "exp", False)
1094 MO_F64_Log -> (fsLit "log", False)
1095 MO_F64_Sqrt -> (fsLit "sqrt", False)
1097 MO_F64_Sin -> (fsLit "sin", False)
1098 MO_F64_Cos -> (fsLit "cos", False)
1099 MO_F64_Tan -> (fsLit "tan", False)
1101 MO_F64_Asin -> (fsLit "asin", False)
1102 MO_F64_Acos -> (fsLit "acos", False)
1103 MO_F64_Atan -> (fsLit "atan", False)
1105 MO_F64_Sinh -> (fsLit "sinh", False)
1106 MO_F64_Cosh -> (fsLit "cosh", False)
1107 MO_F64_Tanh -> (fsLit "tanh", False)
1108 MO_F64_Pwr -> (fsLit "pow", False)
1109 other -> pprPanic "genCCall(ppc): unknown callish op"
1110 (pprCallishMachOp other)
1112 #else /* darwin_TARGET_OS || linux_TARGET_OS */
1113 genCCall = panic "PPC.CodeGen.genCCall: not defined for this os"
1117 -- -----------------------------------------------------------------------------
1118 -- Generating a table-branch
1120 genSwitch :: CmmExpr -> [Maybe BlockId] -> NatM InstrBlock
1124 (reg,e_code) <- getSomeReg expr
1125 tmp <- getNewRegNat II32
1126 lbl <- getNewLabelNat
1127 dflags <- getDynFlagsNat
1128 dynRef <- cmmMakeDynamicReference dflags addImportNat DataReference lbl
1129 (tableReg,t_code) <- getSomeReg $ dynRef
1130 let code = e_code `appOL` t_code `appOL` toOL [
1131 SLW tmp reg (RIImm (ImmInt 2)),
1132 LD II32 tmp (AddrRegReg tableReg tmp),
1133 ADD tmp tmp (RIReg tableReg),
1140 (reg,e_code) <- getSomeReg expr
1141 tmp <- getNewRegNat II32
1142 lbl <- getNewLabelNat
1143 let code = e_code `appOL` toOL [
1144 SLW tmp reg (RIImm (ImmInt 2)),
1145 ADDIS tmp tmp (HA (ImmCLbl lbl)),
1146 LD II32 tmp (AddrRegImm tmp (LO (ImmCLbl lbl))),
1152 generateJumpTableForInstr :: Instr -> Maybe (NatCmmTop Instr)
1153 generateJumpTableForInstr (BCTR ids (Just lbl)) =
1155 | opt_PIC = map jumpTableEntryRel ids
1156 | otherwise = map jumpTableEntry ids
1157 where jumpTableEntryRel Nothing
1158 = CmmStaticLit (CmmInt 0 wordWidth)
1159 jumpTableEntryRel (Just blockid)
1160 = CmmStaticLit (CmmLabelDiffOff blockLabel lbl 0)
1161 where blockLabel = mkAsmTempLabel (getUnique blockid)
1162 in Just (CmmData ReadOnlyData (CmmDataLabel lbl : jumpTable))
1163 generateJumpTableForInstr _ = Nothing
1165 -- -----------------------------------------------------------------------------
1166 -- 'condIntReg' and 'condFltReg': condition codes into registers
1168 -- Turn those condition codes into integers now (when they appear on
1169 -- the right hand side of an assignment).
1171 -- (If applicable) Do not fill the delay slots here; you will confuse the
1172 -- register allocator.
1174 condIntReg, condFltReg :: Cond -> CmmExpr -> CmmExpr -> NatM Register
1176 condReg :: NatM CondCode -> NatM Register
1177 condReg getCond = do
1178 CondCode _ cond cond_code <- getCond
1180 {- code dst = cond_code `appOL` toOL [
1189 code dst = cond_code
1193 RLWINM dst dst (bit + 1) 31 31
1196 negate_code | do_negate = unitOL (CRNOR bit bit bit)
1199 (bit, do_negate) = case cond of
1212 _ -> panic "PPC.CodeGen.codeReg: no match"
1214 return (Any II32 code)
1216 condIntReg cond x y = condReg (condIntCode cond x y)
1217 condFltReg cond x y = condReg (condFltCode cond x y)
1221 -- -----------------------------------------------------------------------------
1222 -- 'trivial*Code': deal with trivial instructions
1224 -- Trivial (dyadic: 'trivialCode', floating-point: 'trivialFCode',
1225 -- unary: 'trivialUCode', unary fl-pt:'trivialUFCode') instructions.
1226 -- Only look for constants on the right hand side, because that's
1227 -- where the generic optimizer will have put them.
1229 -- Similarly, for unary instructions, we don't have to worry about
1230 -- matching an StInt as the argument, because genericOpt will already
1231 -- have handled the constant-folding.
1236 Wolfgang's PowerPC version of The Rules:
1238 A slightly modified version of The Rules to take advantage of the fact
1239 that PowerPC instructions work on all registers and don't implicitly
1240 clobber any fixed registers.
1242 * The only expression for which getRegister returns Fixed is (CmmReg reg).
1244 * If getRegister returns Any, then the code it generates may modify only:
1245 (a) fresh temporaries
1246 (b) the destination register
1247 It may *not* modify global registers, unless the global
1248 register happens to be the destination register.
1249 It may not clobber any other registers. In fact, only ccalls clobber any
1251 Also, it may not modify the counter register (used by genCCall).
1253 Corollary: If a getRegister for a subexpression returns Fixed, you need
1254 not move it to a fresh temporary before evaluating the next subexpression.
1255 The Fixed register won't be modified.
1256 Therefore, we don't need a counterpart for the x86's getStableReg on PPC.
1258 * SDM's First Rule is valid for PowerPC, too: subexpressions can depend on
1259 the value of the destination register.
1265 -> (Reg -> Reg -> RI -> Instr)
1270 trivialCode rep signed instr x (CmmLit (CmmInt y _))
1271 | Just imm <- makeImmediate rep signed y
1273 (src1, code1) <- getSomeReg x
1274 let code dst = code1 `snocOL` instr dst src1 (RIImm imm)
1275 return (Any (intSize rep) code)
1277 trivialCode rep _ instr x y = do
1278 (src1, code1) <- getSomeReg x
1279 (src2, code2) <- getSomeReg y
1280 let code dst = code1 `appOL` code2 `snocOL` instr dst src1 (RIReg src2)
1281 return (Any (intSize rep) code)
1283 trivialCodeNoImm' :: Size -> (Reg -> Reg -> Reg -> Instr)
1284 -> CmmExpr -> CmmExpr -> NatM Register
1285 trivialCodeNoImm' size instr x y = do
1286 (src1, code1) <- getSomeReg x
1287 (src2, code2) <- getSomeReg y
1288 let code dst = code1 `appOL` code2 `snocOL` instr dst src1 src2
1289 return (Any size code)
1291 trivialCodeNoImm :: Size -> (Size -> Reg -> Reg -> Reg -> Instr)
1292 -> CmmExpr -> CmmExpr -> NatM Register
1293 trivialCodeNoImm size instr x y = trivialCodeNoImm' size (instr size) x y
1298 -> (Reg -> Reg -> Instr)
1301 trivialUCode rep instr x = do
1302 (src, code) <- getSomeReg x
1303 let code' dst = code `snocOL` instr dst src
1304 return (Any rep code')
1306 -- There is no "remainder" instruction on the PPC, so we have to do
1308 -- The "div" parameter is the division instruction to use (DIVW or DIVWU)
1310 remainderCode :: Width -> (Reg -> Reg -> Reg -> Instr)
1311 -> CmmExpr -> CmmExpr -> NatM Register
1312 remainderCode rep div x y = do
1313 (src1, code1) <- getSomeReg x
1314 (src2, code2) <- getSomeReg y
1315 let code dst = code1 `appOL` code2 `appOL` toOL [
1317 MULLW dst dst (RIReg src2),
1320 return (Any (intSize rep) code)
1323 coerceInt2FP :: Width -> Width -> CmmExpr -> NatM Register
1324 coerceInt2FP fromRep toRep x = do
1325 (src, code) <- getSomeReg x
1326 lbl <- getNewLabelNat
1327 itmp <- getNewRegNat II32
1328 ftmp <- getNewRegNat FF64
1329 dflags <- getDynFlagsNat
1330 dynRef <- cmmMakeDynamicReference dflags addImportNat DataReference lbl
1331 Amode addr addr_code <- getAmode dynRef
1333 code' dst = code `appOL` maybe_exts `appOL` toOL [
1336 CmmStaticLit (CmmInt 0x43300000 W32),
1337 CmmStaticLit (CmmInt 0x80000000 W32)],
1338 XORIS itmp src (ImmInt 0x8000),
1339 ST II32 itmp (spRel 3),
1340 LIS itmp (ImmInt 0x4330),
1341 ST II32 itmp (spRel 2),
1342 LD FF64 ftmp (spRel 2)
1343 ] `appOL` addr_code `appOL` toOL [
1345 FSUB FF64 dst ftmp dst
1346 ] `appOL` maybe_frsp dst
1348 maybe_exts = case fromRep of
1349 W8 -> unitOL $ EXTS II8 src src
1350 W16 -> unitOL $ EXTS II16 src src
1352 _ -> panic "PPC.CodeGen.coerceInt2FP: no match"
1356 W32 -> unitOL $ FRSP dst dst
1358 _ -> panic "PPC.CodeGen.coerceInt2FP: no match"
1360 return (Any (floatSize toRep) code')
1362 coerceFP2Int :: Width -> Width -> CmmExpr -> NatM Register
1363 coerceFP2Int _ toRep x = do
1364 -- the reps don't really matter: F*->FF64 and II32->I* are no-ops
1365 (src, code) <- getSomeReg x
1366 tmp <- getNewRegNat FF64
1368 code' dst = code `appOL` toOL [
1369 -- convert to int in FP reg
1371 -- store value (64bit) from FP to stack
1372 ST FF64 tmp (spRel 2),
1373 -- read low word of value (high word is undefined)
1374 LD II32 dst (spRel 3)]
1375 return (Any (intSize toRep) code')