2 -----------------------------------------------------------------------------
4 -- Generating machine code (instruction selection)
6 -- (c) The University of Glasgow 1996-2004
8 -----------------------------------------------------------------------------
10 module SPARC.CodeGen (
17 #include "HsVersions.h"
18 #include "nativeGen/NCG.h"
35 -- Our intermediate code:
42 import StaticFlags ( opt_PIC )
44 import qualified Outputable as O
48 import Control.Monad ( mapAndUnzipM )
52 -- | Top level code generation
56 -> NatM [NatCmmTop Instr]
59 (CmmProc info lab params (ListGraph blocks))
61 (nat_blocks,statics) <- mapAndUnzipM basicBlockCodeGen blocks
63 -- picBaseMb <- getPicBaseMaybeNat
64 let proc = CmmProc info lab params (ListGraph $ concat nat_blocks)
65 let tops = proc : concat statics
68 -- Just picBase -> initializePicBase picBase tops
69 -- Nothing -> return tops
74 cmmTopCodeGen _ (CmmData sec dat) = do
75 return [CmmData sec dat] -- no translation, we just use CmmStatic
81 -> NatM ( [NatBasicBlock Instr]
84 basicBlockCodeGen (BasicBlock id stmts) = do
85 instrs <- stmtsToInstrs stmts
86 -- code generation may introduce new basic block boundaries, which
87 -- are indicated by the NEWBLOCK instruction. We must split up the
88 -- instruction stream into basic blocks again. Also, we extract
91 (top,other_blocks,statics) = foldrOL mkBlocks ([],[],[]) instrs
93 mkBlocks (NEWBLOCK id) (instrs,blocks,statics)
94 = ([], BasicBlock id instrs : blocks, statics)
95 mkBlocks (LDATA sec dat) (instrs,blocks,statics)
96 = (instrs, blocks, CmmData sec dat:statics)
97 mkBlocks instr (instrs,blocks,statics)
98 = (instr:instrs, blocks, statics)
100 return (BasicBlock id top : other_blocks, statics)
103 stmtsToInstrs :: [CmmStmt] -> NatM InstrBlock
105 = do instrss <- mapM stmtToInstrs stmts
106 return (concatOL instrss)
109 stmtToInstrs :: CmmStmt -> NatM InstrBlock
110 stmtToInstrs stmt = case stmt of
111 CmmNop -> return nilOL
112 CmmComment s -> return (unitOL (COMMENT s))
115 | isFloatType ty -> assignReg_FltCode size reg src
116 | isWord64 ty -> assignReg_I64Code reg src
117 | otherwise -> assignReg_IntCode size reg src
118 where ty = cmmRegType reg
119 size = cmmTypeSize ty
122 | isFloatType ty -> assignMem_FltCode size addr src
123 | isWord64 ty -> assignMem_I64Code addr src
124 | otherwise -> assignMem_IntCode size addr src
125 where ty = cmmExprType src
126 size = cmmTypeSize ty
128 CmmCall target result_regs args _ _
129 -> genCCall target result_regs args
131 CmmBranch id -> genBranch id
132 CmmCondBranch arg id -> genCondJump id arg
133 CmmSwitch arg ids -> genSwitch arg ids
134 CmmJump arg _ -> genJump arg
137 -> panic "stmtToInstrs: return statement should have been cps'd away"
140 --------------------------------------------------------------------------------
141 -- | 'InstrBlock's are the insn sequences generated by the insn selectors.
142 -- They are really trees of insns to facilitate fast appending, where a
143 -- left-to-right traversal yields the insns in the correct order.
149 -- | Condition codes passed up the tree.
152 = CondCode Bool Cond InstrBlock
155 -- | a.k.a "Register64"
156 -- Reg is the lower 32-bit temporary which contains the result.
157 -- Use getHiVRegFromLo to find the other VRegUnique.
159 -- Rules of this simplified insn selection game are therefore that
160 -- the returned Reg may be modified
168 -- | Register's passed up the tree. If the stix code forces the register
169 -- to live in a pre-decided machine register, it comes out as @Fixed@;
170 -- otherwise, it comes out as @Any@, and the parent can decide which
171 -- register to put it in.
174 = Fixed Size Reg InstrBlock
175 | Any Size (Reg -> InstrBlock)
178 swizzleRegisterRep :: Register -> Size -> Register
179 swizzleRegisterRep (Fixed _ reg code) size = Fixed size reg code
180 swizzleRegisterRep (Any _ codefn) size = Any size codefn
183 -- | Grab the Reg for a CmmReg
184 getRegisterReg :: CmmReg -> Reg
186 getRegisterReg (CmmLocal (LocalReg u pk))
187 = mkVReg u (cmmTypeSize pk)
189 getRegisterReg (CmmGlobal mid)
190 = case get_GlobalReg_reg_or_addr mid of
191 Left (RealReg rrno) -> RealReg rrno
192 _other -> pprPanic "getRegisterReg-memory" (ppr $ CmmGlobal mid)
193 -- By this stage, the only MagicIds remaining should be the
194 -- ones which map to a real machine register on this
195 -- platform. Hence ...
198 -- | Memory addressing modes passed up the tree.
200 = Amode AddrMode InstrBlock
203 Now, given a tree (the argument to an CmmLoad) that references memory,
204 produce a suitable addressing mode.
206 A Rule of the Game (tm) for Amodes: use of the addr bit must
207 immediately follow use of the code part, since the code part puts
208 values in registers which the addr then refers to. So you can't put
209 anything in between, lest it overwrite some of those registers. If
210 you need to do some other computation between the code part and use of
211 the addr bit, first store the effective address from the amode in a
212 temporary, then do the other computation, and then use the temporary:
216 ... other computation ...
221 -- | Check whether an integer will fit in 32 bits.
222 -- A CmmInt is intended to be truncated to the appropriate
223 -- number of bits, so here we truncate it to Int64. This is
224 -- important because e.g. -1 as a CmmInt might be either
225 -- -1 or 18446744073709551615.
227 is32BitInteger :: Integer -> Bool
228 is32BitInteger i = i64 <= 0x7fffffff && i64 >= -0x80000000
229 where i64 = fromIntegral i :: Int64
232 -- | Convert a BlockId to some CmmStatic data
233 jumpTableEntry :: Maybe BlockId -> CmmStatic
234 jumpTableEntry Nothing = CmmStaticLit (CmmInt 0 wordWidth)
235 jumpTableEntry (Just (BlockId id)) = CmmStaticLit (CmmLabel blockLabel)
236 where blockLabel = mkAsmTempLabel id
241 -- -----------------------------------------------------------------------------
242 -- General things for putting together code sequences
244 -- Expand CmmRegOff. ToDo: should we do it this way around, or convert
245 -- CmmExprs into CmmRegOff?
246 mangleIndexTree :: CmmExpr -> CmmExpr
247 mangleIndexTree (CmmRegOff reg off)
248 = CmmMachOp (MO_Add width) [CmmReg reg, CmmLit (CmmInt (fromIntegral off) width)]
249 where width = typeWidth (cmmRegType reg)
252 assignMem_I64Code :: CmmExpr -> CmmExpr -> NatM InstrBlock
253 assignMem_I64Code addrTree valueTree = do
254 Amode _ addr_code <- getAmode addrTree
255 ChildCode64 vcode rlo <- iselExpr64 valueTree
257 (src, code) <- getSomeReg addrTree
259 rhi = getHiVRegFromLo rlo
261 mov_hi = ST II32 rhi (AddrRegImm src (ImmInt 0))
262 mov_lo = ST II32 rlo (AddrRegImm src (ImmInt 4))
264 return (vcode `appOL` code `snocOL` mov_hi `snocOL` mov_lo)
267 assignReg_I64Code :: CmmReg -> CmmExpr -> NatM InstrBlock
268 assignReg_I64Code (CmmLocal (LocalReg u_dst pk)) valueTree = do
269 ChildCode64 vcode r_src_lo <- iselExpr64 valueTree
271 r_dst_lo = mkVReg u_dst (cmmTypeSize pk)
272 r_dst_hi = getHiVRegFromLo r_dst_lo
273 r_src_hi = getHiVRegFromLo r_src_lo
274 mov_lo = mkMOV r_src_lo r_dst_lo
275 mov_hi = mkMOV r_src_hi r_dst_hi
276 mkMOV sreg dreg = OR False g0 (RIReg sreg) dreg
277 return (vcode `snocOL` mov_hi `snocOL` mov_lo)
278 assignReg_I64Code lvalue valueTree
279 = panic "assignReg_I64Code(sparc): invalid lvalue"
282 -- Load a 64 bit word
283 iselExpr64 (CmmLoad addrTree ty)
285 = do Amode amode addr_code <- getAmode addrTree
288 | AddrRegReg r1 r2 <- amode
289 = do rlo <- getNewRegNat II32
290 tmp <- getNewRegNat II32
291 let rhi = getHiVRegFromLo rlo
296 [ ADD False False r1 (RIReg r2) tmp
297 , LD II32 (AddrRegImm tmp (ImmInt 0)) rhi
298 , LD II32 (AddrRegImm tmp (ImmInt 4)) rlo ])
301 | AddrRegImm r1 (ImmInt i) <- amode
302 = do rlo <- getNewRegNat II32
303 let rhi = getHiVRegFromLo rlo
308 [ LD II32 (AddrRegImm r1 (ImmInt $ 0 + i)) rhi
309 , LD II32 (AddrRegImm r1 (ImmInt $ 4 + i)) rlo ])
315 -- Add a literal to a 64 bit integer
316 iselExpr64 (CmmMachOp (MO_Add _) [e1, CmmLit (CmmInt i _)])
317 = do ChildCode64 code1 r1_lo <- iselExpr64 e1
318 let r1_hi = getHiVRegFromLo r1_lo
320 r_dst_lo <- getNewRegNat II32
321 let r_dst_hi = getHiVRegFromLo r_dst_lo
325 [ ADD False False r1_lo (RIImm (ImmInteger i)) r_dst_lo
326 , ADD True False r1_hi (RIReg g0) r_dst_hi ])
331 iselExpr64 (CmmMachOp (MO_Add width) [e1, e2])
332 = do ChildCode64 code1 r1_lo <- iselExpr64 e1
333 let r1_hi = getHiVRegFromLo r1_lo
335 ChildCode64 code2 r2_lo <- iselExpr64 e2
336 let r2_hi = getHiVRegFromLo r2_lo
338 r_dst_lo <- getNewRegNat II32
339 let r_dst_hi = getHiVRegFromLo r_dst_lo
344 [ ADD False False r1_lo (RIReg r2_lo) r_dst_lo
345 , ADD True False r1_hi (RIReg r2_hi) r_dst_hi ]
347 return $ ChildCode64 code r_dst_lo
350 iselExpr64 (CmmReg (CmmLocal (LocalReg uq ty))) | isWord64 ty = do
351 r_dst_lo <- getNewRegNat II32
352 let r_dst_hi = getHiVRegFromLo r_dst_lo
353 r_src_lo = mkVReg uq II32
354 r_src_hi = getHiVRegFromLo r_src_lo
355 mov_lo = mkMOV r_src_lo r_dst_lo
356 mov_hi = mkMOV r_src_hi r_dst_hi
357 mkMOV sreg dreg = OR False g0 (RIReg sreg) dreg
359 ChildCode64 (toOL [mov_hi, mov_lo]) r_dst_lo
362 -- Convert something into II64
363 iselExpr64 (CmmMachOp (MO_UU_Conv _ W64) [expr])
365 r_dst_lo <- getNewRegNat II32
366 let r_dst_hi = getHiVRegFromLo r_dst_lo
368 -- compute expr and load it into r_dst_lo
369 (a_reg, a_code) <- getSomeReg expr
373 [ mkRegRegMoveInstr g0 r_dst_hi -- clear high 32 bits
374 , mkRegRegMoveInstr a_reg r_dst_lo ]
376 return $ ChildCode64 code r_dst_lo
380 = pprPanic "iselExpr64(sparc)" (ppr expr)
383 -- | The dual to getAnyReg: compute an expression into a register, but
384 -- we don't mind which one it is.
385 getSomeReg :: CmmExpr -> NatM (Reg, InstrBlock)
387 r <- getRegister expr
390 tmp <- getNewRegNat rep
391 return (tmp, code tmp)
397 getRegister :: CmmExpr -> NatM Register
399 getRegister (CmmReg reg)
400 = return (Fixed (cmmTypeSize (cmmRegType reg))
401 (getRegisterReg reg) nilOL)
403 getRegister tree@(CmmRegOff _ _)
404 = getRegister (mangleIndexTree tree)
406 getRegister (CmmMachOp (MO_UU_Conv W64 W32)
407 [CmmMachOp (MO_U_Shr W64) [x,CmmLit (CmmInt 32 _)]]) = do
408 ChildCode64 code rlo <- iselExpr64 x
409 return $ Fixed II32 (getHiVRegFromLo rlo) code
411 getRegister (CmmMachOp (MO_SS_Conv W64 W32)
412 [CmmMachOp (MO_U_Shr W64) [x,CmmLit (CmmInt 32 _)]]) = do
413 ChildCode64 code rlo <- iselExpr64 x
414 return $ Fixed II32 (getHiVRegFromLo rlo) code
416 getRegister (CmmMachOp (MO_UU_Conv W64 W32) [x]) = do
417 ChildCode64 code rlo <- iselExpr64 x
418 return $ Fixed II32 rlo code
420 getRegister (CmmMachOp (MO_SS_Conv W64 W32) [x]) = do
421 ChildCode64 code rlo <- iselExpr64 x
422 return $ Fixed II32 rlo code
426 -- Load a literal float into a float register.
427 -- The actual literal is stored in a new data area, and we load it
429 getRegister (CmmLit (CmmFloat f W32)) = do
431 -- a label for the new data area
432 lbl <- getNewLabelNat
433 tmp <- getNewRegNat II32
435 let code dst = toOL [
439 CmmStaticLit (CmmFloat f W32)],
442 SETHI (HI (ImmCLbl lbl)) tmp,
443 LD II32 (AddrRegImm tmp (LO (ImmCLbl lbl))) dst]
445 return (Any FF32 code)
447 getRegister (CmmLit (CmmFloat d W64)) = do
448 lbl <- getNewLabelNat
449 tmp <- getNewRegNat II32
450 let code dst = toOL [
453 CmmStaticLit (CmmFloat d W64)],
454 SETHI (HI (ImmCLbl lbl)) tmp,
455 LD II64 (AddrRegImm tmp (LO (ImmCLbl lbl))) dst]
456 return (Any FF64 code)
458 getRegister (CmmMachOp mop [x]) -- unary MachOps
460 MO_F_Neg W32 -> trivialUFCode FF32 (FNEG FF32) x
461 MO_F_Neg W64 -> trivialUFCode FF64 (FNEG FF64) x
463 MO_S_Neg rep -> trivialUCode (intSize rep) (SUB False False g0) x
464 MO_Not rep -> trivialUCode (intSize rep) (XNOR False g0) x
466 MO_FF_Conv W64 W32-> coerceDbl2Flt x
467 MO_FF_Conv W32 W64-> coerceFlt2Dbl x
469 MO_FS_Conv from to -> coerceFP2Int from to x
470 MO_SF_Conv from to -> coerceInt2FP from to x
472 -- Conversions which are a nop on sparc
474 | from == to -> conversionNop (intSize to) x
475 MO_UU_Conv W32 W8 -> trivialCode W8 (AND False) x (CmmLit (CmmInt 255 W8))
476 MO_UU_Conv W32 to -> conversionNop (intSize to) x
477 MO_SS_Conv W32 to -> conversionNop (intSize to) x
479 MO_UU_Conv W8 to@W32 -> conversionNop (intSize to) x
480 MO_UU_Conv W16 to@W32 -> conversionNop (intSize to) x
481 MO_UU_Conv W8 to@W16 -> conversionNop (intSize to) x
484 MO_SS_Conv W8 W32 -> integerExtend W8 W32 x
485 MO_SS_Conv W16 W32 -> integerExtend W16 W32 x
486 MO_SS_Conv W8 W16 -> integerExtend W8 W16 x
488 other_op -> panic ("Unknown unary mach op: " ++ show mop)
491 -- | sign extend and widen
493 :: Width -- ^ width of source expression
494 -> Width -- ^ width of result
495 -> CmmExpr -- ^ source expression
498 integerExtend from to expr
499 = do -- load the expr into some register
500 (reg, e_code) <- getSomeReg expr
501 tmp <- getNewRegNat II32
510 -- local shift word left to load the sign bit
511 `snocOL` SLL reg (RIImm (ImmInt bitCount)) tmp
513 -- arithmetic shift right to sign extend
514 `snocOL` SRA tmp (RIImm (ImmInt bitCount)) dst
516 return (Any (intSize to) code)
519 conversionNop new_rep expr
520 = do e_code <- getRegister expr
521 return (swizzleRegisterRep e_code new_rep)
523 getRegister (CmmMachOp mop [x, y]) -- dyadic PrimOps
525 MO_Eq rep -> condIntReg EQQ x y
526 MO_Ne rep -> condIntReg NE x y
528 MO_S_Gt rep -> condIntReg GTT x y
529 MO_S_Ge rep -> condIntReg GE x y
530 MO_S_Lt rep -> condIntReg LTT x y
531 MO_S_Le rep -> condIntReg LE x y
533 MO_U_Gt W32 -> condIntReg GTT x y
534 MO_U_Ge W32 -> condIntReg GE x y
535 MO_U_Lt W32 -> condIntReg LTT x y
536 MO_U_Le W32 -> condIntReg LE x y
538 MO_U_Gt W16 -> condIntReg GU x y
539 MO_U_Ge W16 -> condIntReg GEU x y
540 MO_U_Lt W16 -> condIntReg LU x y
541 MO_U_Le W16 -> condIntReg LEU x y
543 MO_Add W32 -> trivialCode W32 (ADD False False) x y
544 MO_Sub W32 -> trivialCode W32 (SUB False False) x y
546 MO_S_MulMayOflo rep -> imulMayOflo rep x y
548 MO_S_Quot W32 -> idiv True False x y
549 MO_U_Quot W32 -> idiv False False x y
551 MO_S_Rem W32 -> irem True x y
552 MO_U_Rem W32 -> irem False x y
554 MO_F_Eq w -> condFltReg EQQ x y
555 MO_F_Ne w -> condFltReg NE x y
557 MO_F_Gt w -> condFltReg GTT x y
558 MO_F_Ge w -> condFltReg GE x y
559 MO_F_Lt w -> condFltReg LTT x y
560 MO_F_Le w -> condFltReg LE x y
562 MO_F_Add w -> trivialFCode w FADD x y
563 MO_F_Sub w -> trivialFCode w FSUB x y
564 MO_F_Mul w -> trivialFCode w FMUL x y
565 MO_F_Quot w -> trivialFCode w FDIV x y
567 MO_And rep -> trivialCode rep (AND False) x y
568 MO_Or rep -> trivialCode rep (OR False) x y
569 MO_Xor rep -> trivialCode rep (XOR False) x y
571 MO_Mul rep -> trivialCode rep (SMUL False) x y
573 MO_Shl rep -> trivialCode rep SLL x y
574 MO_U_Shr rep -> trivialCode rep SRL x y
575 MO_S_Shr rep -> trivialCode rep SRA x y
578 MO_F32_Pwr -> getRegister (StCall (Left (fsLit "pow")) CCallConv FF64
579 [promote x, promote y])
580 where promote x = CmmMachOp MO_F32_to_Dbl [x]
581 MO_F64_Pwr -> getRegister (StCall (Left (fsLit "pow")) CCallConv FF64
584 other -> pprPanic "getRegister(sparc) - binary CmmMachOp (1)" (pprMachOp mop)
586 -- idiv fn x y = getRegister (StCall (Left fn) CCallConv II32 [x, y])
589 -- | Generate an integer division instruction.
590 idiv :: Bool -> Bool -> CmmExpr -> CmmExpr -> NatM Register
592 -- For unsigned division with a 32 bit numerator,
593 -- we can just clear the Y register.
594 idiv False cc x y = do
595 (a_reg, a_code) <- getSomeReg x
596 (b_reg, b_code) <- getSomeReg y
603 , UDIV cc a_reg (RIReg b_reg) dst]
605 return (Any II32 code)
608 -- For _signed_ division with a 32 bit numerator,
609 -- we have to sign extend the numerator into the Y register.
610 idiv True cc x y = do
611 (a_reg, a_code) <- getSomeReg x
612 (b_reg, b_code) <- getSomeReg y
614 tmp <- getNewRegNat II32
620 [ SRA a_reg (RIImm (ImmInt 16)) tmp -- sign extend
621 , SRA tmp (RIImm (ImmInt 16)) tmp
624 , SDIV cc a_reg (RIReg b_reg) dst]
626 return (Any II32 code)
629 -- | Do an integer remainder.
631 -- NOTE: The SPARC v8 architecture manual says that integer division
632 -- instructions _may_ generate a remainder, depending on the implementation.
633 -- If so it is _recommended_ that the remainder is placed in the Y register.
635 -- The UltraSparc 2007 manual says Y is _undefined_ after division.
637 -- The SPARC T2 doesn't store the remainder, not sure about the others.
638 -- It's probably best not to worry about it, and just generate our own
641 irem :: Bool -> CmmExpr -> CmmExpr -> NatM Register
643 -- For unsigned operands:
644 -- Division is between a 64 bit numerator and a 32 bit denominator,
645 -- so we still have to clear the Y register.
647 (a_reg, a_code) <- getSomeReg x
648 (b_reg, b_code) <- getSomeReg y
650 tmp_reg <- getNewRegNat II32
657 , UDIV False a_reg (RIReg b_reg) tmp_reg
658 , UMUL False tmp_reg (RIReg b_reg) tmp_reg
659 , SUB False False a_reg (RIReg tmp_reg) dst]
661 return (Any II32 code)
664 -- For signed operands:
665 -- Make sure to sign extend into the Y register, or the remainder
666 -- will have the wrong sign when the numerator is negative.
668 -- TODO: When sign extending, GCC only shifts the a_reg right by 17 bits,
669 -- not the full 32. Not sure why this is, something to do with overflow?
670 -- If anyone cares enough about the speed of signed remainder they
671 -- can work it out themselves (then tell me). -- BL 2009/01/20
674 (a_reg, a_code) <- getSomeReg x
675 (b_reg, b_code) <- getSomeReg y
677 tmp1_reg <- getNewRegNat II32
678 tmp2_reg <- getNewRegNat II32
684 [ SRA a_reg (RIImm (ImmInt 16)) tmp1_reg -- sign extend
685 , SRA tmp1_reg (RIImm (ImmInt 16)) tmp1_reg -- sign extend
688 , SDIV False a_reg (RIReg b_reg) tmp2_reg
689 , SMUL False tmp2_reg (RIReg b_reg) tmp2_reg
690 , SUB False False a_reg (RIReg tmp2_reg) dst]
692 return (Any II32 code)
695 imulMayOflo :: Width -> CmmExpr -> CmmExpr -> NatM Register
696 imulMayOflo rep a b = do
697 (a_reg, a_code) <- getSomeReg a
698 (b_reg, b_code) <- getSomeReg b
699 res_lo <- getNewRegNat II32
700 res_hi <- getNewRegNat II32
702 shift_amt = case rep of
705 _ -> panic "shift_amt"
706 code dst = a_code `appOL` b_code `appOL`
708 SMUL False a_reg (RIReg b_reg) res_lo,
710 SRA res_lo (RIImm (ImmInt shift_amt)) res_lo,
711 SUB False False res_lo (RIReg res_hi) dst
713 return (Any II32 code)
715 getRegister (CmmLoad mem pk) = do
716 Amode src code <- getAmode mem
718 code__2 dst = code `snocOL` LD (cmmTypeSize pk) src dst
719 return (Any (cmmTypeSize pk) code__2)
721 getRegister (CmmLit (CmmInt i _))
724 src = ImmInt (fromInteger i)
725 code dst = unitOL (OR False g0 (RIImm src) dst)
727 return (Any II32 code)
729 getRegister (CmmLit lit)
730 = let rep = cmmLitType lit
734 OR False dst (RIImm (LO imm)) dst]
735 in return (Any II32 code)
739 getAmode :: CmmExpr -> NatM Amode
740 getAmode tree@(CmmRegOff _ _) = getAmode (mangleIndexTree tree)
742 getAmode (CmmMachOp (MO_Sub rep) [x, CmmLit (CmmInt i _)])
745 (reg, code) <- getSomeReg x
747 off = ImmInt (-(fromInteger i))
748 return (Amode (AddrRegImm reg off) code)
751 getAmode (CmmMachOp (MO_Add rep) [x, CmmLit (CmmInt i _)])
754 (reg, code) <- getSomeReg x
756 off = ImmInt (fromInteger i)
757 return (Amode (AddrRegImm reg off) code)
759 getAmode (CmmMachOp (MO_Add rep) [x, y])
761 (regX, codeX) <- getSomeReg x
762 (regY, codeY) <- getSomeReg y
764 code = codeX `appOL` codeY
765 return (Amode (AddrRegReg regX regY) code)
767 getAmode (CmmLit lit)
769 let imm__2 = litToImm lit
770 tmp1 <- getNewRegNat II32
771 tmp2 <- getNewRegNat II32
773 let code = toOL [ SETHI (HI imm__2) tmp1
774 , OR False tmp1 (RIImm (LO imm__2)) tmp2]
776 return (Amode (AddrRegReg tmp2 g0) code)
780 (reg, code) <- getSomeReg other
783 return (Amode (AddrRegImm reg off) code)
786 getCondCode :: CmmExpr -> NatM CondCode
787 getCondCode (CmmMachOp mop [x, y])
790 MO_F_Eq W32 -> condFltCode EQQ x y
791 MO_F_Ne W32 -> condFltCode NE x y
792 MO_F_Gt W32 -> condFltCode GTT x y
793 MO_F_Ge W32 -> condFltCode GE x y
794 MO_F_Lt W32 -> condFltCode LTT x y
795 MO_F_Le W32 -> condFltCode LE x y
797 MO_F_Eq W64 -> condFltCode EQQ x y
798 MO_F_Ne W64 -> condFltCode NE x y
799 MO_F_Gt W64 -> condFltCode GTT x y
800 MO_F_Ge W64 -> condFltCode GE x y
801 MO_F_Lt W64 -> condFltCode LTT x y
802 MO_F_Le W64 -> condFltCode LE x y
804 MO_Eq rep -> condIntCode EQQ x y
805 MO_Ne rep -> condIntCode NE x y
807 MO_S_Gt rep -> condIntCode GTT x y
808 MO_S_Ge rep -> condIntCode GE x y
809 MO_S_Lt rep -> condIntCode LTT x y
810 MO_S_Le rep -> condIntCode LE x y
812 MO_U_Gt rep -> condIntCode GU x y
813 MO_U_Ge rep -> condIntCode GEU x y
814 MO_U_Lt rep -> condIntCode LU x y
815 MO_U_Le rep -> condIntCode LEU x y
817 other -> pprPanic "getCondCode(x86,x86_64,sparc)" (ppr (CmmMachOp mop [x,y]))
819 getCondCode other = pprPanic "getCondCode(2)(x86,sparc)" (ppr other)
825 -- @cond(Int|Flt)Code@: Turn a boolean expression into a condition, to be
826 -- passed back up the tree.
828 condIntCode :: Cond -> CmmExpr -> CmmExpr -> NatM CondCode
829 condIntCode cond x (CmmLit (CmmInt y rep))
832 (src1, code) <- getSomeReg x
834 src2 = ImmInt (fromInteger y)
835 code' = code `snocOL` SUB False True src1 (RIImm src2) g0
836 return (CondCode False cond code')
838 condIntCode cond x y = do
839 (src1, code1) <- getSomeReg x
840 (src2, code2) <- getSomeReg y
842 code__2 = code1 `appOL` code2 `snocOL`
843 SUB False True src1 (RIReg src2) g0
844 return (CondCode False cond code__2)
847 condFltCode :: Cond -> CmmExpr -> CmmExpr -> NatM CondCode
848 condFltCode cond x y = do
849 (src1, code1) <- getSomeReg x
850 (src2, code2) <- getSomeReg y
851 tmp <- getNewRegNat FF64
853 promote x = FxTOy FF32 FF64 x tmp
859 if pk1 `cmmEqType` pk2 then
860 code1 `appOL` code2 `snocOL`
861 FCMP True (cmmTypeSize pk1) src1 src2
862 else if typeWidth pk1 == W32 then
863 code1 `snocOL` promote src1 `appOL` code2 `snocOL`
864 FCMP True FF64 tmp src2
866 code1 `appOL` code2 `snocOL` promote src2 `snocOL`
867 FCMP True FF64 src1 tmp
868 return (CondCode True cond code__2)
872 -- -----------------------------------------------------------------------------
873 -- Generating assignments
875 -- Assignments are really at the heart of the whole code generation
876 -- business. Almost all top-level nodes of any real importance are
877 -- assignments, which correspond to loads, stores, or register
878 -- transfers. If we're really lucky, some of the register transfers
879 -- will go away, because we can use the destination register to
880 -- complete the code generation for the right hand side. This only
881 -- fails when the right hand side is forced into a fixed register
882 -- (e.g. the result of a call).
884 assignMem_IntCode :: Size -> CmmExpr -> CmmExpr -> NatM InstrBlock
885 assignMem_IntCode pk addr src = do
886 (srcReg, code) <- getSomeReg src
887 Amode dstAddr addr_code <- getAmode addr
888 return $ code `appOL` addr_code `snocOL` ST pk srcReg dstAddr
891 assignReg_IntCode :: Size -> CmmReg -> CmmExpr -> NatM InstrBlock
892 assignReg_IntCode pk reg src = do
895 Any _ code -> code dst
896 Fixed _ freg fcode -> fcode `snocOL` OR False g0 (RIReg freg) dst
898 dst = getRegisterReg reg
902 -- Floating point assignment to memory
903 assignMem_FltCode :: Size -> CmmExpr -> CmmExpr -> NatM InstrBlock
904 assignMem_FltCode pk addr src = do
905 Amode dst__2 code1 <- getAmode addr
906 (src__2, code2) <- getSomeReg src
907 tmp1 <- getNewRegNat pk
909 pk__2 = cmmExprType src
910 code__2 = code1 `appOL` code2 `appOL`
911 if sizeToWidth pk == typeWidth pk__2
912 then unitOL (ST pk src__2 dst__2)
913 else toOL [ FxTOy (cmmTypeSize pk__2) pk src__2 tmp1
917 -- Floating point assignment to a register/temporary
918 assignReg_FltCode :: Size -> CmmReg -> CmmExpr -> NatM InstrBlock
919 assignReg_FltCode pk dstCmmReg srcCmmExpr = do
920 srcRegister <- getRegister srcCmmExpr
921 let dstReg = getRegisterReg dstCmmReg
923 return $ case srcRegister of
924 Any _ code -> code dstReg
925 Fixed _ srcFixedReg srcCode -> srcCode `snocOL` FMOV pk srcFixedReg dstReg
930 genJump :: CmmExpr{-the branch target-} -> NatM InstrBlock
932 genJump (CmmLit (CmmLabel lbl))
933 = return (toOL [CALL (Left target) 0 True, NOP])
939 (target, code) <- getSomeReg tree
940 return (code `snocOL` JMP (AddrRegReg target g0) `snocOL` NOP)
942 -- -----------------------------------------------------------------------------
943 -- Unconditional branches
945 genBranch :: BlockId -> NatM InstrBlock
946 genBranch = return . toOL . mkJumpInstr
949 -- -----------------------------------------------------------------------------
953 Conditional jumps are always to local labels, so we can use branch
954 instructions. We peek at the arguments to decide what kind of
957 SPARC: First, we have to ensure that the condition codes are set
958 according to the supplied comparison operation. We generate slightly
959 different code for floating point comparisons, because a floating
960 point operation cannot directly precede a @BF@. We assume the worst
961 and fill that slot with a @NOP@.
963 SPARC: Do not fill the delay slots here; you will confuse the register
969 :: BlockId -- the branch target
970 -> CmmExpr -- the condition on which to branch
975 genCondJump bid bool = do
976 CondCode is_float cond code <- getCondCode bool
981 then [NOP, BF cond False bid, NOP]
982 else [BI cond False bid, NOP]
988 -- -----------------------------------------------------------------------------
989 -- Generating C calls
991 -- Now the biggest nightmare---calls. Most of the nastiness is buried in
992 -- @get_arg@, which moves the arguments to the correct registers/stack
993 -- locations. Apart from that, the code is easy.
995 -- (If applicable) Do not fill the delay slots here; you will confuse the
996 -- register allocator.
999 :: CmmCallTarget -- function to call
1000 -> HintedCmmFormals -- where to put the result
1001 -> HintedCmmActuals -- arguments (of mixed type)
1005 -- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
1008 The SPARC calling convention is an absolute
1009 nightmare. The first 6x32 bits of arguments are mapped into
1010 %o0 through %o5, and the remaining arguments are dumped to the
1011 stack, beginning at [%sp+92]. (Note that %o6 == %sp.)
1013 If we have to put args on the stack, move %o6==%sp down by
1014 the number of words to go on the stack, to ensure there's enough space.
1016 According to Fraser and Hanson's lcc book, page 478, fig 17.2,
1017 16 words above the stack pointer is a word for the address of
1018 a structure return value. I use this as a temporary location
1019 for moving values from float to int regs. Certainly it isn't
1020 safe to put anything in the 16 words starting at %sp, since
1021 this area can get trashed at any time due to window overflows
1022 caused by signal handlers.
1024 A final complication (if the above isn't enough) is that
1025 we can't blithely calculate the arguments one by one into
1026 %o0 .. %o5. Consider the following nested calls:
1030 Naive code moves a into %o0, and (fff b c) into %o1. Unfortunately
1031 the inner call will itself use %o0, which trashes the value put there
1032 in preparation for the outer call. Upshot: we need to calculate the
1033 args into temporary regs, and move those to arg regs or onto the
1034 stack only immediately prior to the call proper. Sigh.
1037 :: CmmCallTarget -- function to call
1038 -> HintedCmmFormals -- where to put the result
1039 -> HintedCmmActuals -- arguments (of mixed type)
1045 -- On SPARC under TSO (Total Store Ordering), writes earlier in the instruction stream
1046 -- are guaranteed to take place before writes afterwards (unlike on PowerPC).
1047 -- Ref: Section 8.4 of the SPARC V9 Architecture manual.
1049 -- In the SPARC case we don't need a barrier.
1051 genCCall (CmmPrim (MO_WriteBarrier)) _ _
1054 genCCall target dest_regs argsAndHints
1056 -- strip hints from the arg regs
1057 let args :: [CmmExpr]
1058 args = map hintlessCmm argsAndHints
1061 -- work out the arguments, and assign them to integer regs
1062 argcode_and_vregs <- mapM arg_to_int_vregs args
1063 let (argcodes, vregss) = unzip argcode_and_vregs
1064 let vregs = concat vregss
1066 let n_argRegs = length allArgRegs
1067 let n_argRegs_used = min (length vregs) n_argRegs
1070 -- deal with static vs dynamic call targets
1071 callinsns <- case target of
1072 CmmCallee (CmmLit (CmmLabel lbl)) conv ->
1073 return (unitOL (CALL (Left (litToImm (CmmLabel lbl))) n_argRegs_used False))
1076 -> do (dyn_c, [dyn_r]) <- arg_to_int_vregs expr
1077 return (dyn_c `snocOL` CALL (Right dyn_r) n_argRegs_used False)
1080 -> do res <- outOfLineFloatOp mop
1081 lblOrMopExpr <- case res of
1083 return (unitOL (CALL (Left (litToImm (CmmLabel lbl))) n_argRegs_used False))
1086 (dyn_c, [dyn_r]) <- arg_to_int_vregs mopExpr
1087 return (dyn_c `snocOL` CALL (Right dyn_r) n_argRegs_used False)
1091 let argcode = concatOL argcodes
1093 let (move_sp_down, move_sp_up)
1094 = let diff = length vregs - n_argRegs
1095 nn = if odd diff then diff + 1 else diff -- keep 8-byte alignment
1098 else (unitOL (moveSp (-1*nn)), unitOL (moveSp (1*nn)))
1101 = toOL (move_final vregs allArgRegs eXTRA_STK_ARGS_HERE)
1105 move_sp_down `appOL`
1106 transfer_code `appOL`
1110 assign_code dest_regs
1113 -- | Generate code to calculate an argument, and move it into one
1114 -- or two integer vregs.
1115 arg_to_int_vregs :: CmmExpr -> NatM (OrdList Instr, [Reg])
1116 arg_to_int_vregs arg
1118 -- If the expr produces a 64 bit int, then we can just use iselExpr64
1119 | isWord64 (cmmExprType arg)
1120 = do (ChildCode64 code r_lo) <- iselExpr64 arg
1121 let r_hi = getHiVRegFromLo r_lo
1122 return (code, [r_hi, r_lo])
1125 = do (src, code) <- getSomeReg arg
1126 tmp <- getNewRegNat (cmmTypeSize $ cmmExprType arg)
1127 let pk = cmmExprType arg
1129 case cmmTypeSize pk of
1131 -- Load a 64 bit float return value into two integer regs.
1133 v1 <- getNewRegNat II32
1134 v2 <- getNewRegNat II32
1136 let Just f0_high = fPair f0
1140 FMOV FF64 src f0 `snocOL`
1141 ST FF32 f0 (spRel 16) `snocOL`
1142 LD II32 (spRel 16) v1 `snocOL`
1143 ST FF32 f0_high (spRel 16) `snocOL`
1144 LD II32 (spRel 16) v2
1146 return (code2, [v1,v2])
1148 -- Load a 32 bit float return value into an integer reg
1150 v1 <- getNewRegNat II32
1154 ST FF32 src (spRel 16) `snocOL`
1155 LD II32 (spRel 16) v1
1157 return (code2, [v1])
1159 -- Move an integer return value into its destination reg.
1161 v1 <- getNewRegNat II32
1165 OR False g0 (RIReg src) v1
1167 return (code2, [v1])
1170 -- | Move args from the integer vregs into which they have been
1171 -- marshalled, into %o0 .. %o5, and the rest onto the stack.
1173 move_final :: [Reg] -> [Reg] -> Int -> [Instr]
1176 move_final [] _ offset
1179 -- out of aregs; move to stack
1180 move_final (v:vs) [] offset
1181 = ST II32 v (spRel offset)
1182 : move_final vs [] (offset+1)
1184 -- move into an arg (%o[0..5]) reg
1185 move_final (v:vs) (a:az) offset
1186 = OR False g0 (RIReg v) a
1187 : move_final vs az offset
1190 -- | Assign results returned from the call into their
1193 assign_code :: [CmmHinted LocalReg] -> OrdList Instr
1194 assign_code [] = nilOL
1196 assign_code [CmmHinted dest _hint]
1197 = let rep = localRegType dest
1198 width = typeWidth rep
1199 r_dest = getRegisterReg (CmmLocal dest)
1204 = unitOL $ FMOV FF32 (RealReg $ fReg 0) r_dest
1208 = unitOL $ FMOV FF64 (RealReg $ fReg 0) r_dest
1210 | not $ isFloatType rep
1212 = unitOL $ mkRegRegMoveInstr (RealReg $ oReg 0) r_dest
1214 | not $ isFloatType rep
1216 , r_dest_hi <- getHiVRegFromLo r_dest
1217 = toOL [ mkRegRegMoveInstr (RealReg $ oReg 0) r_dest_hi
1218 , mkRegRegMoveInstr (RealReg $ oReg 1) r_dest]
1222 -- | Generate a call to implement an out-of-line floating point operation
1225 -> NatM (Either CLabel CmmExpr)
1227 outOfLineFloatOp mop
1228 = do let functionName
1229 = outOfLineFloatOp_table mop
1231 dflags <- getDynFlagsNat
1232 mopExpr <- cmmMakeDynamicReference dflags addImportNat CallReference
1233 $ mkForeignLabel functionName Nothing True IsFunction
1237 CmmLit (CmmLabel lbl) -> Left lbl
1240 return mopLabelOrExpr
1243 -- | Decide what C function to use to implement a CallishMachOp
1245 outOfLineFloatOp_table
1249 outOfLineFloatOp_table mop
1251 MO_F32_Exp -> fsLit "expf"
1252 MO_F32_Log -> fsLit "logf"
1253 MO_F32_Sqrt -> fsLit "sqrtf"
1254 MO_F32_Pwr -> fsLit "powf"
1256 MO_F32_Sin -> fsLit "sinf"
1257 MO_F32_Cos -> fsLit "cosf"
1258 MO_F32_Tan -> fsLit "tanf"
1260 MO_F32_Asin -> fsLit "asinf"
1261 MO_F32_Acos -> fsLit "acosf"
1262 MO_F32_Atan -> fsLit "atanf"
1264 MO_F32_Sinh -> fsLit "sinhf"
1265 MO_F32_Cosh -> fsLit "coshf"
1266 MO_F32_Tanh -> fsLit "tanhf"
1268 MO_F64_Exp -> fsLit "exp"
1269 MO_F64_Log -> fsLit "log"
1270 MO_F64_Sqrt -> fsLit "sqrt"
1271 MO_F64_Pwr -> fsLit "pow"
1273 MO_F64_Sin -> fsLit "sin"
1274 MO_F64_Cos -> fsLit "cos"
1275 MO_F64_Tan -> fsLit "tan"
1277 MO_F64_Asin -> fsLit "asin"
1278 MO_F64_Acos -> fsLit "acos"
1279 MO_F64_Atan -> fsLit "atan"
1281 MO_F64_Sinh -> fsLit "sinh"
1282 MO_F64_Cosh -> fsLit "cosh"
1283 MO_F64_Tanh -> fsLit "tanh"
1285 other -> pprPanic "outOfLineFloatOp(sparc): Unknown callish mach op "
1286 (pprCallishMachOp mop)
1289 -- -----------------------------------------------------------------------------
1290 -- Generating a table-branch
1292 genSwitch :: CmmExpr -> [Maybe BlockId] -> NatM InstrBlock
1295 = error "MachCodeGen: sparc genSwitch PIC not finished\n"
1298 = do (e_reg, e_code) <- getSomeReg expr
1300 base_reg <- getNewRegNat II32
1301 offset_reg <- getNewRegNat II32
1302 dst <- getNewRegNat II32
1304 label <- getNewLabelNat
1305 let jumpTable = map jumpTableEntry ids
1307 return $ e_code `appOL`
1310 [ LDATA ReadOnlyData (CmmDataLabel label : jumpTable)
1312 -- load base of jump table
1313 , SETHI (HI (ImmCLbl label)) base_reg
1314 , OR False base_reg (RIImm $ LO $ ImmCLbl label) base_reg
1316 -- the addrs in the table are 32 bits wide..
1317 , SLL e_reg (RIImm $ ImmInt 2) offset_reg
1319 -- load and jump to the destination
1320 , LD II32 (AddrRegReg base_reg offset_reg) dst
1321 , JMP_TBL (AddrRegImm dst (ImmInt 0)) [i | Just i <- ids]
1326 -- -----------------------------------------------------------------------------
1327 -- 'condIntReg' and 'condFltReg': condition codes into registers
1329 -- Turn those condition codes into integers now (when they appear on
1330 -- the right hand side of an assignment).
1332 -- (If applicable) Do not fill the delay slots here; you will confuse the
1333 -- register allocator.
1335 condIntReg, condFltReg :: Cond -> CmmExpr -> CmmExpr -> NatM Register
1337 condIntReg EQQ x (CmmLit (CmmInt 0 d)) = do
1338 (src, code) <- getSomeReg x
1339 tmp <- getNewRegNat II32
1341 code__2 dst = code `appOL` toOL [
1342 SUB False True g0 (RIReg src) g0,
1343 SUB True False g0 (RIImm (ImmInt (-1))) dst]
1344 return (Any II32 code__2)
1346 condIntReg EQQ x y = do
1347 (src1, code1) <- getSomeReg x
1348 (src2, code2) <- getSomeReg y
1349 tmp1 <- getNewRegNat II32
1350 tmp2 <- getNewRegNat II32
1352 code__2 dst = code1 `appOL` code2 `appOL` toOL [
1353 XOR False src1 (RIReg src2) dst,
1354 SUB False True g0 (RIReg dst) g0,
1355 SUB True False g0 (RIImm (ImmInt (-1))) dst]
1356 return (Any II32 code__2)
1358 condIntReg NE x (CmmLit (CmmInt 0 d)) = do
1359 (src, code) <- getSomeReg x
1360 tmp <- getNewRegNat II32
1362 code__2 dst = code `appOL` toOL [
1363 SUB False True g0 (RIReg src) g0,
1364 ADD True False g0 (RIImm (ImmInt 0)) dst]
1365 return (Any II32 code__2)
1367 condIntReg NE x y = do
1368 (src1, code1) <- getSomeReg x
1369 (src2, code2) <- getSomeReg y
1370 tmp1 <- getNewRegNat II32
1371 tmp2 <- getNewRegNat II32
1373 code__2 dst = code1 `appOL` code2 `appOL` toOL [
1374 XOR False src1 (RIReg src2) dst,
1375 SUB False True g0 (RIReg dst) g0,
1376 ADD True False g0 (RIImm (ImmInt 0)) dst]
1377 return (Any II32 code__2)
1379 condIntReg cond x y = do
1380 bid1@(BlockId lbl1) <- getBlockIdNat
1381 bid2@(BlockId lbl2) <- getBlockIdNat
1382 CondCode _ cond cond_code <- condIntCode cond x y
1384 code__2 dst = cond_code `appOL` toOL [
1385 BI cond False bid1, NOP,
1386 OR False g0 (RIImm (ImmInt 0)) dst,
1387 BI ALWAYS False bid2, NOP,
1389 OR False g0 (RIImm (ImmInt 1)) dst,
1391 return (Any II32 code__2)
1393 condFltReg cond x y = do
1394 bid1@(BlockId lbl1) <- getBlockIdNat
1395 bid2@(BlockId lbl2) <- getBlockIdNat
1396 CondCode _ cond cond_code <- condFltCode cond x y
1398 code__2 dst = cond_code `appOL` toOL [
1400 BF cond False bid1, NOP,
1401 OR False g0 (RIImm (ImmInt 0)) dst,
1402 BI ALWAYS False bid2, NOP,
1404 OR False g0 (RIImm (ImmInt 1)) dst,
1406 return (Any II32 code__2)
1410 -- -----------------------------------------------------------------------------
1411 -- 'trivial*Code': deal with trivial instructions
1413 -- Trivial (dyadic: 'trivialCode', floating-point: 'trivialFCode',
1414 -- unary: 'trivialUCode', unary fl-pt:'trivialUFCode') instructions.
1415 -- Only look for constants on the right hand side, because that's
1416 -- where the generic optimizer will have put them.
1418 -- Similarly, for unary instructions, we don't have to worry about
1419 -- matching an StInt as the argument, because genericOpt will already
1420 -- have handled the constant-folding.
1422 trivialCode pk instr x (CmmLit (CmmInt y d))
1425 (src1, code) <- getSomeReg x
1426 tmp <- getNewRegNat II32
1428 src2 = ImmInt (fromInteger y)
1429 code__2 dst = code `snocOL` instr src1 (RIImm src2) dst
1430 return (Any II32 code__2)
1432 trivialCode pk instr x y = do
1433 (src1, code1) <- getSomeReg x
1434 (src2, code2) <- getSomeReg y
1435 tmp1 <- getNewRegNat II32
1436 tmp2 <- getNewRegNat II32
1438 code__2 dst = code1 `appOL` code2 `snocOL`
1439 instr src1 (RIReg src2) dst
1440 return (Any II32 code__2)
1443 trivialFCode pk instr x y = do
1444 (src1, code1) <- getSomeReg x
1445 (src2, code2) <- getSomeReg y
1446 tmp1 <- getNewRegNat (cmmTypeSize $ cmmExprType x)
1447 tmp2 <- getNewRegNat (cmmTypeSize $ cmmExprType y)
1448 tmp <- getNewRegNat FF64
1450 promote x = FxTOy FF32 FF64 x tmp
1456 if pk1 `cmmEqType` pk2 then
1457 code1 `appOL` code2 `snocOL`
1458 instr (floatSize pk) src1 src2 dst
1459 else if typeWidth pk1 == W32 then
1460 code1 `snocOL` promote src1 `appOL` code2 `snocOL`
1461 instr FF64 tmp src2 dst
1463 code1 `appOL` code2 `snocOL` promote src2 `snocOL`
1464 instr FF64 src1 tmp dst
1465 return (Any (cmmTypeSize $ if pk1 `cmmEqType` pk2 then pk1 else cmmFloat W64)
1469 trivialUCode size instr x = do
1470 (src, code) <- getSomeReg x
1471 tmp <- getNewRegNat size
1473 code__2 dst = code `snocOL` instr (RIReg src) dst
1474 return (Any size code__2)
1477 trivialUFCode pk instr x = do
1478 (src, code) <- getSomeReg x
1479 tmp <- getNewRegNat pk
1481 code__2 dst = code `snocOL` instr src dst
1482 return (Any pk code__2)
1486 coerceDbl2Flt :: CmmExpr -> NatM Register
1487 coerceFlt2Dbl :: CmmExpr -> NatM Register
1490 coerceInt2FP width1 width2 x = do
1491 (src, code) <- getSomeReg x
1493 code__2 dst = code `appOL` toOL [
1494 ST (intSize width1) src (spRel (-2)),
1495 LD (intSize width1) (spRel (-2)) dst,
1496 FxTOy (intSize width1) (floatSize width2) dst dst]
1497 return (Any (floatSize $ width2) code__2)
1500 -- | Coerce a floating point value to integer
1502 -- NOTE: On sparc v9 there are no instructions to move a value from an
1503 -- FP register directly to an int register, so we have to use a load/store.
1505 coerceFP2Int width1 width2 x
1506 = do let fsize1 = floatSize width1
1507 fsize2 = floatSize width2
1509 isize2 = intSize width2
1511 (fsrc, code) <- getSomeReg x
1512 fdst <- getNewRegNat fsize2
1517 -- convert float to int format, leaving it in a float reg.
1518 [ FxTOy fsize1 isize2 fsrc fdst
1520 -- store the int into mem, then load it back to move
1521 -- it into an actual int reg.
1522 , ST fsize2 fdst (spRel (-2))
1523 , LD isize2 (spRel (-2)) dst]
1525 return (Any isize2 code2)
1528 coerceDbl2Flt x = do
1529 (src, code) <- getSomeReg x
1530 return (Any FF32 (\dst -> code `snocOL` FxTOy FF64 FF32 src dst))
1533 coerceFlt2Dbl x = do
1534 (src, code) <- getSomeReg x
1535 return (Any FF64 (\dst -> code `snocOL` FxTOy FF32 FF64 src dst))
1539 -- eXTRA_STK_ARGS_HERE
1541 -- We (allegedly) put the first six C-call arguments in registers;
1542 -- where do we start putting the rest of them?
1544 -- Moved from Instrs (SDM):
1546 eXTRA_STK_ARGS_HERE :: Int