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"
32 -- Our intermediate code:
39 import StaticFlags ( opt_PIC )
41 import qualified Outputable as O
45 import Control.Monad ( mapAndUnzipM )
49 -- | Top level code generation
53 -> NatM [NatCmmTop Instr]
56 (CmmProc info lab params (ListGraph blocks))
58 (nat_blocks,statics) <- mapAndUnzipM basicBlockCodeGen blocks
60 -- picBaseMb <- getPicBaseMaybeNat
61 let proc = CmmProc info lab params (ListGraph $ concat nat_blocks)
62 let tops = proc : concat statics
65 -- Just picBase -> initializePicBase picBase tops
66 -- Nothing -> return tops
71 cmmTopCodeGen _ (CmmData sec dat) = do
72 return [CmmData sec dat] -- no translation, we just use CmmStatic
78 -> NatM ( [NatBasicBlock Instr]
81 basicBlockCodeGen (BasicBlock id stmts) = do
82 instrs <- stmtsToInstrs stmts
83 -- code generation may introduce new basic block boundaries, which
84 -- are indicated by the NEWBLOCK instruction. We must split up the
85 -- instruction stream into basic blocks again. Also, we extract
88 (top,other_blocks,statics) = foldrOL mkBlocks ([],[],[]) instrs
90 mkBlocks (NEWBLOCK id) (instrs,blocks,statics)
91 = ([], BasicBlock id instrs : blocks, statics)
92 mkBlocks (LDATA sec dat) (instrs,blocks,statics)
93 = (instrs, blocks, CmmData sec dat:statics)
94 mkBlocks instr (instrs,blocks,statics)
95 = (instr:instrs, blocks, statics)
97 return (BasicBlock id top : other_blocks, statics)
100 stmtsToInstrs :: [CmmStmt] -> NatM InstrBlock
102 = do instrss <- mapM stmtToInstrs stmts
103 return (concatOL instrss)
106 stmtToInstrs :: CmmStmt -> NatM InstrBlock
107 stmtToInstrs stmt = case stmt of
108 CmmNop -> return nilOL
109 CmmComment s -> return (unitOL (COMMENT s))
112 | isFloatType ty -> assignReg_FltCode size reg src
113 | isWord64 ty -> assignReg_I64Code reg src
114 | otherwise -> assignReg_IntCode size reg src
115 where ty = cmmRegType reg
116 size = cmmTypeSize ty
119 | isFloatType ty -> assignMem_FltCode size addr src
120 | isWord64 ty -> assignMem_I64Code addr src
121 | otherwise -> assignMem_IntCode size addr src
122 where ty = cmmExprType src
123 size = cmmTypeSize ty
125 CmmCall target result_regs args _ _
126 -> genCCall target result_regs args
128 CmmBranch id -> genBranch id
129 CmmCondBranch arg id -> genCondJump id arg
130 CmmSwitch arg ids -> genSwitch arg ids
131 CmmJump arg _ -> genJump arg
134 -> panic "stmtToInstrs: return statement should have been cps'd away"
137 --------------------------------------------------------------------------------
138 -- | 'InstrBlock's are the insn sequences generated by the insn selectors.
139 -- They are really trees of insns to facilitate fast appending, where a
140 -- left-to-right traversal yields the insns in the correct order.
146 -- | Condition codes passed up the tree.
149 = CondCode Bool Cond InstrBlock
152 -- | a.k.a "Register64"
153 -- Reg is the lower 32-bit temporary which contains the result.
154 -- Use getHiVRegFromLo to find the other VRegUnique.
156 -- Rules of this simplified insn selection game are therefore that
157 -- the returned Reg may be modified
165 -- | Register's passed up the tree. If the stix code forces the register
166 -- to live in a pre-decided machine register, it comes out as @Fixed@;
167 -- otherwise, it comes out as @Any@, and the parent can decide which
168 -- register to put it in.
171 = Fixed Size Reg InstrBlock
172 | Any Size (Reg -> InstrBlock)
175 swizzleRegisterRep :: Register -> Size -> Register
176 swizzleRegisterRep (Fixed _ reg code) size = Fixed size reg code
177 swizzleRegisterRep (Any _ codefn) size = Any size codefn
180 -- | Grab the Reg for a CmmReg
181 getRegisterReg :: CmmReg -> Reg
183 getRegisterReg (CmmLocal (LocalReg u pk))
184 = mkVReg u (cmmTypeSize pk)
186 getRegisterReg (CmmGlobal mid)
187 = case get_GlobalReg_reg_or_addr mid of
188 Left (RealReg rrno) -> RealReg rrno
189 _other -> pprPanic "getRegisterReg-memory" (ppr $ CmmGlobal mid)
190 -- By this stage, the only MagicIds remaining should be the
191 -- ones which map to a real machine register on this
192 -- platform. Hence ...
195 -- | Memory addressing modes passed up the tree.
197 = Amode AddrMode InstrBlock
200 Now, given a tree (the argument to an CmmLoad) that references memory,
201 produce a suitable addressing mode.
203 A Rule of the Game (tm) for Amodes: use of the addr bit must
204 immediately follow use of the code part, since the code part puts
205 values in registers which the addr then refers to. So you can't put
206 anything in between, lest it overwrite some of those registers. If
207 you need to do some other computation between the code part and use of
208 the addr bit, first store the effective address from the amode in a
209 temporary, then do the other computation, and then use the temporary:
213 ... other computation ...
218 -- | Check whether an integer will fit in 32 bits.
219 -- A CmmInt is intended to be truncated to the appropriate
220 -- number of bits, so here we truncate it to Int64. This is
221 -- important because e.g. -1 as a CmmInt might be either
222 -- -1 or 18446744073709551615.
224 is32BitInteger :: Integer -> Bool
225 is32BitInteger i = i64 <= 0x7fffffff && i64 >= -0x80000000
226 where i64 = fromIntegral i :: Int64
229 -- | Convert a BlockId to some CmmStatic data
230 jumpTableEntry :: Maybe BlockId -> CmmStatic
231 jumpTableEntry Nothing = CmmStaticLit (CmmInt 0 wordWidth)
232 jumpTableEntry (Just (BlockId id)) = CmmStaticLit (CmmLabel blockLabel)
233 where blockLabel = mkAsmTempLabel id
238 -- -----------------------------------------------------------------------------
239 -- General things for putting together code sequences
241 -- Expand CmmRegOff. ToDo: should we do it this way around, or convert
242 -- CmmExprs into CmmRegOff?
243 mangleIndexTree :: CmmExpr -> CmmExpr
244 mangleIndexTree (CmmRegOff reg off)
245 = CmmMachOp (MO_Add width) [CmmReg reg, CmmLit (CmmInt (fromIntegral off) width)]
246 where width = typeWidth (cmmRegType reg)
249 assignMem_I64Code :: CmmExpr -> CmmExpr -> NatM InstrBlock
250 assignMem_I64Code addrTree valueTree = do
251 Amode _ addr_code <- getAmode addrTree
252 ChildCode64 vcode rlo <- iselExpr64 valueTree
254 (src, code) <- getSomeReg addrTree
256 rhi = getHiVRegFromLo rlo
258 mov_hi = ST II32 rhi (AddrRegImm src (ImmInt 0))
259 mov_lo = ST II32 rlo (AddrRegImm src (ImmInt 4))
261 return (vcode `appOL` code `snocOL` mov_hi `snocOL` mov_lo)
264 assignReg_I64Code :: CmmReg -> CmmExpr -> NatM InstrBlock
265 assignReg_I64Code (CmmLocal (LocalReg u_dst pk)) valueTree = do
266 ChildCode64 vcode r_src_lo <- iselExpr64 valueTree
268 r_dst_lo = mkVReg u_dst (cmmTypeSize pk)
269 r_dst_hi = getHiVRegFromLo r_dst_lo
270 r_src_hi = getHiVRegFromLo r_src_lo
271 mov_lo = mkMOV r_src_lo r_dst_lo
272 mov_hi = mkMOV r_src_hi r_dst_hi
273 mkMOV sreg dreg = OR False g0 (RIReg sreg) dreg
274 return (vcode `snocOL` mov_hi `snocOL` mov_lo)
275 assignReg_I64Code lvalue valueTree
276 = panic "assignReg_I64Code(sparc): invalid lvalue"
279 -- Load a 64 bit word
280 iselExpr64 (CmmLoad addrTree ty)
282 = do Amode amode addr_code <- getAmode addrTree
285 | AddrRegReg r1 r2 <- amode
286 = do rlo <- getNewRegNat II32
287 tmp <- getNewRegNat II32
288 let rhi = getHiVRegFromLo rlo
293 [ ADD False False r1 (RIReg r2) tmp
294 , LD II32 (AddrRegImm tmp (ImmInt 0)) rhi
295 , LD II32 (AddrRegImm tmp (ImmInt 4)) rlo ])
298 | AddrRegImm r1 (ImmInt i) <- amode
299 = do rlo <- getNewRegNat II32
300 let rhi = getHiVRegFromLo rlo
305 [ LD II32 (AddrRegImm r1 (ImmInt $ 0 + i)) rhi
306 , LD II32 (AddrRegImm r1 (ImmInt $ 4 + i)) rlo ])
312 -- Add a literal to a 64 bit integer
313 iselExpr64 (CmmMachOp (MO_Add _) [e1, CmmLit (CmmInt i _)])
314 = do ChildCode64 code1 r1_lo <- iselExpr64 e1
315 let r1_hi = getHiVRegFromLo r1_lo
317 r_dst_lo <- getNewRegNat II32
318 let r_dst_hi = getHiVRegFromLo r_dst_lo
322 [ ADD False False r1_lo (RIImm (ImmInteger i)) r_dst_lo
323 , ADD True False r1_hi (RIReg g0) r_dst_hi ])
328 iselExpr64 (CmmMachOp (MO_Add width) [e1, e2])
329 = do ChildCode64 code1 r1_lo <- iselExpr64 e1
330 let r1_hi = getHiVRegFromLo r1_lo
332 ChildCode64 code2 r2_lo <- iselExpr64 e2
333 let r2_hi = getHiVRegFromLo r2_lo
335 r_dst_lo <- getNewRegNat II32
336 let r_dst_hi = getHiVRegFromLo r_dst_lo
341 [ ADD False False r1_lo (RIReg r2_lo) r_dst_lo
342 , ADD True False r1_hi (RIReg r2_hi) r_dst_hi ]
344 return $ ChildCode64 code r_dst_lo
347 iselExpr64 (CmmReg (CmmLocal (LocalReg uq ty))) | isWord64 ty = do
348 r_dst_lo <- getNewRegNat II32
349 let r_dst_hi = getHiVRegFromLo r_dst_lo
350 r_src_lo = mkVReg uq II32
351 r_src_hi = getHiVRegFromLo r_src_lo
352 mov_lo = mkMOV r_src_lo r_dst_lo
353 mov_hi = mkMOV r_src_hi r_dst_hi
354 mkMOV sreg dreg = OR False g0 (RIReg sreg) dreg
356 ChildCode64 (toOL [mov_hi, mov_lo]) r_dst_lo
359 -- Convert something into II64
360 iselExpr64 (CmmMachOp (MO_UU_Conv _ W64) [expr])
362 r_dst_lo <- getNewRegNat II32
363 let r_dst_hi = getHiVRegFromLo r_dst_lo
365 -- compute expr and load it into r_dst_lo
366 (a_reg, a_code) <- getSomeReg expr
370 [ mkRegRegMoveInstr g0 r_dst_hi -- clear high 32 bits
371 , mkRegRegMoveInstr a_reg r_dst_lo ]
373 return $ ChildCode64 code r_dst_lo
377 = pprPanic "iselExpr64(sparc)" (ppr expr)
380 -- | The dual to getAnyReg: compute an expression into a register, but
381 -- we don't mind which one it is.
382 getSomeReg :: CmmExpr -> NatM (Reg, InstrBlock)
384 r <- getRegister expr
387 tmp <- getNewRegNat rep
388 return (tmp, code tmp)
394 getRegister :: CmmExpr -> NatM Register
396 getRegister (CmmReg reg)
397 = return (Fixed (cmmTypeSize (cmmRegType reg))
398 (getRegisterReg reg) nilOL)
400 getRegister tree@(CmmRegOff _ _)
401 = getRegister (mangleIndexTree tree)
403 getRegister (CmmMachOp (MO_UU_Conv W64 W32)
404 [CmmMachOp (MO_U_Shr W64) [x,CmmLit (CmmInt 32 _)]]) = do
405 ChildCode64 code rlo <- iselExpr64 x
406 return $ Fixed II32 (getHiVRegFromLo rlo) code
408 getRegister (CmmMachOp (MO_SS_Conv W64 W32)
409 [CmmMachOp (MO_U_Shr W64) [x,CmmLit (CmmInt 32 _)]]) = do
410 ChildCode64 code rlo <- iselExpr64 x
411 return $ Fixed II32 (getHiVRegFromLo rlo) code
413 getRegister (CmmMachOp (MO_UU_Conv W64 W32) [x]) = do
414 ChildCode64 code rlo <- iselExpr64 x
415 return $ Fixed II32 rlo code
417 getRegister (CmmMachOp (MO_SS_Conv W64 W32) [x]) = do
418 ChildCode64 code rlo <- iselExpr64 x
419 return $ Fixed II32 rlo code
423 -- Load a literal float into a float register.
424 -- The actual literal is stored in a new data area, and we load it
426 getRegister (CmmLit (CmmFloat f W32)) = do
428 -- a label for the new data area
429 lbl <- getNewLabelNat
430 tmp <- getNewRegNat II32
432 let code dst = toOL [
436 CmmStaticLit (CmmFloat f W32)],
439 SETHI (HI (ImmCLbl lbl)) tmp,
440 LD II32 (AddrRegImm tmp (LO (ImmCLbl lbl))) dst]
442 return (Any FF32 code)
444 getRegister (CmmLit (CmmFloat d W64)) = do
445 lbl <- getNewLabelNat
446 tmp <- getNewRegNat II32
447 let code dst = toOL [
450 CmmStaticLit (CmmFloat d W64)],
451 SETHI (HI (ImmCLbl lbl)) tmp,
452 LD II64 (AddrRegImm tmp (LO (ImmCLbl lbl))) dst]
453 return (Any FF64 code)
455 getRegister (CmmMachOp mop [x]) -- unary MachOps
457 MO_F_Neg W32 -> trivialUFCode FF32 (FNEG FF32) x
458 MO_F_Neg W64 -> trivialUFCode FF64 (FNEG FF64) x
460 MO_S_Neg rep -> trivialUCode (intSize rep) (SUB False False g0) x
461 MO_Not rep -> trivialUCode (intSize rep) (XNOR False g0) x
463 MO_FF_Conv W64 W32-> coerceDbl2Flt x
464 MO_FF_Conv W32 W64-> coerceFlt2Dbl x
466 MO_FS_Conv from to -> coerceFP2Int from to x
467 MO_SF_Conv from to -> coerceInt2FP from to x
469 -- Conversions which are a nop on sparc
471 | from == to -> conversionNop (intSize to) x
472 MO_UU_Conv W32 W8 -> trivialCode W8 (AND False) x (CmmLit (CmmInt 255 W8))
473 MO_UU_Conv W32 to -> conversionNop (intSize to) x
474 MO_SS_Conv W32 to -> conversionNop (intSize to) x
476 MO_UU_Conv W8 to@W32 -> conversionNop (intSize to) x
477 MO_UU_Conv W16 to@W32 -> conversionNop (intSize to) x
478 MO_UU_Conv W8 to@W16 -> conversionNop (intSize to) x
481 MO_SS_Conv W8 W32 -> integerExtend W8 W32 x
482 MO_SS_Conv W16 W32 -> integerExtend W16 W32 x
483 MO_SS_Conv W8 W16 -> integerExtend W8 W16 x
485 other_op -> panic ("Unknown unary mach op: " ++ show mop)
488 -- | sign extend and widen
490 :: Width -- ^ width of source expression
491 -> Width -- ^ width of result
492 -> CmmExpr -- ^ source expression
495 integerExtend from to expr
496 = do -- load the expr into some register
497 (reg, e_code) <- getSomeReg expr
498 tmp <- getNewRegNat II32
507 -- local shift word left to load the sign bit
508 `snocOL` SLL reg (RIImm (ImmInt bitCount)) tmp
510 -- arithmetic shift right to sign extend
511 `snocOL` SRA tmp (RIImm (ImmInt bitCount)) dst
513 return (Any (intSize to) code)
516 conversionNop new_rep expr
517 = do e_code <- getRegister expr
518 return (swizzleRegisterRep e_code new_rep)
520 getRegister (CmmMachOp mop [x, y]) -- dyadic PrimOps
522 MO_Eq rep -> condIntReg EQQ x y
523 MO_Ne rep -> condIntReg NE x y
525 MO_S_Gt rep -> condIntReg GTT x y
526 MO_S_Ge rep -> condIntReg GE x y
527 MO_S_Lt rep -> condIntReg LTT x y
528 MO_S_Le rep -> condIntReg LE x y
530 MO_U_Gt W32 -> condIntReg GTT x y
531 MO_U_Ge W32 -> condIntReg GE x y
532 MO_U_Lt W32 -> condIntReg LTT x y
533 MO_U_Le W32 -> condIntReg LE x y
535 MO_U_Gt W16 -> condIntReg GU x y
536 MO_U_Ge W16 -> condIntReg GEU x y
537 MO_U_Lt W16 -> condIntReg LU x y
538 MO_U_Le W16 -> condIntReg LEU x y
540 MO_Add W32 -> trivialCode W32 (ADD False False) x y
541 MO_Sub W32 -> trivialCode W32 (SUB False False) x y
543 MO_S_MulMayOflo rep -> imulMayOflo rep x y
545 MO_S_Quot W32 -> idiv True False x y
546 MO_U_Quot W32 -> idiv False False x y
548 MO_S_Rem W32 -> irem True x y
549 MO_U_Rem W32 -> irem False x y
551 MO_F_Eq w -> condFltReg EQQ x y
552 MO_F_Ne w -> condFltReg NE x y
554 MO_F_Gt w -> condFltReg GTT x y
555 MO_F_Ge w -> condFltReg GE x y
556 MO_F_Lt w -> condFltReg LTT x y
557 MO_F_Le w -> condFltReg LE x y
559 MO_F_Add w -> trivialFCode w FADD x y
560 MO_F_Sub w -> trivialFCode w FSUB x y
561 MO_F_Mul w -> trivialFCode w FMUL x y
562 MO_F_Quot w -> trivialFCode w FDIV x y
564 MO_And rep -> trivialCode rep (AND False) x y
565 MO_Or rep -> trivialCode rep (OR False) x y
566 MO_Xor rep -> trivialCode rep (XOR False) x y
568 MO_Mul rep -> trivialCode rep (SMUL False) x y
570 MO_Shl rep -> trivialCode rep SLL x y
571 MO_U_Shr rep -> trivialCode rep SRL x y
572 MO_S_Shr rep -> trivialCode rep SRA x y
575 MO_F32_Pwr -> getRegister (StCall (Left (fsLit "pow")) CCallConv FF64
576 [promote x, promote y])
577 where promote x = CmmMachOp MO_F32_to_Dbl [x]
578 MO_F64_Pwr -> getRegister (StCall (Left (fsLit "pow")) CCallConv FF64
581 other -> pprPanic "getRegister(sparc) - binary CmmMachOp (1)" (pprMachOp mop)
583 -- idiv fn x y = getRegister (StCall (Left fn) CCallConv II32 [x, y])
586 -- | Generate an integer division instruction.
587 idiv :: Bool -> Bool -> CmmExpr -> CmmExpr -> NatM Register
589 -- For unsigned division with a 32 bit numerator,
590 -- we can just clear the Y register.
591 idiv False cc x y = do
592 (a_reg, a_code) <- getSomeReg x
593 (b_reg, b_code) <- getSomeReg y
600 , UDIV cc a_reg (RIReg b_reg) dst]
602 return (Any II32 code)
605 -- For _signed_ division with a 32 bit numerator,
606 -- we have to sign extend the numerator into the Y register.
607 idiv True cc x y = do
608 (a_reg, a_code) <- getSomeReg x
609 (b_reg, b_code) <- getSomeReg y
611 tmp <- getNewRegNat II32
617 [ SRA a_reg (RIImm (ImmInt 16)) tmp -- sign extend
618 , SRA tmp (RIImm (ImmInt 16)) tmp
621 , SDIV cc a_reg (RIReg b_reg) dst]
623 return (Any II32 code)
626 -- | Do an integer remainder.
628 -- NOTE: The SPARC v8 architecture manual says that integer division
629 -- instructions _may_ generate a remainder, depending on the implementation.
630 -- If so it is _recommended_ that the remainder is placed in the Y register.
632 -- The UltraSparc 2007 manual says Y is _undefined_ after division.
634 -- The SPARC T2 doesn't store the remainder, not sure about the others.
635 -- It's probably best not to worry about it, and just generate our own
638 irem :: Bool -> CmmExpr -> CmmExpr -> NatM Register
640 -- For unsigned operands:
641 -- Division is between a 64 bit numerator and a 32 bit denominator,
642 -- so we still have to clear the Y register.
644 (a_reg, a_code) <- getSomeReg x
645 (b_reg, b_code) <- getSomeReg y
647 tmp_reg <- getNewRegNat II32
654 , UDIV False a_reg (RIReg b_reg) tmp_reg
655 , UMUL False tmp_reg (RIReg b_reg) tmp_reg
656 , SUB False False a_reg (RIReg tmp_reg) dst]
658 return (Any II32 code)
661 -- For signed operands:
662 -- Make sure to sign extend into the Y register, or the remainder
663 -- will have the wrong sign when the numerator is negative.
665 -- TODO: When sign extending, GCC only shifts the a_reg right by 17 bits,
666 -- not the full 32. Not sure why this is, something to do with overflow?
667 -- If anyone cares enough about the speed of signed remainder they
668 -- can work it out themselves (then tell me). -- BL 2009/01/20
671 (a_reg, a_code) <- getSomeReg x
672 (b_reg, b_code) <- getSomeReg y
674 tmp1_reg <- getNewRegNat II32
675 tmp2_reg <- getNewRegNat II32
681 [ SRA a_reg (RIImm (ImmInt 16)) tmp1_reg -- sign extend
682 , SRA tmp1_reg (RIImm (ImmInt 16)) tmp1_reg -- sign extend
685 , SDIV False a_reg (RIReg b_reg) tmp2_reg
686 , SMUL False tmp2_reg (RIReg b_reg) tmp2_reg
687 , SUB False False a_reg (RIReg tmp2_reg) dst]
689 return (Any II32 code)
692 imulMayOflo :: Width -> CmmExpr -> CmmExpr -> NatM Register
693 imulMayOflo rep a b = do
694 (a_reg, a_code) <- getSomeReg a
695 (b_reg, b_code) <- getSomeReg b
696 res_lo <- getNewRegNat II32
697 res_hi <- getNewRegNat II32
699 shift_amt = case rep of
702 _ -> panic "shift_amt"
703 code dst = a_code `appOL` b_code `appOL`
705 SMUL False a_reg (RIReg b_reg) res_lo,
707 SRA res_lo (RIImm (ImmInt shift_amt)) res_lo,
708 SUB False False res_lo (RIReg res_hi) dst
710 return (Any II32 code)
712 getRegister (CmmLoad mem pk) = do
713 Amode src code <- getAmode mem
715 code__2 dst = code `snocOL` LD (cmmTypeSize pk) src dst
716 return (Any (cmmTypeSize pk) code__2)
718 getRegister (CmmLit (CmmInt i _))
721 src = ImmInt (fromInteger i)
722 code dst = unitOL (OR False g0 (RIImm src) dst)
724 return (Any II32 code)
726 getRegister (CmmLit lit)
727 = let rep = cmmLitType lit
731 OR False dst (RIImm (LO imm)) dst]
732 in return (Any II32 code)
736 getAmode :: CmmExpr -> NatM Amode
737 getAmode tree@(CmmRegOff _ _) = getAmode (mangleIndexTree tree)
739 getAmode (CmmMachOp (MO_Sub rep) [x, CmmLit (CmmInt i _)])
742 (reg, code) <- getSomeReg x
744 off = ImmInt (-(fromInteger i))
745 return (Amode (AddrRegImm reg off) code)
748 getAmode (CmmMachOp (MO_Add rep) [x, CmmLit (CmmInt i _)])
751 (reg, code) <- getSomeReg x
753 off = ImmInt (fromInteger i)
754 return (Amode (AddrRegImm reg off) code)
756 getAmode (CmmMachOp (MO_Add rep) [x, y])
758 (regX, codeX) <- getSomeReg x
759 (regY, codeY) <- getSomeReg y
761 code = codeX `appOL` codeY
762 return (Amode (AddrRegReg regX regY) code)
764 getAmode (CmmLit lit)
766 let imm__2 = litToImm lit
767 tmp1 <- getNewRegNat II32
768 tmp2 <- getNewRegNat II32
770 let code = toOL [ SETHI (HI imm__2) tmp1
771 , OR False tmp1 (RIImm (LO imm__2)) tmp2]
773 return (Amode (AddrRegReg tmp2 g0) code)
777 (reg, code) <- getSomeReg other
780 return (Amode (AddrRegImm reg off) code)
783 getCondCode :: CmmExpr -> NatM CondCode
784 getCondCode (CmmMachOp mop [x, y])
787 MO_F_Eq W32 -> condFltCode EQQ x y
788 MO_F_Ne W32 -> condFltCode NE x y
789 MO_F_Gt W32 -> condFltCode GTT x y
790 MO_F_Ge W32 -> condFltCode GE x y
791 MO_F_Lt W32 -> condFltCode LTT x y
792 MO_F_Le W32 -> condFltCode LE x y
794 MO_F_Eq W64 -> condFltCode EQQ x y
795 MO_F_Ne W64 -> condFltCode NE x y
796 MO_F_Gt W64 -> condFltCode GTT x y
797 MO_F_Ge W64 -> condFltCode GE x y
798 MO_F_Lt W64 -> condFltCode LTT x y
799 MO_F_Le W64 -> condFltCode LE x y
801 MO_Eq rep -> condIntCode EQQ x y
802 MO_Ne rep -> condIntCode NE x y
804 MO_S_Gt rep -> condIntCode GTT x y
805 MO_S_Ge rep -> condIntCode GE x y
806 MO_S_Lt rep -> condIntCode LTT x y
807 MO_S_Le rep -> condIntCode LE x y
809 MO_U_Gt rep -> condIntCode GU x y
810 MO_U_Ge rep -> condIntCode GEU x y
811 MO_U_Lt rep -> condIntCode LU x y
812 MO_U_Le rep -> condIntCode LEU x y
814 other -> pprPanic "getCondCode(x86,x86_64,sparc)" (ppr (CmmMachOp mop [x,y]))
816 getCondCode other = pprPanic "getCondCode(2)(x86,sparc)" (ppr other)
822 -- @cond(Int|Flt)Code@: Turn a boolean expression into a condition, to be
823 -- passed back up the tree.
825 condIntCode :: Cond -> CmmExpr -> CmmExpr -> NatM CondCode
826 condIntCode cond x (CmmLit (CmmInt y rep))
829 (src1, code) <- getSomeReg x
831 src2 = ImmInt (fromInteger y)
832 code' = code `snocOL` SUB False True src1 (RIImm src2) g0
833 return (CondCode False cond code')
835 condIntCode cond x y = do
836 (src1, code1) <- getSomeReg x
837 (src2, code2) <- getSomeReg y
839 code__2 = code1 `appOL` code2 `snocOL`
840 SUB False True src1 (RIReg src2) g0
841 return (CondCode False cond code__2)
844 condFltCode :: Cond -> CmmExpr -> CmmExpr -> NatM CondCode
845 condFltCode cond x y = do
846 (src1, code1) <- getSomeReg x
847 (src2, code2) <- getSomeReg y
848 tmp <- getNewRegNat FF64
850 promote x = FxTOy FF32 FF64 x tmp
856 if pk1 `cmmEqType` pk2 then
857 code1 `appOL` code2 `snocOL`
858 FCMP True (cmmTypeSize pk1) src1 src2
859 else if typeWidth pk1 == W32 then
860 code1 `snocOL` promote src1 `appOL` code2 `snocOL`
861 FCMP True FF64 tmp src2
863 code1 `appOL` code2 `snocOL` promote src2 `snocOL`
864 FCMP True FF64 src1 tmp
865 return (CondCode True cond code__2)
869 -- -----------------------------------------------------------------------------
870 -- Generating assignments
872 -- Assignments are really at the heart of the whole code generation
873 -- business. Almost all top-level nodes of any real importance are
874 -- assignments, which correspond to loads, stores, or register
875 -- transfers. If we're really lucky, some of the register transfers
876 -- will go away, because we can use the destination register to
877 -- complete the code generation for the right hand side. This only
878 -- fails when the right hand side is forced into a fixed register
879 -- (e.g. the result of a call).
881 assignMem_IntCode :: Size -> CmmExpr -> CmmExpr -> NatM InstrBlock
882 assignMem_IntCode pk addr src = do
883 (srcReg, code) <- getSomeReg src
884 Amode dstAddr addr_code <- getAmode addr
885 return $ code `appOL` addr_code `snocOL` ST pk srcReg dstAddr
888 assignReg_IntCode :: Size -> CmmReg -> CmmExpr -> NatM InstrBlock
889 assignReg_IntCode pk reg src = do
892 Any _ code -> code dst
893 Fixed _ freg fcode -> fcode `snocOL` OR False g0 (RIReg freg) dst
895 dst = getRegisterReg reg
899 -- Floating point assignment to memory
900 assignMem_FltCode :: Size -> CmmExpr -> CmmExpr -> NatM InstrBlock
901 assignMem_FltCode pk addr src = do
902 Amode dst__2 code1 <- getAmode addr
903 (src__2, code2) <- getSomeReg src
904 tmp1 <- getNewRegNat pk
906 pk__2 = cmmExprType src
907 code__2 = code1 `appOL` code2 `appOL`
908 if sizeToWidth pk == typeWidth pk__2
909 then unitOL (ST pk src__2 dst__2)
910 else toOL [ FxTOy (cmmTypeSize pk__2) pk src__2 tmp1
914 -- Floating point assignment to a register/temporary
915 assignReg_FltCode :: Size -> CmmReg -> CmmExpr -> NatM InstrBlock
916 assignReg_FltCode pk dstCmmReg srcCmmExpr = do
917 srcRegister <- getRegister srcCmmExpr
918 let dstReg = getRegisterReg dstCmmReg
920 return $ case srcRegister of
921 Any _ code -> code dstReg
922 Fixed _ srcFixedReg srcCode -> srcCode `snocOL` FMOV pk srcFixedReg dstReg
927 genJump :: CmmExpr{-the branch target-} -> NatM InstrBlock
929 genJump (CmmLit (CmmLabel lbl))
930 = return (toOL [CALL (Left target) 0 True, NOP])
936 (target, code) <- getSomeReg tree
937 return (code `snocOL` JMP (AddrRegReg target g0) `snocOL` NOP)
939 -- -----------------------------------------------------------------------------
940 -- Unconditional branches
942 genBranch :: BlockId -> NatM InstrBlock
943 genBranch = return . toOL . mkJumpInstr
946 -- -----------------------------------------------------------------------------
950 Conditional jumps are always to local labels, so we can use branch
951 instructions. We peek at the arguments to decide what kind of
954 SPARC: First, we have to ensure that the condition codes are set
955 according to the supplied comparison operation. We generate slightly
956 different code for floating point comparisons, because a floating
957 point operation cannot directly precede a @BF@. We assume the worst
958 and fill that slot with a @NOP@.
960 SPARC: Do not fill the delay slots here; you will confuse the register
966 :: BlockId -- the branch target
967 -> CmmExpr -- the condition on which to branch
972 genCondJump bid bool = do
973 CondCode is_float cond code <- getCondCode bool
978 then [NOP, BF cond False bid, NOP]
979 else [BI cond False bid, NOP]
985 -- -----------------------------------------------------------------------------
986 -- Generating C calls
988 -- Now the biggest nightmare---calls. Most of the nastiness is buried in
989 -- @get_arg@, which moves the arguments to the correct registers/stack
990 -- locations. Apart from that, the code is easy.
992 -- (If applicable) Do not fill the delay slots here; you will confuse the
993 -- register allocator.
996 :: CmmCallTarget -- function to call
997 -> HintedCmmFormals -- where to put the result
998 -> HintedCmmActuals -- arguments (of mixed type)
1002 -- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
1005 The SPARC calling convention is an absolute
1006 nightmare. The first 6x32 bits of arguments are mapped into
1007 %o0 through %o5, and the remaining arguments are dumped to the
1008 stack, beginning at [%sp+92]. (Note that %o6 == %sp.)
1010 If we have to put args on the stack, move %o6==%sp down by
1011 the number of words to go on the stack, to ensure there's enough space.
1013 According to Fraser and Hanson's lcc book, page 478, fig 17.2,
1014 16 words above the stack pointer is a word for the address of
1015 a structure return value. I use this as a temporary location
1016 for moving values from float to int regs. Certainly it isn't
1017 safe to put anything in the 16 words starting at %sp, since
1018 this area can get trashed at any time due to window overflows
1019 caused by signal handlers.
1021 A final complication (if the above isn't enough) is that
1022 we can't blithely calculate the arguments one by one into
1023 %o0 .. %o5. Consider the following nested calls:
1027 Naive code moves a into %o0, and (fff b c) into %o1. Unfortunately
1028 the inner call will itself use %o0, which trashes the value put there
1029 in preparation for the outer call. Upshot: we need to calculate the
1030 args into temporary regs, and move those to arg regs or onto the
1031 stack only immediately prior to the call proper. Sigh.
1034 :: CmmCallTarget -- function to call
1035 -> HintedCmmFormals -- where to put the result
1036 -> HintedCmmActuals -- arguments (of mixed type)
1042 -- On SPARC under TSO (Total Store Ordering), writes earlier in the instruction stream
1043 -- are guaranteed to take place before writes afterwards (unlike on PowerPC).
1044 -- Ref: Section 8.4 of the SPARC V9 Architecture manual.
1046 -- In the SPARC case we don't need a barrier.
1048 genCCall (CmmPrim (MO_WriteBarrier)) _ _
1051 genCCall target dest_regs argsAndHints
1053 -- strip hints from the arg regs
1054 let args :: [CmmExpr]
1055 args = map hintlessCmm argsAndHints
1058 -- work out the arguments, and assign them to integer regs
1059 argcode_and_vregs <- mapM arg_to_int_vregs args
1060 let (argcodes, vregss) = unzip argcode_and_vregs
1061 let vregs = concat vregss
1063 let n_argRegs = length allArgRegs
1064 let n_argRegs_used = min (length vregs) n_argRegs
1067 -- deal with static vs dynamic call targets
1068 callinsns <- case target of
1069 CmmCallee (CmmLit (CmmLabel lbl)) conv ->
1070 return (unitOL (CALL (Left (litToImm (CmmLabel lbl))) n_argRegs_used False))
1073 -> do (dyn_c, [dyn_r]) <- arg_to_int_vregs expr
1074 return (dyn_c `snocOL` CALL (Right dyn_r) n_argRegs_used False)
1077 -> do res <- outOfLineFloatOp mop
1078 lblOrMopExpr <- case res of
1080 return (unitOL (CALL (Left (litToImm (CmmLabel lbl))) n_argRegs_used False))
1083 (dyn_c, [dyn_r]) <- arg_to_int_vregs mopExpr
1084 return (dyn_c `snocOL` CALL (Right dyn_r) n_argRegs_used False)
1088 let argcode = concatOL argcodes
1090 let (move_sp_down, move_sp_up)
1091 = let diff = length vregs - n_argRegs
1092 nn = if odd diff then diff + 1 else diff -- keep 8-byte alignment
1095 else (unitOL (moveSp (-1*nn)), unitOL (moveSp (1*nn)))
1098 = toOL (move_final vregs allArgRegs eXTRA_STK_ARGS_HERE)
1102 move_sp_down `appOL`
1103 transfer_code `appOL`
1107 assign_code dest_regs
1110 -- | Generate code to calculate an argument, and move it into one
1111 -- or two integer vregs.
1112 arg_to_int_vregs :: CmmExpr -> NatM (OrdList Instr, [Reg])
1113 arg_to_int_vregs arg
1115 -- If the expr produces a 64 bit int, then we can just use iselExpr64
1116 | isWord64 (cmmExprType arg)
1117 = do (ChildCode64 code r_lo) <- iselExpr64 arg
1118 let r_hi = getHiVRegFromLo r_lo
1119 return (code, [r_hi, r_lo])
1122 = do (src, code) <- getSomeReg arg
1123 tmp <- getNewRegNat (cmmTypeSize $ cmmExprType arg)
1124 let pk = cmmExprType arg
1126 case cmmTypeSize pk of
1128 -- Load a 64 bit float return value into two integer regs.
1130 v1 <- getNewRegNat II32
1131 v2 <- getNewRegNat II32
1133 let Just f0_high = fPair f0
1137 FMOV FF64 src f0 `snocOL`
1138 ST FF32 f0 (spRel 16) `snocOL`
1139 LD II32 (spRel 16) v1 `snocOL`
1140 ST FF32 f0_high (spRel 16) `snocOL`
1141 LD II32 (spRel 16) v2
1143 return (code2, [v1,v2])
1145 -- Load a 32 bit float return value into an integer reg
1147 v1 <- getNewRegNat II32
1151 ST FF32 src (spRel 16) `snocOL`
1152 LD II32 (spRel 16) v1
1154 return (code2, [v1])
1156 -- Move an integer return value into its destination reg.
1158 v1 <- getNewRegNat II32
1162 OR False g0 (RIReg src) v1
1164 return (code2, [v1])
1167 -- | Move args from the integer vregs into which they have been
1168 -- marshalled, into %o0 .. %o5, and the rest onto the stack.
1170 move_final :: [Reg] -> [Reg] -> Int -> [Instr]
1173 move_final [] _ offset
1176 -- out of aregs; move to stack
1177 move_final (v:vs) [] offset
1178 = ST II32 v (spRel offset)
1179 : move_final vs [] (offset+1)
1181 -- move into an arg (%o[0..5]) reg
1182 move_final (v:vs) (a:az) offset
1183 = OR False g0 (RIReg v) a
1184 : move_final vs az offset
1187 -- | Assign results returned from the call into their
1190 assign_code :: [CmmHinted LocalReg] -> OrdList Instr
1191 assign_code [] = nilOL
1193 assign_code [CmmHinted dest _hint]
1194 = let rep = localRegType dest
1195 width = typeWidth rep
1196 r_dest = getRegisterReg (CmmLocal dest)
1201 = unitOL $ FMOV FF32 (RealReg $ fReg 0) r_dest
1205 = unitOL $ FMOV FF64 (RealReg $ fReg 0) r_dest
1207 | not $ isFloatType rep
1209 = unitOL $ mkRegRegMoveInstr (RealReg $ oReg 0) r_dest
1211 | not $ isFloatType rep
1213 , r_dest_hi <- getHiVRegFromLo r_dest
1214 = toOL [ mkRegRegMoveInstr (RealReg $ oReg 0) r_dest_hi
1215 , mkRegRegMoveInstr (RealReg $ oReg 1) r_dest]
1219 -- | Generate a call to implement an out-of-line floating point operation
1222 -> NatM (Either CLabel CmmExpr)
1224 outOfLineFloatOp mop
1225 = do let functionName
1226 = outOfLineFloatOp_table mop
1228 dflags <- getDynFlagsNat
1229 mopExpr <- cmmMakeDynamicReference dflags addImportNat CallReference
1230 $ mkForeignLabel functionName Nothing True IsFunction
1234 CmmLit (CmmLabel lbl) -> Left lbl
1237 return mopLabelOrExpr
1240 -- | Decide what C function to use to implement a CallishMachOp
1242 outOfLineFloatOp_table
1246 outOfLineFloatOp_table mop
1248 MO_F32_Exp -> fsLit "expf"
1249 MO_F32_Log -> fsLit "logf"
1250 MO_F32_Sqrt -> fsLit "sqrtf"
1251 MO_F32_Pwr -> fsLit "powf"
1253 MO_F32_Sin -> fsLit "sinf"
1254 MO_F32_Cos -> fsLit "cosf"
1255 MO_F32_Tan -> fsLit "tanf"
1257 MO_F32_Asin -> fsLit "asinf"
1258 MO_F32_Acos -> fsLit "acosf"
1259 MO_F32_Atan -> fsLit "atanf"
1261 MO_F32_Sinh -> fsLit "sinhf"
1262 MO_F32_Cosh -> fsLit "coshf"
1263 MO_F32_Tanh -> fsLit "tanhf"
1265 MO_F64_Exp -> fsLit "exp"
1266 MO_F64_Log -> fsLit "log"
1267 MO_F64_Sqrt -> fsLit "sqrt"
1268 MO_F64_Pwr -> fsLit "pow"
1270 MO_F64_Sin -> fsLit "sin"
1271 MO_F64_Cos -> fsLit "cos"
1272 MO_F64_Tan -> fsLit "tan"
1274 MO_F64_Asin -> fsLit "asin"
1275 MO_F64_Acos -> fsLit "acos"
1276 MO_F64_Atan -> fsLit "atan"
1278 MO_F64_Sinh -> fsLit "sinh"
1279 MO_F64_Cosh -> fsLit "cosh"
1280 MO_F64_Tanh -> fsLit "tanh"
1282 other -> pprPanic "outOfLineFloatOp(sparc): Unknown callish mach op "
1283 (pprCallishMachOp mop)
1286 -- -----------------------------------------------------------------------------
1287 -- Generating a table-branch
1289 genSwitch :: CmmExpr -> [Maybe BlockId] -> NatM InstrBlock
1292 = error "MachCodeGen: sparc genSwitch PIC not finished\n"
1295 = do (e_reg, e_code) <- getSomeReg expr
1297 base_reg <- getNewRegNat II32
1298 offset_reg <- getNewRegNat II32
1299 dst <- getNewRegNat II32
1301 label <- getNewLabelNat
1302 let jumpTable = map jumpTableEntry ids
1304 return $ e_code `appOL`
1307 [ LDATA ReadOnlyData (CmmDataLabel label : jumpTable)
1309 -- load base of jump table
1310 , SETHI (HI (ImmCLbl label)) base_reg
1311 , OR False base_reg (RIImm $ LO $ ImmCLbl label) base_reg
1313 -- the addrs in the table are 32 bits wide..
1314 , SLL e_reg (RIImm $ ImmInt 2) offset_reg
1316 -- load and jump to the destination
1317 , LD II32 (AddrRegReg base_reg offset_reg) dst
1318 , JMP_TBL (AddrRegImm dst (ImmInt 0)) [i | Just i <- ids]
1323 -- -----------------------------------------------------------------------------
1324 -- 'condIntReg' and 'condFltReg': condition codes into registers
1326 -- Turn those condition codes into integers now (when they appear on
1327 -- the right hand side of an assignment).
1329 -- (If applicable) Do not fill the delay slots here; you will confuse the
1330 -- register allocator.
1332 condIntReg, condFltReg :: Cond -> CmmExpr -> CmmExpr -> NatM Register
1334 condIntReg EQQ x (CmmLit (CmmInt 0 d)) = do
1335 (src, code) <- getSomeReg x
1336 tmp <- getNewRegNat II32
1338 code__2 dst = code `appOL` toOL [
1339 SUB False True g0 (RIReg src) g0,
1340 SUB True False g0 (RIImm (ImmInt (-1))) dst]
1341 return (Any II32 code__2)
1343 condIntReg EQQ x y = do
1344 (src1, code1) <- getSomeReg x
1345 (src2, code2) <- getSomeReg y
1346 tmp1 <- getNewRegNat II32
1347 tmp2 <- getNewRegNat II32
1349 code__2 dst = code1 `appOL` code2 `appOL` toOL [
1350 XOR False src1 (RIReg src2) dst,
1351 SUB False True g0 (RIReg dst) g0,
1352 SUB True False g0 (RIImm (ImmInt (-1))) dst]
1353 return (Any II32 code__2)
1355 condIntReg NE x (CmmLit (CmmInt 0 d)) = do
1356 (src, code) <- getSomeReg x
1357 tmp <- getNewRegNat II32
1359 code__2 dst = code `appOL` toOL [
1360 SUB False True g0 (RIReg src) g0,
1361 ADD True False g0 (RIImm (ImmInt 0)) dst]
1362 return (Any II32 code__2)
1364 condIntReg NE x y = do
1365 (src1, code1) <- getSomeReg x
1366 (src2, code2) <- getSomeReg y
1367 tmp1 <- getNewRegNat II32
1368 tmp2 <- getNewRegNat II32
1370 code__2 dst = code1 `appOL` code2 `appOL` toOL [
1371 XOR False src1 (RIReg src2) dst,
1372 SUB False True g0 (RIReg dst) g0,
1373 ADD True False g0 (RIImm (ImmInt 0)) dst]
1374 return (Any II32 code__2)
1376 condIntReg cond x y = do
1377 bid1@(BlockId lbl1) <- getBlockIdNat
1378 bid2@(BlockId lbl2) <- getBlockIdNat
1379 CondCode _ cond cond_code <- condIntCode cond x y
1381 code__2 dst = cond_code `appOL` toOL [
1382 BI cond False bid1, NOP,
1383 OR False g0 (RIImm (ImmInt 0)) dst,
1384 BI ALWAYS False bid2, NOP,
1386 OR False g0 (RIImm (ImmInt 1)) dst,
1388 return (Any II32 code__2)
1390 condFltReg cond x y = do
1391 bid1@(BlockId lbl1) <- getBlockIdNat
1392 bid2@(BlockId lbl2) <- getBlockIdNat
1393 CondCode _ cond cond_code <- condFltCode cond x y
1395 code__2 dst = cond_code `appOL` toOL [
1397 BF cond False bid1, NOP,
1398 OR False g0 (RIImm (ImmInt 0)) dst,
1399 BI ALWAYS False bid2, NOP,
1401 OR False g0 (RIImm (ImmInt 1)) dst,
1403 return (Any II32 code__2)
1407 -- -----------------------------------------------------------------------------
1408 -- 'trivial*Code': deal with trivial instructions
1410 -- Trivial (dyadic: 'trivialCode', floating-point: 'trivialFCode',
1411 -- unary: 'trivialUCode', unary fl-pt:'trivialUFCode') instructions.
1412 -- Only look for constants on the right hand side, because that's
1413 -- where the generic optimizer will have put them.
1415 -- Similarly, for unary instructions, we don't have to worry about
1416 -- matching an StInt as the argument, because genericOpt will already
1417 -- have handled the constant-folding.
1419 trivialCode pk instr x (CmmLit (CmmInt y d))
1422 (src1, code) <- getSomeReg x
1423 tmp <- getNewRegNat II32
1425 src2 = ImmInt (fromInteger y)
1426 code__2 dst = code `snocOL` instr src1 (RIImm src2) dst
1427 return (Any II32 code__2)
1429 trivialCode pk instr x y = do
1430 (src1, code1) <- getSomeReg x
1431 (src2, code2) <- getSomeReg y
1432 tmp1 <- getNewRegNat II32
1433 tmp2 <- getNewRegNat II32
1435 code__2 dst = code1 `appOL` code2 `snocOL`
1436 instr src1 (RIReg src2) dst
1437 return (Any II32 code__2)
1440 trivialFCode pk instr x y = do
1441 (src1, code1) <- getSomeReg x
1442 (src2, code2) <- getSomeReg y
1443 tmp1 <- getNewRegNat (cmmTypeSize $ cmmExprType x)
1444 tmp2 <- getNewRegNat (cmmTypeSize $ cmmExprType y)
1445 tmp <- getNewRegNat FF64
1447 promote x = FxTOy FF32 FF64 x tmp
1453 if pk1 `cmmEqType` pk2 then
1454 code1 `appOL` code2 `snocOL`
1455 instr (floatSize pk) src1 src2 dst
1456 else if typeWidth pk1 == W32 then
1457 code1 `snocOL` promote src1 `appOL` code2 `snocOL`
1458 instr FF64 tmp src2 dst
1460 code1 `appOL` code2 `snocOL` promote src2 `snocOL`
1461 instr FF64 src1 tmp dst
1462 return (Any (cmmTypeSize $ if pk1 `cmmEqType` pk2 then pk1 else cmmFloat W64)
1466 trivialUCode size instr x = do
1467 (src, code) <- getSomeReg x
1468 tmp <- getNewRegNat size
1470 code__2 dst = code `snocOL` instr (RIReg src) dst
1471 return (Any size code__2)
1474 trivialUFCode pk instr x = do
1475 (src, code) <- getSomeReg x
1476 tmp <- getNewRegNat pk
1478 code__2 dst = code `snocOL` instr src dst
1479 return (Any pk code__2)
1483 coerceDbl2Flt :: CmmExpr -> NatM Register
1484 coerceFlt2Dbl :: CmmExpr -> NatM Register
1487 coerceInt2FP width1 width2 x = do
1488 (src, code) <- getSomeReg x
1490 code__2 dst = code `appOL` toOL [
1491 ST (intSize width1) src (spRel (-2)),
1492 LD (intSize width1) (spRel (-2)) dst,
1493 FxTOy (intSize width1) (floatSize width2) dst dst]
1494 return (Any (floatSize $ width2) code__2)
1497 -- | Coerce a floating point value to integer
1499 -- NOTE: On sparc v9 there are no instructions to move a value from an
1500 -- FP register directly to an int register, so we have to use a load/store.
1502 coerceFP2Int width1 width2 x
1503 = do let fsize1 = floatSize width1
1504 fsize2 = floatSize width2
1506 isize2 = intSize width2
1508 (fsrc, code) <- getSomeReg x
1509 fdst <- getNewRegNat fsize2
1514 -- convert float to int format, leaving it in a float reg.
1515 [ FxTOy fsize1 isize2 fsrc fdst
1517 -- store the int into mem, then load it back to move
1518 -- it into an actual int reg.
1519 , ST fsize2 fdst (spRel (-2))
1520 , LD isize2 (spRel (-2)) dst]
1522 return (Any isize2 code2)
1525 coerceDbl2Flt x = do
1526 (src, code) <- getSomeReg x
1527 return (Any FF32 (\dst -> code `snocOL` FxTOy FF64 FF32 src dst))
1530 coerceFlt2Dbl x = do
1531 (src, code) <- getSomeReg x
1532 return (Any FF64 (\dst -> code `snocOL` FxTOy FF32 FF64 src dst))
1536 -- eXTRA_STK_ARGS_HERE
1538 -- We (allegedly) put the first six C-call arguments in registers;
1539 -- where do we start putting the rest of them?
1541 -- Moved from Instrs (SDM):
1543 eXTRA_STK_ARGS_HERE :: Int