1 -----------------------------------------------------------------------------
3 -- Generating machine code (instruction selection)
5 -- (c) The University of Glasgow 1996-2004
7 -----------------------------------------------------------------------------
9 -- This is a big module, but, if you pay attention to
10 -- (a) the sectioning, (b) the type signatures, and
11 -- (c) the #if blah_TARGET_ARCH} things, the
12 -- structure should not be too overwhelming.
14 module MachCodeGen ( cmmTopCodeGen, InstrBlock ) where
16 #include "HsVersions.h"
17 #include "nativeGen/NCG.h"
24 import PositionIndependentCode ( cmmMakeDynamicReference, initializePicBase )
26 -- Our intermediate code:
27 import PprCmm ( pprExpr )
33 import StaticFlags ( opt_PIC )
34 import ForeignCall ( CCallConv(..) )
39 import FastTypes ( isFastTrue )
40 import Constants ( wORD_SIZE )
43 import Outputable ( assertPanic )
44 import TRACE ( trace )
47 import Control.Monad ( mapAndUnzipM )
48 import Maybe ( fromJust )
52 -- -----------------------------------------------------------------------------
53 -- Top-level of the instruction selector
55 -- | 'InstrBlock's are the insn sequences generated by the insn selectors.
56 -- They are really trees of insns to facilitate fast appending, where a
57 -- left-to-right traversal (pre-order?) yields the insns in the correct
60 type InstrBlock = OrdList Instr
62 cmmTopCodeGen :: CmmTop -> NatM [NatCmmTop]
63 cmmTopCodeGen (CmmProc info lab params blocks) = do
64 (nat_blocks,statics) <- mapAndUnzipM basicBlockCodeGen blocks
65 picBaseMb <- getPicBaseMaybeNat
66 let proc = CmmProc info lab params (concat nat_blocks)
67 tops = proc : concat statics
69 Just picBase -> initializePicBase picBase tops
70 Nothing -> return tops
72 cmmTopCodeGen (CmmData sec dat) = do
73 return [CmmData sec dat] -- no translation, we just use CmmStatic
75 basicBlockCodeGen :: CmmBasicBlock -> NatM ([NatBasicBlock],[NatCmmTop])
76 basicBlockCodeGen (BasicBlock id stmts) = do
77 instrs <- stmtsToInstrs stmts
78 -- code generation may introduce new basic block boundaries, which
79 -- are indicated by the NEWBLOCK instruction. We must split up the
80 -- instruction stream into basic blocks again. Also, we extract
83 (top,other_blocks,statics) = foldrOL mkBlocks ([],[],[]) instrs
85 mkBlocks (NEWBLOCK id) (instrs,blocks,statics)
86 = ([], BasicBlock id instrs : blocks, statics)
87 mkBlocks (LDATA sec dat) (instrs,blocks,statics)
88 = (instrs, blocks, CmmData sec dat:statics)
89 mkBlocks instr (instrs,blocks,statics)
90 = (instr:instrs, blocks, statics)
92 return (BasicBlock id top : other_blocks, statics)
94 stmtsToInstrs :: [CmmStmt] -> NatM InstrBlock
96 = do instrss <- mapM stmtToInstrs stmts
97 return (concatOL instrss)
99 stmtToInstrs :: CmmStmt -> NatM InstrBlock
100 stmtToInstrs stmt = case stmt of
101 CmmNop -> return nilOL
102 CmmComment s -> return (unitOL (COMMENT s))
105 | isFloatingRep kind -> assignReg_FltCode kind reg src
106 #if WORD_SIZE_IN_BITS==32
107 | kind == I64 -> assignReg_I64Code reg src
109 | otherwise -> assignReg_IntCode kind reg src
110 where kind = cmmRegRep reg
113 | isFloatingRep kind -> assignMem_FltCode kind addr src
114 #if WORD_SIZE_IN_BITS==32
115 | kind == I64 -> assignMem_I64Code addr src
117 | otherwise -> assignMem_IntCode kind addr src
118 where kind = cmmExprRep src
120 CmmCall target result_regs args vols
121 -> genCCall target result_regs args vols
123 CmmBranch id -> genBranch id
124 CmmCondBranch arg id -> genCondJump id arg
125 CmmSwitch arg ids -> genSwitch arg ids
126 CmmJump arg params -> genJump arg
128 -- -----------------------------------------------------------------------------
129 -- General things for putting together code sequences
131 -- Expand CmmRegOff. ToDo: should we do it this way around, or convert
132 -- CmmExprs into CmmRegOff?
133 mangleIndexTree :: CmmExpr -> CmmExpr
134 mangleIndexTree (CmmRegOff reg off)
135 = CmmMachOp (MO_Add rep) [CmmReg reg, CmmLit (CmmInt (fromIntegral off) rep)]
136 where rep = cmmRegRep reg
138 -- -----------------------------------------------------------------------------
139 -- Code gen for 64-bit arithmetic on 32-bit platforms
142 Simple support for generating 64-bit code (ie, 64 bit values and 64
143 bit assignments) on 32-bit platforms. Unlike the main code generator
144 we merely shoot for generating working code as simply as possible, and
145 pay little attention to code quality. Specifically, there is no
146 attempt to deal cleverly with the fixed-vs-floating register
147 distinction; all values are generated into (pairs of) floating
148 registers, even if this would mean some redundant reg-reg moves as a
149 result. Only one of the VRegUniques is returned, since it will be
150 of the VRegUniqueLo form, and the upper-half VReg can be determined
151 by applying getHiVRegFromLo to it.
154 data ChildCode64 -- a.k.a "Register64"
157 Reg -- the lower 32-bit temporary which contains the
158 -- result; use getHiVRegFromLo to find the other
159 -- VRegUnique. Rules of this simplified insn
160 -- selection game are therefore that the returned
161 -- Reg may be modified
163 #if WORD_SIZE_IN_BITS==32
164 assignMem_I64Code :: CmmExpr -> CmmExpr -> NatM InstrBlock
165 assignReg_I64Code :: CmmReg -> CmmExpr -> NatM InstrBlock
168 #ifndef x86_64_TARGET_ARCH
169 iselExpr64 :: CmmExpr -> NatM ChildCode64
172 -- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
176 assignMem_I64Code addrTree valueTree = do
177 Amode addr addr_code <- getAmode addrTree
178 ChildCode64 vcode rlo <- iselExpr64 valueTree
180 rhi = getHiVRegFromLo rlo
182 -- Little-endian store
183 mov_lo = MOV I32 (OpReg rlo) (OpAddr addr)
184 mov_hi = MOV I32 (OpReg rhi) (OpAddr (fromJust (addrOffset addr 4)))
186 return (vcode `appOL` addr_code `snocOL` mov_lo `snocOL` mov_hi)
189 assignReg_I64Code (CmmLocal (LocalReg u_dst pk)) valueTree = do
190 ChildCode64 vcode r_src_lo <- iselExpr64 valueTree
192 r_dst_lo = mkVReg u_dst I32
193 r_dst_hi = getHiVRegFromLo r_dst_lo
194 r_src_hi = getHiVRegFromLo r_src_lo
195 mov_lo = MOV I32 (OpReg r_src_lo) (OpReg r_dst_lo)
196 mov_hi = MOV I32 (OpReg r_src_hi) (OpReg r_dst_hi)
199 vcode `snocOL` mov_lo `snocOL` mov_hi
202 assignReg_I64Code lvalue valueTree
203 = panic "assignReg_I64Code(i386): invalid lvalue"
207 iselExpr64 (CmmLit (CmmInt i _)) = do
208 (rlo,rhi) <- getNewRegPairNat I32
210 r = fromIntegral (fromIntegral i :: Word32)
211 q = fromIntegral ((fromIntegral i `shiftR` 32) :: Word32)
213 MOV I32 (OpImm (ImmInteger r)) (OpReg rlo),
214 MOV I32 (OpImm (ImmInteger q)) (OpReg rhi)
217 return (ChildCode64 code rlo)
219 iselExpr64 (CmmLoad addrTree I64) = do
220 Amode addr addr_code <- getAmode addrTree
221 (rlo,rhi) <- getNewRegPairNat I32
223 mov_lo = MOV I32 (OpAddr addr) (OpReg rlo)
224 mov_hi = MOV I32 (OpAddr (fromJust (addrOffset addr 4))) (OpReg rhi)
227 ChildCode64 (addr_code `snocOL` mov_lo `snocOL` mov_hi)
231 iselExpr64 (CmmReg (CmmLocal (LocalReg vu I64)))
232 = return (ChildCode64 nilOL (mkVReg vu I32))
234 -- we handle addition, but rather badly
235 iselExpr64 (CmmMachOp (MO_Add _) [e1, CmmLit (CmmInt i _)]) = do
236 ChildCode64 code1 r1lo <- iselExpr64 e1
237 (rlo,rhi) <- getNewRegPairNat I32
239 r = fromIntegral (fromIntegral i :: Word32)
240 q = fromIntegral ((fromIntegral i `shiftR` 32) :: Word32)
241 r1hi = getHiVRegFromLo r1lo
243 toOL [ MOV I32 (OpReg r1lo) (OpReg rlo),
244 ADD I32 (OpImm (ImmInteger r)) (OpReg rlo),
245 MOV I32 (OpReg r1hi) (OpReg rhi),
246 ADC I32 (OpImm (ImmInteger q)) (OpReg rhi) ]
248 return (ChildCode64 code rlo)
250 iselExpr64 (CmmMachOp (MO_Add _) [e1,e2]) = do
251 ChildCode64 code1 r1lo <- iselExpr64 e1
252 ChildCode64 code2 r2lo <- iselExpr64 e2
253 (rlo,rhi) <- getNewRegPairNat I32
255 r1hi = getHiVRegFromLo r1lo
256 r2hi = getHiVRegFromLo r2lo
259 toOL [ MOV I32 (OpReg r1lo) (OpReg rlo),
260 ADD I32 (OpReg r2lo) (OpReg rlo),
261 MOV I32 (OpReg r1hi) (OpReg rhi),
262 ADC I32 (OpReg r2hi) (OpReg rhi) ]
264 return (ChildCode64 code rlo)
267 = pprPanic "iselExpr64(i386)" (ppr expr)
269 #endif /* i386_TARGET_ARCH */
271 -- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
273 #if sparc_TARGET_ARCH
275 assignMem_I64Code addrTree valueTree = do
276 Amode addr addr_code <- getAmode addrTree
277 ChildCode64 vcode rlo <- iselExpr64 valueTree
278 (src, code) <- getSomeReg addrTree
280 rhi = getHiVRegFromLo rlo
282 mov_hi = ST I32 rhi (AddrRegImm src (ImmInt 0))
283 mov_lo = ST I32 rlo (AddrRegImm src (ImmInt 4))
284 return (vcode `appOL` code `snocOL` mov_hi `snocOL` mov_lo)
286 assignReg_I64Code (CmmLocal (LocalReg u_dst pk)) valueTree = do
287 ChildCode64 vcode r_src_lo <- iselExpr64 valueTree
289 r_dst_lo = mkVReg u_dst pk
290 r_dst_hi = getHiVRegFromLo r_dst_lo
291 r_src_hi = getHiVRegFromLo r_src_lo
292 mov_lo = mkMOV r_src_lo r_dst_lo
293 mov_hi = mkMOV r_src_hi r_dst_hi
294 mkMOV sreg dreg = OR False g0 (RIReg sreg) dreg
295 return (vcode `snocOL` mov_hi `snocOL` mov_lo)
296 assignReg_I64Code lvalue valueTree
297 = panic "assignReg_I64Code(sparc): invalid lvalue"
300 -- Don't delete this -- it's very handy for debugging.
302 -- | trace ("iselExpr64: " ++ showSDoc (ppr expr)) False
303 -- = panic "iselExpr64(???)"
305 iselExpr64 (CmmLoad addrTree I64) = do
306 Amode (AddrRegReg r1 r2) addr_code <- getAmode addrTree
307 rlo <- getNewRegNat I32
308 let rhi = getHiVRegFromLo rlo
309 mov_hi = LD I32 (AddrRegImm r1 (ImmInt 0)) rhi
310 mov_lo = LD I32 (AddrRegImm r1 (ImmInt 4)) rlo
312 ChildCode64 (addr_code `snocOL` mov_hi `snocOL` mov_lo)
316 iselExpr64 (CmmReg (CmmLocal (LocalReg uq I64))) = do
317 r_dst_lo <- getNewRegNat I32
318 let r_dst_hi = getHiVRegFromLo r_dst_lo
319 r_src_lo = mkVReg uq I32
320 r_src_hi = getHiVRegFromLo r_src_lo
321 mov_lo = mkMOV r_src_lo r_dst_lo
322 mov_hi = mkMOV r_src_hi r_dst_hi
323 mkMOV sreg dreg = OR False g0 (RIReg sreg) dreg
325 ChildCode64 (toOL [mov_hi, mov_lo]) r_dst_lo
329 = pprPanic "iselExpr64(sparc)" (ppr expr)
331 #endif /* sparc_TARGET_ARCH */
333 -- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
335 #if powerpc_TARGET_ARCH
337 getI64Amodes :: CmmExpr -> NatM (AddrMode, AddrMode, InstrBlock)
338 getI64Amodes addrTree = do
339 Amode hi_addr addr_code <- getAmode addrTree
340 case addrOffset hi_addr 4 of
341 Just lo_addr -> return (hi_addr, lo_addr, addr_code)
342 Nothing -> do (hi_ptr, code) <- getSomeReg addrTree
343 return (AddrRegImm hi_ptr (ImmInt 0),
344 AddrRegImm hi_ptr (ImmInt 4),
347 assignMem_I64Code addrTree valueTree = do
348 (hi_addr, lo_addr, addr_code) <- getI64Amodes addrTree
349 ChildCode64 vcode rlo <- iselExpr64 valueTree
351 rhi = getHiVRegFromLo rlo
354 mov_hi = ST I32 rhi hi_addr
355 mov_lo = ST I32 rlo lo_addr
357 return (vcode `appOL` addr_code `snocOL` mov_lo `snocOL` mov_hi)
359 assignReg_I64Code (CmmLocal (LocalReg u_dst pk)) valueTree = do
360 ChildCode64 vcode r_src_lo <- iselExpr64 valueTree
362 r_dst_lo = mkVReg u_dst I32
363 r_dst_hi = getHiVRegFromLo r_dst_lo
364 r_src_hi = getHiVRegFromLo r_src_lo
365 mov_lo = MR r_dst_lo r_src_lo
366 mov_hi = MR r_dst_hi r_src_hi
369 vcode `snocOL` mov_lo `snocOL` mov_hi
372 assignReg_I64Code lvalue valueTree
373 = panic "assignReg_I64Code(powerpc): invalid lvalue"
376 -- Don't delete this -- it's very handy for debugging.
378 -- | trace ("iselExpr64: " ++ showSDoc (pprCmmExpr expr)) False
379 -- = panic "iselExpr64(???)"
381 iselExpr64 (CmmLoad addrTree I64) = do
382 (hi_addr, lo_addr, addr_code) <- getI64Amodes addrTree
383 (rlo, rhi) <- getNewRegPairNat I32
384 let mov_hi = LD I32 rhi hi_addr
385 mov_lo = LD I32 rlo lo_addr
386 return $ ChildCode64 (addr_code `snocOL` mov_lo `snocOL` mov_hi)
389 iselExpr64 (CmmReg (CmmLocal (LocalReg vu I64)))
390 = return (ChildCode64 nilOL (mkVReg vu I32))
392 iselExpr64 (CmmLit (CmmInt i _)) = do
393 (rlo,rhi) <- getNewRegPairNat I32
395 half0 = fromIntegral (fromIntegral i :: Word16)
396 half1 = fromIntegral ((fromIntegral i `shiftR` 16) :: Word16)
397 half2 = fromIntegral ((fromIntegral i `shiftR` 32) :: Word16)
398 half3 = fromIntegral ((fromIntegral i `shiftR` 48) :: Word16)
401 LIS rlo (ImmInt half1),
402 OR rlo rlo (RIImm $ ImmInt half0),
403 LIS rhi (ImmInt half3),
404 OR rlo rlo (RIImm $ ImmInt half2)
407 return (ChildCode64 code rlo)
409 iselExpr64 (CmmMachOp (MO_Add _) [e1,e2]) = do
410 ChildCode64 code1 r1lo <- iselExpr64 e1
411 ChildCode64 code2 r2lo <- iselExpr64 e2
412 (rlo,rhi) <- getNewRegPairNat I32
414 r1hi = getHiVRegFromLo r1lo
415 r2hi = getHiVRegFromLo r2lo
418 toOL [ ADDC rlo r1lo r2lo,
421 return (ChildCode64 code rlo)
424 = pprPanic "iselExpr64(powerpc)" (ppr expr)
426 #endif /* powerpc_TARGET_ARCH */
429 -- -----------------------------------------------------------------------------
430 -- The 'Register' type
432 -- 'Register's passed up the tree. If the stix code forces the register
433 -- to live in a pre-decided machine register, it comes out as @Fixed@;
434 -- otherwise, it comes out as @Any@, and the parent can decide which
435 -- register to put it in.
438 = Fixed MachRep Reg InstrBlock
439 | Any MachRep (Reg -> InstrBlock)
441 swizzleRegisterRep :: Register -> MachRep -> Register
442 swizzleRegisterRep (Fixed _ reg code) rep = Fixed rep reg code
443 swizzleRegisterRep (Any _ codefn) rep = Any rep codefn
446 -- -----------------------------------------------------------------------------
447 -- Utils based on getRegister, below
449 -- The dual to getAnyReg: compute an expression into a register, but
450 -- we don't mind which one it is.
451 getSomeReg :: CmmExpr -> NatM (Reg, InstrBlock)
453 r <- getRegister expr
456 tmp <- getNewRegNat rep
457 return (tmp, code tmp)
461 -- -----------------------------------------------------------------------------
462 -- Grab the Reg for a CmmReg
464 getRegisterReg :: CmmReg -> Reg
466 getRegisterReg (CmmLocal (LocalReg u pk))
469 getRegisterReg (CmmGlobal mid)
470 = case get_GlobalReg_reg_or_addr mid of
471 Left (RealReg rrno) -> RealReg rrno
472 _other -> pprPanic "getRegisterReg-memory" (ppr $ CmmGlobal mid)
473 -- By this stage, the only MagicIds remaining should be the
474 -- ones which map to a real machine register on this
475 -- platform. Hence ...
478 -- -----------------------------------------------------------------------------
479 -- Generate code to get a subtree into a Register
481 -- Don't delete this -- it's very handy for debugging.
483 -- | trace ("getRegister: " ++ showSDoc (pprCmmExpr expr)) False
484 -- = panic "getRegister(???)"
486 getRegister :: CmmExpr -> NatM Register
488 getRegister (CmmReg (CmmGlobal PicBaseReg))
490 reg <- getPicBaseNat wordRep
491 return (Fixed wordRep reg nilOL)
493 getRegister (CmmReg reg)
494 = return (Fixed (cmmRegRep reg) (getRegisterReg reg) nilOL)
496 getRegister tree@(CmmRegOff _ _)
497 = getRegister (mangleIndexTree tree)
499 -- end of machine-"independent" bit; here we go on the rest...
501 #if alpha_TARGET_ARCH
503 getRegister (StDouble d)
504 = getBlockIdNat `thenNat` \ lbl ->
505 getNewRegNat PtrRep `thenNat` \ tmp ->
506 let code dst = mkSeqInstrs [
507 LDATA RoDataSegment lbl [
508 DATA TF [ImmLab (rational d)]
510 LDA tmp (AddrImm (ImmCLbl lbl)),
511 LD TF dst (AddrReg tmp)]
513 return (Any F64 code)
515 getRegister (StPrim primop [x]) -- unary PrimOps
517 IntNegOp -> trivialUCode (NEG Q False) x
519 NotOp -> trivialUCode NOT x
521 FloatNegOp -> trivialUFCode FloatRep (FNEG TF) x
522 DoubleNegOp -> trivialUFCode F64 (FNEG TF) x
524 OrdOp -> coerceIntCode IntRep x
527 Float2IntOp -> coerceFP2Int x
528 Int2FloatOp -> coerceInt2FP pr x
529 Double2IntOp -> coerceFP2Int x
530 Int2DoubleOp -> coerceInt2FP pr x
532 Double2FloatOp -> coerceFltCode x
533 Float2DoubleOp -> coerceFltCode x
535 other_op -> getRegister (StCall fn CCallConv F64 [x])
537 fn = case other_op of
538 FloatExpOp -> FSLIT("exp")
539 FloatLogOp -> FSLIT("log")
540 FloatSqrtOp -> FSLIT("sqrt")
541 FloatSinOp -> FSLIT("sin")
542 FloatCosOp -> FSLIT("cos")
543 FloatTanOp -> FSLIT("tan")
544 FloatAsinOp -> FSLIT("asin")
545 FloatAcosOp -> FSLIT("acos")
546 FloatAtanOp -> FSLIT("atan")
547 FloatSinhOp -> FSLIT("sinh")
548 FloatCoshOp -> FSLIT("cosh")
549 FloatTanhOp -> FSLIT("tanh")
550 DoubleExpOp -> FSLIT("exp")
551 DoubleLogOp -> FSLIT("log")
552 DoubleSqrtOp -> FSLIT("sqrt")
553 DoubleSinOp -> FSLIT("sin")
554 DoubleCosOp -> FSLIT("cos")
555 DoubleTanOp -> FSLIT("tan")
556 DoubleAsinOp -> FSLIT("asin")
557 DoubleAcosOp -> FSLIT("acos")
558 DoubleAtanOp -> FSLIT("atan")
559 DoubleSinhOp -> FSLIT("sinh")
560 DoubleCoshOp -> FSLIT("cosh")
561 DoubleTanhOp -> FSLIT("tanh")
563 pr = panic "MachCode.getRegister: no primrep needed for Alpha"
565 getRegister (StPrim primop [x, y]) -- dyadic PrimOps
567 CharGtOp -> trivialCode (CMP LTT) y x
568 CharGeOp -> trivialCode (CMP LE) y x
569 CharEqOp -> trivialCode (CMP EQQ) x y
570 CharNeOp -> int_NE_code x y
571 CharLtOp -> trivialCode (CMP LTT) x y
572 CharLeOp -> trivialCode (CMP LE) x y
574 IntGtOp -> trivialCode (CMP LTT) y x
575 IntGeOp -> trivialCode (CMP LE) y x
576 IntEqOp -> trivialCode (CMP EQQ) x y
577 IntNeOp -> int_NE_code x y
578 IntLtOp -> trivialCode (CMP LTT) x y
579 IntLeOp -> trivialCode (CMP LE) x y
581 WordGtOp -> trivialCode (CMP ULT) y x
582 WordGeOp -> trivialCode (CMP ULE) x y
583 WordEqOp -> trivialCode (CMP EQQ) x y
584 WordNeOp -> int_NE_code x y
585 WordLtOp -> trivialCode (CMP ULT) x y
586 WordLeOp -> trivialCode (CMP ULE) x y
588 AddrGtOp -> trivialCode (CMP ULT) y x
589 AddrGeOp -> trivialCode (CMP ULE) y x
590 AddrEqOp -> trivialCode (CMP EQQ) x y
591 AddrNeOp -> int_NE_code x y
592 AddrLtOp -> trivialCode (CMP ULT) x y
593 AddrLeOp -> trivialCode (CMP ULE) x y
595 FloatGtOp -> cmpF_code (FCMP TF LE) EQQ x y
596 FloatGeOp -> cmpF_code (FCMP TF LTT) EQQ x y
597 FloatEqOp -> cmpF_code (FCMP TF EQQ) NE x y
598 FloatNeOp -> cmpF_code (FCMP TF EQQ) EQQ x y
599 FloatLtOp -> cmpF_code (FCMP TF LTT) NE x y
600 FloatLeOp -> cmpF_code (FCMP TF LE) NE x y
602 DoubleGtOp -> cmpF_code (FCMP TF LE) EQQ x y
603 DoubleGeOp -> cmpF_code (FCMP TF LTT) EQQ x y
604 DoubleEqOp -> cmpF_code (FCMP TF EQQ) NE x y
605 DoubleNeOp -> cmpF_code (FCMP TF EQQ) EQQ x y
606 DoubleLtOp -> cmpF_code (FCMP TF LTT) NE x y
607 DoubleLeOp -> cmpF_code (FCMP TF LE) NE x y
609 IntAddOp -> trivialCode (ADD Q False) x y
610 IntSubOp -> trivialCode (SUB Q False) x y
611 IntMulOp -> trivialCode (MUL Q False) x y
612 IntQuotOp -> trivialCode (DIV Q False) x y
613 IntRemOp -> trivialCode (REM Q False) x y
615 WordAddOp -> trivialCode (ADD Q False) x y
616 WordSubOp -> trivialCode (SUB Q False) x y
617 WordMulOp -> trivialCode (MUL Q False) x y
618 WordQuotOp -> trivialCode (DIV Q True) x y
619 WordRemOp -> trivialCode (REM Q True) x y
621 FloatAddOp -> trivialFCode FloatRep (FADD TF) x y
622 FloatSubOp -> trivialFCode FloatRep (FSUB TF) x y
623 FloatMulOp -> trivialFCode FloatRep (FMUL TF) x y
624 FloatDivOp -> trivialFCode FloatRep (FDIV TF) x y
626 DoubleAddOp -> trivialFCode F64 (FADD TF) x y
627 DoubleSubOp -> trivialFCode F64 (FSUB TF) x y
628 DoubleMulOp -> trivialFCode F64 (FMUL TF) x y
629 DoubleDivOp -> trivialFCode F64 (FDIV TF) x y
631 AddrAddOp -> trivialCode (ADD Q False) x y
632 AddrSubOp -> trivialCode (SUB Q False) x y
633 AddrRemOp -> trivialCode (REM Q True) x y
635 AndOp -> trivialCode AND x y
636 OrOp -> trivialCode OR x y
637 XorOp -> trivialCode XOR x y
638 SllOp -> trivialCode SLL x y
639 SrlOp -> trivialCode SRL x y
641 ISllOp -> trivialCode SLL x y -- was: panic "AlphaGen:isll"
642 ISraOp -> trivialCode SRA x y -- was: panic "AlphaGen:isra"
643 ISrlOp -> trivialCode SRL x y -- was: panic "AlphaGen:isrl"
645 FloatPowerOp -> getRegister (StCall FSLIT("pow") CCallConv F64 [x,y])
646 DoublePowerOp -> getRegister (StCall FSLIT("pow") CCallConv F64 [x,y])
648 {- ------------------------------------------------------------
649 Some bizarre special code for getting condition codes into
650 registers. Integer non-equality is a test for equality
651 followed by an XOR with 1. (Integer comparisons always set
652 the result register to 0 or 1.) Floating point comparisons of
653 any kind leave the result in a floating point register, so we
654 need to wrangle an integer register out of things.
656 int_NE_code :: StixTree -> StixTree -> NatM Register
659 = trivialCode (CMP EQQ) x y `thenNat` \ register ->
660 getNewRegNat IntRep `thenNat` \ tmp ->
662 code = registerCode register tmp
663 src = registerName register tmp
664 code__2 dst = code . mkSeqInstr (XOR src (RIImm (ImmInt 1)) dst)
666 return (Any IntRep code__2)
668 {- ------------------------------------------------------------
669 Comments for int_NE_code also apply to cmpF_code
672 :: (Reg -> Reg -> Reg -> Instr)
674 -> StixTree -> StixTree
677 cmpF_code instr cond x y
678 = trivialFCode pr instr x y `thenNat` \ register ->
679 getNewRegNat F64 `thenNat` \ tmp ->
680 getBlockIdNat `thenNat` \ lbl ->
682 code = registerCode register tmp
683 result = registerName register tmp
685 code__2 dst = code . mkSeqInstrs [
686 OR zeroh (RIImm (ImmInt 1)) dst,
687 BF cond result (ImmCLbl lbl),
688 OR zeroh (RIReg zeroh) dst,
691 return (Any IntRep code__2)
693 pr = panic "trivialU?FCode: does not use PrimRep on Alpha"
694 ------------------------------------------------------------
696 getRegister (CmmLoad pk mem)
697 = getAmode mem `thenNat` \ amode ->
699 code = amodeCode amode
700 src = amodeAddr amode
701 size = primRepToSize pk
702 code__2 dst = code . mkSeqInstr (LD size dst src)
704 return (Any pk code__2)
706 getRegister (StInt i)
709 code dst = mkSeqInstr (OR zeroh (RIImm src) dst)
711 return (Any IntRep code)
714 code dst = mkSeqInstr (LDI Q dst src)
716 return (Any IntRep code)
718 src = ImmInt (fromInteger i)
723 code dst = mkSeqInstr (LDA dst (AddrImm imm__2))
725 return (Any PtrRep code)
728 imm__2 = case imm of Just x -> x
730 #endif /* alpha_TARGET_ARCH */
732 -- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
736 getRegister (CmmLit (CmmFloat f F32)) = do
737 lbl <- getNewLabelNat
738 let code dst = toOL [
741 CmmStaticLit (CmmFloat f F32)],
742 GLD F32 (ImmAddr (ImmCLbl lbl) 0) dst
745 return (Any F32 code)
748 getRegister (CmmLit (CmmFloat d F64))
750 = let code dst = unitOL (GLDZ dst)
751 in return (Any F64 code)
754 = let code dst = unitOL (GLD1 dst)
755 in return (Any F64 code)
758 lbl <- getNewLabelNat
759 let code dst = toOL [
762 CmmStaticLit (CmmFloat d F64)],
763 GLD F64 (ImmAddr (ImmCLbl lbl) 0) dst
766 return (Any F64 code)
768 #endif /* i386_TARGET_ARCH */
770 #if x86_64_TARGET_ARCH
772 getRegister (CmmLit (CmmFloat 0.0 rep)) = do
773 let code dst = unitOL (XOR rep (OpReg dst) (OpReg dst))
774 -- I don't know why there are xorpd, xorps, and pxor instructions.
775 -- They all appear to do the same thing --SDM
776 return (Any rep code)
778 getRegister (CmmLit (CmmFloat f rep)) = do
779 lbl <- getNewLabelNat
780 let code dst = toOL [
783 CmmStaticLit (CmmFloat f rep)],
784 MOV rep (OpAddr (ripRel (ImmCLbl lbl))) (OpReg dst)
787 return (Any rep code)
789 #endif /* x86_64_TARGET_ARCH */
791 #if i386_TARGET_ARCH || x86_64_TARGET_ARCH
793 -- catch simple cases of zero- or sign-extended load
794 getRegister (CmmMachOp (MO_U_Conv I8 I32) [CmmLoad addr _]) = do
795 code <- intLoadCode (MOVZxL I8) addr
796 return (Any I32 code)
798 getRegister (CmmMachOp (MO_S_Conv I8 I32) [CmmLoad addr _]) = do
799 code <- intLoadCode (MOVSxL I8) addr
800 return (Any I32 code)
802 getRegister (CmmMachOp (MO_U_Conv I16 I32) [CmmLoad addr _]) = do
803 code <- intLoadCode (MOVZxL I16) addr
804 return (Any I32 code)
806 getRegister (CmmMachOp (MO_S_Conv I16 I32) [CmmLoad addr _]) = do
807 code <- intLoadCode (MOVSxL I16) addr
808 return (Any I32 code)
812 #if x86_64_TARGET_ARCH
814 -- catch simple cases of zero- or sign-extended load
815 getRegister (CmmMachOp (MO_U_Conv I8 I64) [CmmLoad addr _]) = do
816 code <- intLoadCode (MOVZxL I8) addr
817 return (Any I64 code)
819 getRegister (CmmMachOp (MO_S_Conv I8 I64) [CmmLoad addr _]) = do
820 code <- intLoadCode (MOVSxL I8) addr
821 return (Any I64 code)
823 getRegister (CmmMachOp (MO_U_Conv I16 I64) [CmmLoad addr _]) = do
824 code <- intLoadCode (MOVZxL I16) addr
825 return (Any I64 code)
827 getRegister (CmmMachOp (MO_S_Conv I16 I64) [CmmLoad addr _]) = do
828 code <- intLoadCode (MOVSxL I16) addr
829 return (Any I64 code)
831 getRegister (CmmMachOp (MO_U_Conv I32 I64) [CmmLoad addr _]) = do
832 code <- intLoadCode (MOV I32) addr -- 32-bit loads zero-extend
833 return (Any I64 code)
835 getRegister (CmmMachOp (MO_S_Conv I32 I64) [CmmLoad addr _]) = do
836 code <- intLoadCode (MOVSxL I32) addr
837 return (Any I64 code)
841 #if x86_64_TARGET_ARCH
842 getRegister (CmmMachOp (MO_S_Neg F32) [x]) = do
843 x_code <- getAnyReg x
844 lbl <- getNewLabelNat
846 code dst = x_code dst `appOL` toOL [
847 -- This is how gcc does it, so it can't be that bad:
848 LDATA ReadOnlyData16 [
851 CmmStaticLit (CmmInt 0x80000000 I32),
852 CmmStaticLit (CmmInt 0 I32),
853 CmmStaticLit (CmmInt 0 I32),
854 CmmStaticLit (CmmInt 0 I32)
856 XOR F32 (OpAddr (ripRel (ImmCLbl lbl))) (OpReg dst)
857 -- xorps, so we need the 128-bit constant
858 -- ToDo: rip-relative
861 return (Any F32 code)
863 getRegister (CmmMachOp (MO_S_Neg F64) [x]) = do
864 x_code <- getAnyReg x
865 lbl <- getNewLabelNat
867 -- This is how gcc does it, so it can't be that bad:
868 code dst = x_code dst `appOL` toOL [
869 LDATA ReadOnlyData16 [
872 CmmStaticLit (CmmInt 0x8000000000000000 I64),
873 CmmStaticLit (CmmInt 0 I64)
875 -- gcc puts an unpck here. Wonder if we need it.
876 XOR F64 (OpAddr (ripRel (ImmCLbl lbl))) (OpReg dst)
877 -- xorpd, so we need the 128-bit constant
880 return (Any F64 code)
883 #if i386_TARGET_ARCH || x86_64_TARGET_ARCH
885 getRegister (CmmMachOp mop [x]) -- unary MachOps
888 MO_S_Neg F32 -> trivialUFCode F32 (GNEG F32) x
889 MO_S_Neg F64 -> trivialUFCode F64 (GNEG F64) x
892 MO_S_Neg rep -> trivialUCode rep (NEGI rep) x
893 MO_Not rep -> trivialUCode rep (NOT rep) x
896 -- TODO: these are only nops if the arg is not a fixed register that
897 -- can't be byte-addressed.
898 MO_U_Conv I32 I8 -> conversionNop I32 x
899 MO_S_Conv I32 I8 -> conversionNop I32 x
900 MO_U_Conv I16 I8 -> conversionNop I16 x
901 MO_S_Conv I16 I8 -> conversionNop I16 x
902 MO_U_Conv I32 I16 -> conversionNop I32 x
903 MO_S_Conv I32 I16 -> conversionNop I32 x
904 #if x86_64_TARGET_ARCH
905 MO_U_Conv I64 I32 -> conversionNop I64 x
906 MO_S_Conv I64 I32 -> conversionNop I64 x
907 MO_U_Conv I64 I16 -> conversionNop I64 x
908 MO_S_Conv I64 I16 -> conversionNop I64 x
909 MO_U_Conv I64 I8 -> conversionNop I64 x
910 MO_S_Conv I64 I8 -> conversionNop I64 x
913 MO_U_Conv rep1 rep2 | rep1 == rep2 -> conversionNop rep1 x
914 MO_S_Conv rep1 rep2 | rep1 == rep2 -> conversionNop rep1 x
917 MO_U_Conv I8 I32 -> integerExtend I8 I32 MOVZxL x
918 MO_U_Conv I16 I32 -> integerExtend I16 I32 MOVZxL x
919 MO_U_Conv I8 I16 -> integerExtend I8 I16 MOVZxL x
921 MO_S_Conv I8 I32 -> integerExtend I8 I32 MOVSxL x
922 MO_S_Conv I16 I32 -> integerExtend I16 I32 MOVSxL x
923 MO_S_Conv I8 I16 -> integerExtend I8 I16 MOVSxL x
925 #if x86_64_TARGET_ARCH
926 MO_U_Conv I8 I64 -> integerExtend I8 I64 MOVZxL x
927 MO_U_Conv I16 I64 -> integerExtend I16 I64 MOVZxL x
928 MO_U_Conv I32 I64 -> integerExtend I32 I64 MOVZxL x
929 MO_S_Conv I8 I64 -> integerExtend I8 I64 MOVSxL x
930 MO_S_Conv I16 I64 -> integerExtend I16 I64 MOVSxL x
931 MO_S_Conv I32 I64 -> integerExtend I32 I64 MOVSxL x
932 -- for 32-to-64 bit zero extension, amd64 uses an ordinary movl.
933 -- However, we don't want the register allocator to throw it
934 -- away as an unnecessary reg-to-reg move, so we keep it in
935 -- the form of a movzl and print it as a movl later.
939 MO_S_Conv F32 F64 -> conversionNop F64 x
940 MO_S_Conv F64 F32 -> conversionNop F32 x
942 MO_S_Conv F32 F64 -> coerceFP2FP F64 x
943 MO_S_Conv F64 F32 -> coerceFP2FP F32 x
947 | isFloatingRep from -> coerceFP2Int from to x
948 | isFloatingRep to -> coerceInt2FP from to x
950 other -> pprPanic "getRegister" (pprMachOp mop)
952 -- signed or unsigned extension.
953 integerExtend from to instr expr = do
954 (reg,e_code) <- if from == I8 then getByteReg expr
959 instr from (OpReg reg) (OpReg dst)
962 conversionNop new_rep expr
963 = do e_code <- getRegister expr
964 return (swizzleRegisterRep e_code new_rep)
967 getRegister e@(CmmMachOp mop [x, y]) -- dyadic MachOps
968 = ASSERT2(cmmExprRep x /= I8, pprExpr e)
970 MO_Eq F32 -> condFltReg EQQ x y
971 MO_Ne F32 -> condFltReg NE x y
972 MO_S_Gt F32 -> condFltReg GTT x y
973 MO_S_Ge F32 -> condFltReg GE x y
974 MO_S_Lt F32 -> condFltReg LTT x y
975 MO_S_Le F32 -> condFltReg LE x y
977 MO_Eq F64 -> condFltReg EQQ x y
978 MO_Ne F64 -> condFltReg NE x y
979 MO_S_Gt F64 -> condFltReg GTT x y
980 MO_S_Ge F64 -> condFltReg GE x y
981 MO_S_Lt F64 -> condFltReg LTT x y
982 MO_S_Le F64 -> condFltReg LE x y
984 MO_Eq rep -> condIntReg EQQ x y
985 MO_Ne rep -> condIntReg NE x y
987 MO_S_Gt rep -> condIntReg GTT x y
988 MO_S_Ge rep -> condIntReg GE x y
989 MO_S_Lt rep -> condIntReg LTT x y
990 MO_S_Le rep -> condIntReg LE x y
992 MO_U_Gt rep -> condIntReg GU x y
993 MO_U_Ge rep -> condIntReg GEU x y
994 MO_U_Lt rep -> condIntReg LU x y
995 MO_U_Le rep -> condIntReg LEU x y
998 MO_Add F32 -> trivialFCode F32 GADD x y
999 MO_Sub F32 -> trivialFCode F32 GSUB x y
1001 MO_Add F64 -> trivialFCode F64 GADD x y
1002 MO_Sub F64 -> trivialFCode F64 GSUB x y
1004 MO_S_Quot F32 -> trivialFCode F32 GDIV x y
1005 MO_S_Quot F64 -> trivialFCode F64 GDIV x y
1008 #if x86_64_TARGET_ARCH
1009 MO_Add F32 -> trivialFCode F32 ADD x y
1010 MO_Sub F32 -> trivialFCode F32 SUB x y
1012 MO_Add F64 -> trivialFCode F64 ADD x y
1013 MO_Sub F64 -> trivialFCode F64 SUB x y
1015 MO_S_Quot F32 -> trivialFCode F32 FDIV x y
1016 MO_S_Quot F64 -> trivialFCode F64 FDIV x y
1019 MO_Add rep -> add_code rep x y
1020 MO_Sub rep -> sub_code rep x y
1022 MO_S_Quot rep -> div_code rep True True x y
1023 MO_S_Rem rep -> div_code rep True False x y
1024 MO_U_Quot rep -> div_code rep False True x y
1025 MO_U_Rem rep -> div_code rep False False x y
1027 #if i386_TARGET_ARCH
1028 MO_Mul F32 -> trivialFCode F32 GMUL x y
1029 MO_Mul F64 -> trivialFCode F64 GMUL x y
1032 #if x86_64_TARGET_ARCH
1033 MO_Mul F32 -> trivialFCode F32 MUL x y
1034 MO_Mul F64 -> trivialFCode F64 MUL x y
1037 MO_Mul rep -> let op = IMUL rep in
1038 trivialCode rep op (Just op) x y
1040 MO_S_MulMayOflo rep -> imulMayOflo rep x y
1042 MO_And rep -> let op = AND rep in
1043 trivialCode rep op (Just op) x y
1044 MO_Or rep -> let op = OR rep in
1045 trivialCode rep op (Just op) x y
1046 MO_Xor rep -> let op = XOR rep in
1047 trivialCode rep op (Just op) x y
1049 {- Shift ops on x86s have constraints on their source, it
1050 either has to be Imm, CL or 1
1051 => trivialCode is not restrictive enough (sigh.)
1053 MO_Shl rep -> shift_code rep (SHL rep) x y {-False-}
1054 MO_U_Shr rep -> shift_code rep (SHR rep) x y {-False-}
1055 MO_S_Shr rep -> shift_code rep (SAR rep) x y {-False-}
1057 other -> pprPanic "getRegister(x86) - binary CmmMachOp (1)" (pprMachOp mop)
1059 --------------------
1060 imulMayOflo :: MachRep -> CmmExpr -> CmmExpr -> NatM Register
1061 imulMayOflo rep a b = do
1062 (a_reg, a_code) <- getNonClobberedReg a
1063 b_code <- getAnyReg b
1065 shift_amt = case rep of
1068 _ -> panic "shift_amt"
1070 code = a_code `appOL` b_code eax `appOL`
1072 IMUL2 rep (OpReg a_reg), -- result in %edx:%eax
1073 SAR rep (OpImm (ImmInt shift_amt)) (OpReg eax),
1074 -- sign extend lower part
1075 SUB rep (OpReg edx) (OpReg eax)
1076 -- compare against upper
1077 -- eax==0 if high part == sign extended low part
1080 return (Fixed rep eax code)
1082 --------------------
1083 shift_code :: MachRep
1084 -> (Operand -> Operand -> Instr)
1089 {- Case1: shift length as immediate -}
1090 shift_code rep instr x y@(CmmLit lit) = do
1091 x_code <- getAnyReg x
1094 = x_code dst `snocOL`
1095 instr (OpImm (litToImm lit)) (OpReg dst)
1097 return (Any rep code)
1099 {- Case2: shift length is complex (non-immediate) -}
1100 shift_code rep instr x y{-amount-} = do
1101 (x_reg, x_code) <- getNonClobberedReg x
1102 y_code <- getAnyReg y
1104 code = x_code `appOL`
1106 instr (OpReg ecx) (OpReg x_reg)
1108 return (Fixed rep x_reg code)
1110 --------------------
1111 add_code :: MachRep -> CmmExpr -> CmmExpr -> NatM Register
1112 add_code rep x (CmmLit (CmmInt y _)) = add_int rep x y
1113 add_code rep x y = trivialCode rep (ADD rep) (Just (ADD rep)) x y
1115 --------------------
1116 sub_code :: MachRep -> CmmExpr -> CmmExpr -> NatM Register
1117 sub_code rep x (CmmLit (CmmInt y _)) = add_int rep x (-y)
1118 sub_code rep x y = trivialCode rep (SUB rep) Nothing x y
1120 -- our three-operand add instruction:
1121 add_int rep x y = do
1122 (x_reg, x_code) <- getSomeReg x
1124 imm = ImmInt (fromInteger y)
1128 (OpAddr (AddrBaseIndex (EABaseReg x_reg) EAIndexNone imm))
1131 return (Any rep code)
1133 ----------------------
1134 div_code rep signed quotient x y = do
1135 (y_op, y_code) <- getRegOrMem y -- cannot be clobbered
1136 x_code <- getAnyReg x
1138 widen | signed = CLTD rep
1139 | otherwise = XOR rep (OpReg edx) (OpReg edx)
1141 instr | signed = IDIV
1144 code = y_code `appOL`
1146 toOL [widen, instr rep y_op]
1148 result | quotient = eax
1152 return (Fixed rep result code)
1155 getRegister (CmmLoad mem pk)
1158 Amode src mem_code <- getAmode mem
1160 code dst = mem_code `snocOL`
1161 IF_ARCH_i386(GLD pk src dst,
1162 MOV pk (OpAddr src) (OpReg dst))
1164 return (Any pk code)
1166 #if i386_TARGET_ARCH
1167 getRegister (CmmLoad mem pk)
1170 code <- intLoadCode (instr pk) mem
1171 return (Any pk code)
1173 instr I8 = MOVZxL pk
1176 -- we always zero-extend 8-bit loads, if we
1177 -- can't think of anything better. This is because
1178 -- we can't guarantee access to an 8-bit variant of every register
1179 -- (esi and edi don't have 8-bit variants), so to make things
1180 -- simpler we do our 8-bit arithmetic with full 32-bit registers.
1183 #if x86_64_TARGET_ARCH
1184 -- Simpler memory load code on x86_64
1185 getRegister (CmmLoad mem pk)
1187 code <- intLoadCode (MOV pk) mem
1188 return (Any pk code)
1191 getRegister (CmmLit (CmmInt 0 rep))
1193 -- x86_64: 32-bit xor is one byte shorter, and zero-extends to 64 bits
1194 adj_rep = case rep of I64 -> I32; _ -> rep
1195 rep1 = IF_ARCH_i386( rep, adj_rep )
1197 = unitOL (XOR rep1 (OpReg dst) (OpReg dst))
1199 return (Any rep code)
1201 #if x86_64_TARGET_ARCH
1202 -- optimisation for loading small literals on x86_64: take advantage
1203 -- of the automatic zero-extension from 32 to 64 bits, because the 32-bit
1204 -- instruction forms are shorter.
1205 getRegister (CmmLit lit)
1206 | I64 <- cmmLitRep lit, not (isBigLit lit)
1209 code dst = unitOL (MOV I32 (OpImm imm) (OpReg dst))
1211 return (Any I64 code)
1213 isBigLit (CmmInt i I64) = i < 0 || i > 0xffffffff
1215 -- note1: not the same as is64BitLit, because that checks for
1216 -- signed literals that fit in 32 bits, but we want unsigned
1218 -- note2: all labels are small, because we're assuming the
1219 -- small memory model (see gcc docs, -mcmodel=small).
1222 getRegister (CmmLit lit)
1226 code dst = unitOL (MOV rep (OpImm imm) (OpReg dst))
1228 return (Any rep code)
1230 getRegister other = pprPanic "getRegister(x86)" (ppr other)
1233 intLoadCode :: (Operand -> Operand -> Instr) -> CmmExpr
1234 -> NatM (Reg -> InstrBlock)
1235 intLoadCode instr mem = do
1236 Amode src mem_code <- getAmode mem
1237 return (\dst -> mem_code `snocOL` instr (OpAddr src) (OpReg dst))
1239 -- Compute an expression into *any* register, adding the appropriate
1240 -- move instruction if necessary.
1241 getAnyReg :: CmmExpr -> NatM (Reg -> InstrBlock)
1243 r <- getRegister expr
1246 anyReg :: Register -> NatM (Reg -> InstrBlock)
1247 anyReg (Any _ code) = return code
1248 anyReg (Fixed rep reg fcode) = return (\dst -> fcode `snocOL` reg2reg rep reg dst)
1250 -- A bit like getSomeReg, but we want a reg that can be byte-addressed.
1251 -- Fixed registers might not be byte-addressable, so we make sure we've
1252 -- got a temporary, inserting an extra reg copy if necessary.
1253 getByteReg :: CmmExpr -> NatM (Reg, InstrBlock)
1254 #if x86_64_TARGET_ARCH
1255 getByteReg = getSomeReg -- all regs are byte-addressable on x86_64
1257 getByteReg expr = do
1258 r <- getRegister expr
1261 tmp <- getNewRegNat rep
1262 return (tmp, code tmp)
1264 | isVirtualReg reg -> return (reg,code)
1266 tmp <- getNewRegNat rep
1267 return (tmp, code `snocOL` reg2reg rep reg tmp)
1268 -- ToDo: could optimise slightly by checking for byte-addressable
1269 -- real registers, but that will happen very rarely if at all.
1272 -- Another variant: this time we want the result in a register that cannot
1273 -- be modified by code to evaluate an arbitrary expression.
1274 getNonClobberedReg :: CmmExpr -> NatM (Reg, InstrBlock)
1275 getNonClobberedReg expr = do
1276 r <- getRegister expr
1279 tmp <- getNewRegNat rep
1280 return (tmp, code tmp)
1282 -- only free regs can be clobbered
1283 | RealReg rr <- reg, isFastTrue (freeReg rr) -> do
1284 tmp <- getNewRegNat rep
1285 return (tmp, code `snocOL` reg2reg rep reg tmp)
1289 reg2reg :: MachRep -> Reg -> Reg -> Instr
1291 #if i386_TARGET_ARCH
1292 | isFloatingRep rep = GMOV src dst
1294 | otherwise = MOV rep (OpReg src) (OpReg dst)
1296 #endif /* i386_TARGET_ARCH || x86_64_TARGET_ARCH */
1298 -- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
1300 #if sparc_TARGET_ARCH
1302 getRegister (CmmLit (CmmFloat f F32)) = do
1303 lbl <- getNewLabelNat
1304 let code dst = toOL [
1307 CmmStaticLit (CmmFloat f F32)],
1308 SETHI (HI (ImmCLbl lbl)) dst,
1309 LD F32 (AddrRegImm dst (LO (ImmCLbl lbl))) dst]
1310 return (Any F32 code)
1312 getRegister (CmmLit (CmmFloat d F64)) = do
1313 lbl <- getNewLabelNat
1314 let code dst = toOL [
1317 CmmStaticLit (CmmFloat d F64)],
1318 SETHI (HI (ImmCLbl lbl)) dst,
1319 LD F64 (AddrRegImm dst (LO (ImmCLbl lbl))) dst]
1320 return (Any F64 code)
1322 getRegister (CmmMachOp mop [x]) -- unary MachOps
1324 MO_S_Neg F32 -> trivialUFCode F32 (FNEG F32) x
1325 MO_S_Neg F64 -> trivialUFCode F64 (FNEG F64) x
1327 MO_S_Neg rep -> trivialUCode rep (SUB False False g0) x
1328 MO_Not rep -> trivialUCode rep (XNOR False g0) x
1330 MO_U_Conv I32 I8 -> trivialCode I8 (AND False) x (CmmLit (CmmInt 255 I8))
1332 MO_U_Conv F64 F32-> coerceDbl2Flt x
1333 MO_U_Conv F32 F64-> coerceFlt2Dbl x
1335 MO_S_Conv F32 I32-> coerceFP2Int F32 I32 x
1336 MO_S_Conv I32 F32-> coerceInt2FP I32 F32 x
1337 MO_S_Conv F64 I32-> coerceFP2Int F64 I32 x
1338 MO_S_Conv I32 F64-> coerceInt2FP I32 F64 x
1340 -- Conversions which are a nop on sparc
1342 | from == to -> conversionNop to x
1343 MO_U_Conv I32 to -> conversionNop to x
1344 MO_S_Conv I32 to -> conversionNop to x
1347 MO_U_Conv I8 I32 -> integerExtend False I8 I32 x
1348 MO_U_Conv I16 I32 -> integerExtend False I16 I32 x
1349 MO_U_Conv I8 I16 -> integerExtend False I8 I16 x
1350 MO_S_Conv I16 I32 -> integerExtend True I16 I32 x
1352 other_op -> panic "Unknown unary mach op"
1355 integerExtend signed from to expr = do
1356 (reg, e_code) <- getSomeReg expr
1360 ((if signed then SRA else SRL)
1361 reg (RIImm (ImmInt 0)) dst)
1362 return (Any to code)
1363 conversionNop new_rep expr
1364 = do e_code <- getRegister expr
1365 return (swizzleRegisterRep e_code new_rep)
1367 getRegister (CmmMachOp mop [x, y]) -- dyadic PrimOps
1369 MO_Eq F32 -> condFltReg EQQ x y
1370 MO_Ne F32 -> condFltReg NE x y
1372 MO_S_Gt F32 -> condFltReg GTT x y
1373 MO_S_Ge F32 -> condFltReg GE x y
1374 MO_S_Lt F32 -> condFltReg LTT x y
1375 MO_S_Le F32 -> condFltReg LE x y
1377 MO_Eq F64 -> condFltReg EQQ x y
1378 MO_Ne F64 -> condFltReg NE x y
1380 MO_S_Gt F64 -> condFltReg GTT x y
1381 MO_S_Ge F64 -> condFltReg GE x y
1382 MO_S_Lt F64 -> condFltReg LTT x y
1383 MO_S_Le F64 -> condFltReg LE x y
1385 MO_Eq rep -> condIntReg EQQ x y
1386 MO_Ne rep -> condIntReg NE x y
1388 MO_S_Gt rep -> condIntReg GTT x y
1389 MO_S_Ge rep -> condIntReg GE x y
1390 MO_S_Lt rep -> condIntReg LTT x y
1391 MO_S_Le rep -> condIntReg LE x y
1393 MO_U_Gt I32 -> condIntReg GTT x y
1394 MO_U_Ge I32 -> condIntReg GE x y
1395 MO_U_Lt I32 -> condIntReg LTT x y
1396 MO_U_Le I32 -> condIntReg LE x y
1398 MO_U_Gt I16 -> condIntReg GU x y
1399 MO_U_Ge I16 -> condIntReg GEU x y
1400 MO_U_Lt I16 -> condIntReg LU x y
1401 MO_U_Le I16 -> condIntReg LEU x y
1403 MO_Add I32 -> trivialCode I32 (ADD False False) x y
1404 MO_Sub I32 -> trivialCode I32 (SUB False False) x y
1406 MO_S_MulMayOflo rep -> imulMayOflo rep x y
1408 -- ToDo: teach about V8+ SPARC div instructions
1409 MO_S_Quot I32 -> idiv FSLIT(".div") x y
1410 MO_S_Rem I32 -> idiv FSLIT(".rem") x y
1411 MO_U_Quot I32 -> idiv FSLIT(".udiv") x y
1412 MO_U_Rem I32 -> idiv FSLIT(".urem") x y
1414 MO_Add F32 -> trivialFCode F32 FADD x y
1415 MO_Sub F32 -> trivialFCode F32 FSUB x y
1416 MO_Mul F32 -> trivialFCode F32 FMUL x y
1417 MO_S_Quot F32 -> trivialFCode F32 FDIV x y
1419 MO_Add F64 -> trivialFCode F64 FADD x y
1420 MO_Sub F64 -> trivialFCode F64 FSUB x y
1421 MO_Mul F64 -> trivialFCode F64 FMUL x y
1422 MO_S_Quot F64 -> trivialFCode F64 FDIV x y
1424 MO_And rep -> trivialCode rep (AND False) x y
1425 MO_Or rep -> trivialCode rep (OR False) x y
1426 MO_Xor rep -> trivialCode rep (XOR False) x y
1428 MO_Mul rep -> trivialCode rep (SMUL False) x y
1430 MO_Shl rep -> trivialCode rep SLL x y
1431 MO_U_Shr rep -> trivialCode rep SRL x y
1432 MO_S_Shr rep -> trivialCode rep SRA x y
1435 MO_F32_Pwr -> getRegister (StCall (Left FSLIT("pow")) CCallConv F64
1436 [promote x, promote y])
1437 where promote x = CmmMachOp MO_F32_to_Dbl [x]
1438 MO_F64_Pwr -> getRegister (StCall (Left FSLIT("pow")) CCallConv F64
1441 other -> pprPanic "getRegister(sparc) - binary CmmMachOp (1)" (pprMachOp mop)
1443 --idiv fn x y = getRegister (StCall (Left fn) CCallConv I32 [x, y])
1445 --------------------
1446 imulMayOflo :: MachRep -> CmmExpr -> CmmExpr -> NatM Register
1447 imulMayOflo rep a b = do
1448 (a_reg, a_code) <- getSomeReg a
1449 (b_reg, b_code) <- getSomeReg b
1450 res_lo <- getNewRegNat I32
1451 res_hi <- getNewRegNat I32
1453 shift_amt = case rep of
1456 _ -> panic "shift_amt"
1457 code dst = a_code `appOL` b_code `appOL`
1459 SMUL False a_reg (RIReg b_reg) res_lo,
1461 SRA res_lo (RIImm (ImmInt shift_amt)) res_lo,
1462 SUB False False res_lo (RIReg res_hi) dst
1464 return (Any I32 code)
1466 getRegister (CmmLoad mem pk) = do
1467 Amode src code <- getAmode mem
1469 code__2 dst = code `snocOL` LD pk src dst
1470 return (Any pk code__2)
1472 getRegister (CmmLit (CmmInt i _))
1475 src = ImmInt (fromInteger i)
1476 code dst = unitOL (OR False g0 (RIImm src) dst)
1478 return (Any I32 code)
1480 getRegister (CmmLit lit)
1481 = let rep = cmmLitRep lit
1485 OR False dst (RIImm (LO imm)) dst]
1486 in return (Any I32 code)
1488 #endif /* sparc_TARGET_ARCH */
1490 #if powerpc_TARGET_ARCH
1491 getRegister (CmmLoad mem pk)
1494 Amode addr addr_code <- getAmode mem
1495 let code dst = ASSERT((regClass dst == RcDouble) == isFloatingRep pk)
1496 addr_code `snocOL` LD pk dst addr
1497 return (Any pk code)
1499 -- catch simple cases of zero- or sign-extended load
1500 getRegister (CmmMachOp (MO_U_Conv I8 I32) [CmmLoad mem _]) = do
1501 Amode addr addr_code <- getAmode mem
1502 return (Any I32 (\dst -> addr_code `snocOL` LD I8 dst addr))
1504 -- Note: there is no Load Byte Arithmetic instruction, so no signed case here
1506 getRegister (CmmMachOp (MO_U_Conv I16 I32) [CmmLoad mem _]) = do
1507 Amode addr addr_code <- getAmode mem
1508 return (Any I32 (\dst -> addr_code `snocOL` LD I16 dst addr))
1510 getRegister (CmmMachOp (MO_S_Conv I16 I32) [CmmLoad mem _]) = do
1511 Amode addr addr_code <- getAmode mem
1512 return (Any I32 (\dst -> addr_code `snocOL` LA I16 dst addr))
1514 getRegister (CmmMachOp mop [x]) -- unary MachOps
1516 MO_Not rep -> trivialUCode rep NOT x
1518 MO_S_Conv F64 F32 -> trivialUCode F32 FRSP x
1519 MO_S_Conv F32 F64 -> conversionNop F64 x
1522 | from == to -> conversionNop to x
1523 | isFloatingRep from -> coerceFP2Int from to x
1524 | isFloatingRep to -> coerceInt2FP from to x
1526 -- narrowing is a nop: we treat the high bits as undefined
1527 MO_S_Conv I32 to -> conversionNop to x
1528 MO_S_Conv I16 I8 -> conversionNop I8 x
1529 MO_S_Conv I8 to -> trivialUCode to (EXTS I8) x
1530 MO_S_Conv I16 to -> trivialUCode to (EXTS I16) x
1533 | from == to -> conversionNop to x
1534 -- narrowing is a nop: we treat the high bits as undefined
1535 MO_U_Conv I32 to -> conversionNop to x
1536 MO_U_Conv I16 I8 -> conversionNop I8 x
1537 MO_U_Conv I8 to -> trivialCode to False AND x (CmmLit (CmmInt 255 I32))
1538 MO_U_Conv I16 to -> trivialCode to False AND x (CmmLit (CmmInt 65535 I32))
1540 MO_S_Neg F32 -> trivialUCode F32 FNEG x
1541 MO_S_Neg F64 -> trivialUCode F64 FNEG x
1542 MO_S_Neg rep -> trivialUCode rep NEG x
1545 conversionNop new_rep expr
1546 = do e_code <- getRegister expr
1547 return (swizzleRegisterRep e_code new_rep)
1549 getRegister (CmmMachOp mop [x, y]) -- dyadic PrimOps
1551 MO_Eq F32 -> condFltReg EQQ x y
1552 MO_Ne F32 -> condFltReg NE x y
1554 MO_S_Gt F32 -> condFltReg GTT x y
1555 MO_S_Ge F32 -> condFltReg GE x y
1556 MO_S_Lt F32 -> condFltReg LTT x y
1557 MO_S_Le F32 -> condFltReg LE x y
1559 MO_Eq F64 -> condFltReg EQQ x y
1560 MO_Ne F64 -> condFltReg NE x y
1562 MO_S_Gt F64 -> condFltReg GTT x y
1563 MO_S_Ge F64 -> condFltReg GE x y
1564 MO_S_Lt F64 -> condFltReg LTT x y
1565 MO_S_Le F64 -> condFltReg LE x y
1567 MO_Eq rep -> condIntReg EQQ (extendUExpr rep x) (extendUExpr rep y)
1568 MO_Ne rep -> condIntReg NE (extendUExpr rep x) (extendUExpr rep y)
1570 MO_S_Gt rep -> condIntReg GTT (extendSExpr rep x) (extendSExpr rep y)
1571 MO_S_Ge rep -> condIntReg GE (extendSExpr rep x) (extendSExpr rep y)
1572 MO_S_Lt rep -> condIntReg LTT (extendSExpr rep x) (extendSExpr rep y)
1573 MO_S_Le rep -> condIntReg LE (extendSExpr rep x) (extendSExpr rep y)
1575 MO_U_Gt rep -> condIntReg GU (extendUExpr rep x) (extendUExpr rep y)
1576 MO_U_Ge rep -> condIntReg GEU (extendUExpr rep x) (extendUExpr rep y)
1577 MO_U_Lt rep -> condIntReg LU (extendUExpr rep x) (extendUExpr rep y)
1578 MO_U_Le rep -> condIntReg LEU (extendUExpr rep x) (extendUExpr rep y)
1580 MO_Add F32 -> trivialCodeNoImm F32 (FADD F32) x y
1581 MO_Sub F32 -> trivialCodeNoImm F32 (FSUB F32) x y
1582 MO_Mul F32 -> trivialCodeNoImm F32 (FMUL F32) x y
1583 MO_S_Quot F32 -> trivialCodeNoImm F32 (FDIV F32) x y
1585 MO_Add F64 -> trivialCodeNoImm F64 (FADD F64) x y
1586 MO_Sub F64 -> trivialCodeNoImm F64 (FSUB F64) x y
1587 MO_Mul F64 -> trivialCodeNoImm F64 (FMUL F64) x y
1588 MO_S_Quot F64 -> trivialCodeNoImm F64 (FDIV F64) x y
1590 -- optimize addition with 32-bit immediate
1594 CmmLit (CmmInt imm immrep) | Just _ <- makeImmediate I32 True (-imm)
1595 -> trivialCode I32 True ADD x (CmmLit $ CmmInt imm immrep)
1598 (src, srcCode) <- getSomeReg x
1599 let imm = litToImm lit
1600 code dst = srcCode `appOL` toOL [
1601 ADDIS dst src (HA imm),
1602 ADD dst dst (RIImm (LO imm))
1604 return (Any I32 code)
1605 _ -> trivialCode I32 True ADD x y
1607 MO_Add rep -> trivialCode rep True ADD x y
1609 case y of -- subfi ('substract from' with immediate) doesn't exist
1610 CmmLit (CmmInt imm immrep) | Just _ <- makeImmediate rep True (-imm)
1611 -> trivialCode rep True ADD x (CmmLit $ CmmInt (-imm) immrep)
1612 _ -> trivialCodeNoImm rep SUBF y x
1614 MO_Mul rep -> trivialCode rep True MULLW x y
1616 MO_S_MulMayOflo I32 -> trivialCodeNoImm I32 MULLW_MayOflo x y
1618 MO_S_MulMayOflo rep -> panic "S_MulMayOflo (rep /= I32): not implemented"
1619 MO_U_MulMayOflo rep -> panic "U_MulMayOflo: not implemented"
1621 MO_S_Quot rep -> trivialCodeNoImm rep DIVW (extendSExpr rep x) (extendSExpr rep y)
1622 MO_U_Quot rep -> trivialCodeNoImm rep DIVWU (extendUExpr rep x) (extendUExpr rep y)
1624 MO_S_Rem rep -> remainderCode rep DIVW (extendSExpr rep x) (extendSExpr rep y)
1625 MO_U_Rem rep -> remainderCode rep DIVWU (extendUExpr rep x) (extendUExpr rep y)
1627 MO_And rep -> trivialCode rep False AND x y
1628 MO_Or rep -> trivialCode rep False OR x y
1629 MO_Xor rep -> trivialCode rep False XOR x y
1631 MO_Shl rep -> trivialCode rep False SLW x y
1632 MO_S_Shr rep -> trivialCode rep False SRAW (extendSExpr rep x) y
1633 MO_U_Shr rep -> trivialCode rep False SRW (extendUExpr rep x) y
1635 getRegister (CmmLit (CmmInt i rep))
1636 | Just imm <- makeImmediate rep True i
1638 code dst = unitOL (LI dst imm)
1640 return (Any rep code)
1642 getRegister (CmmLit (CmmFloat f frep)) = do
1643 lbl <- getNewLabelNat
1644 dynRef <- cmmMakeDynamicReference addImportNat False lbl
1645 Amode addr addr_code <- getAmode dynRef
1647 LDATA ReadOnlyData [CmmDataLabel lbl,
1648 CmmStaticLit (CmmFloat f frep)]
1649 `consOL` (addr_code `snocOL` LD frep dst addr)
1650 return (Any frep code)
1652 getRegister (CmmLit lit)
1653 = let rep = cmmLitRep lit
1657 OR dst dst (RIImm (LO imm))
1659 in return (Any rep code)
1661 getRegister other = pprPanic "getRegister(ppc)" (pprExpr other)
1663 -- extend?Rep: wrap integer expression of type rep
1664 -- in a conversion to I32
1665 extendSExpr I32 x = x
1666 extendSExpr rep x = CmmMachOp (MO_S_Conv rep I32) [x]
1667 extendUExpr I32 x = x
1668 extendUExpr rep x = CmmMachOp (MO_U_Conv rep I32) [x]
1670 #endif /* powerpc_TARGET_ARCH */
1673 -- -----------------------------------------------------------------------------
1674 -- The 'Amode' type: Memory addressing modes passed up the tree.
1676 data Amode = Amode AddrMode InstrBlock
1679 Now, given a tree (the argument to an CmmLoad) that references memory,
1680 produce a suitable addressing mode.
1682 A Rule of the Game (tm) for Amodes: use of the addr bit must
1683 immediately follow use of the code part, since the code part puts
1684 values in registers which the addr then refers to. So you can't put
1685 anything in between, lest it overwrite some of those registers. If
1686 you need to do some other computation between the code part and use of
1687 the addr bit, first store the effective address from the amode in a
1688 temporary, then do the other computation, and then use the temporary:
1692 ... other computation ...
1696 getAmode :: CmmExpr -> NatM Amode
1697 getAmode tree@(CmmRegOff _ _) = getAmode (mangleIndexTree tree)
1699 -- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
1701 #if alpha_TARGET_ARCH
1703 getAmode (StPrim IntSubOp [x, StInt i])
1704 = getNewRegNat PtrRep `thenNat` \ tmp ->
1705 getRegister x `thenNat` \ register ->
1707 code = registerCode register tmp
1708 reg = registerName register tmp
1709 off = ImmInt (-(fromInteger i))
1711 return (Amode (AddrRegImm reg off) code)
1713 getAmode (StPrim IntAddOp [x, StInt i])
1714 = getNewRegNat PtrRep `thenNat` \ tmp ->
1715 getRegister x `thenNat` \ register ->
1717 code = registerCode register tmp
1718 reg = registerName register tmp
1719 off = ImmInt (fromInteger i)
1721 return (Amode (AddrRegImm reg off) code)
1725 = return (Amode (AddrImm imm__2) id)
1728 imm__2 = case imm of Just x -> x
1731 = getNewRegNat PtrRep `thenNat` \ tmp ->
1732 getRegister other `thenNat` \ register ->
1734 code = registerCode register tmp
1735 reg = registerName register tmp
1737 return (Amode (AddrReg reg) code)
1739 #endif /* alpha_TARGET_ARCH */
1741 -- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
1743 #if i386_TARGET_ARCH || x86_64_TARGET_ARCH
1745 -- This is all just ridiculous, since it carefully undoes
1746 -- what mangleIndexTree has just done.
1747 getAmode (CmmMachOp (MO_Sub rep) [x, CmmLit lit@(CmmInt i _)])
1748 | not (is64BitLit lit)
1749 -- ASSERT(rep == I32)???
1750 = do (x_reg, x_code) <- getSomeReg x
1751 let off = ImmInt (-(fromInteger i))
1752 return (Amode (AddrBaseIndex (EABaseReg x_reg) EAIndexNone off) x_code)
1754 getAmode (CmmMachOp (MO_Add rep) [x, CmmLit lit@(CmmInt i _)])
1755 | not (is64BitLit lit)
1756 -- ASSERT(rep == I32)???
1757 = do (x_reg, x_code) <- getSomeReg x
1758 let off = ImmInt (fromInteger i)
1759 return (Amode (AddrBaseIndex (EABaseReg x_reg) EAIndexNone off) x_code)
1761 -- Turn (lit1 << n + lit2) into (lit2 + lit1 << n) so it will be
1762 -- recognised by the next rule.
1763 getAmode (CmmMachOp (MO_Add rep) [a@(CmmMachOp (MO_Shl _) _),
1765 = getAmode (CmmMachOp (MO_Add rep) [b,a])
1767 getAmode (CmmMachOp (MO_Add rep) [x, CmmMachOp (MO_Shl _)
1768 [y, CmmLit (CmmInt shift _)]])
1769 | shift == 0 || shift == 1 || shift == 2 || shift == 3
1770 = do (x_reg, x_code) <- getNonClobberedReg x
1771 -- x must be in a temp, because it has to stay live over y_code
1772 -- we could compre x_reg and y_reg and do something better here...
1773 (y_reg, y_code) <- getSomeReg y
1775 code = x_code `appOL` y_code
1776 base = case shift of 0 -> 1; 1 -> 2; 2 -> 4; 3 -> 8
1777 return (Amode (AddrBaseIndex (EABaseReg x_reg) (EAIndex y_reg base) (ImmInt 0))
1780 getAmode (CmmLit lit) | not (is64BitLit lit)
1781 = return (Amode (ImmAddr (litToImm lit) 0) nilOL)
1784 (reg,code) <- getSomeReg expr
1785 return (Amode (AddrBaseIndex (EABaseReg reg) EAIndexNone (ImmInt 0)) code)
1787 #endif /* i386_TARGET_ARCH || x86_64_TARGET_ARCH */
1789 -- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
1791 #if sparc_TARGET_ARCH
1793 getAmode (CmmMachOp (MO_Sub rep) [x, CmmLit (CmmInt i _)])
1796 (reg, code) <- getSomeReg x
1798 off = ImmInt (-(fromInteger i))
1799 return (Amode (AddrRegImm reg off) code)
1802 getAmode (CmmMachOp (MO_Add rep) [x, CmmLit (CmmInt i _)])
1805 (reg, code) <- getSomeReg x
1807 off = ImmInt (fromInteger i)
1808 return (Amode (AddrRegImm reg off) code)
1810 getAmode (CmmMachOp (MO_Add rep) [x, y])
1812 (regX, codeX) <- getSomeReg x
1813 (regY, codeY) <- getSomeReg y
1815 code = codeX `appOL` codeY
1816 return (Amode (AddrRegReg regX regY) code)
1818 -- XXX Is this same as "leaf" in Stix?
1819 getAmode (CmmLit lit)
1821 tmp <- getNewRegNat I32
1823 code = unitOL (SETHI (HI imm__2) tmp)
1824 return (Amode (AddrRegImm tmp (LO imm__2)) code)
1826 imm__2 = litToImm lit
1830 (reg, code) <- getSomeReg other
1833 return (Amode (AddrRegImm reg off) code)
1835 #endif /* sparc_TARGET_ARCH */
1837 #ifdef powerpc_TARGET_ARCH
1838 getAmode (CmmMachOp (MO_Sub I32) [x, CmmLit (CmmInt i _)])
1839 | Just off <- makeImmediate I32 True (-i)
1841 (reg, code) <- getSomeReg x
1842 return (Amode (AddrRegImm reg off) code)
1845 getAmode (CmmMachOp (MO_Add I32) [x, CmmLit (CmmInt i _)])
1846 | Just off <- makeImmediate I32 True i
1848 (reg, code) <- getSomeReg x
1849 return (Amode (AddrRegImm reg off) code)
1851 -- optimize addition with 32-bit immediate
1853 getAmode (CmmMachOp (MO_Add I32) [x, CmmLit lit])
1855 tmp <- getNewRegNat I32
1856 (src, srcCode) <- getSomeReg x
1857 let imm = litToImm lit
1858 code = srcCode `snocOL` ADDIS tmp src (HA imm)
1859 return (Amode (AddrRegImm tmp (LO imm)) code)
1861 getAmode (CmmLit lit)
1863 tmp <- getNewRegNat I32
1864 let imm = litToImm lit
1865 code = unitOL (LIS tmp (HA imm))
1866 return (Amode (AddrRegImm tmp (LO imm)) code)
1868 getAmode (CmmMachOp (MO_Add I32) [x, y])
1870 (regX, codeX) <- getSomeReg x
1871 (regY, codeY) <- getSomeReg y
1872 return (Amode (AddrRegReg regX regY) (codeX `appOL` codeY))
1876 (reg, code) <- getSomeReg other
1879 return (Amode (AddrRegImm reg off) code)
1880 #endif /* powerpc_TARGET_ARCH */
1882 -- -----------------------------------------------------------------------------
1883 -- getOperand: sometimes any operand will do.
1885 -- getNonClobberedOperand: the value of the operand will remain valid across
1886 -- the computation of an arbitrary expression, unless the expression
1887 -- is computed directly into a register which the operand refers to
1888 -- (see trivialCode where this function is used for an example).
1890 #if i386_TARGET_ARCH || x86_64_TARGET_ARCH
1892 getNonClobberedOperand :: CmmExpr -> NatM (Operand, InstrBlock)
1893 #if x86_64_TARGET_ARCH
1894 getNonClobberedOperand (CmmLit lit)
1895 | isSuitableFloatingPointLit lit = do
1896 lbl <- getNewLabelNat
1897 let code = unitOL (LDATA ReadOnlyData [CmmDataLabel lbl,
1899 return (OpAddr (ripRel (ImmCLbl lbl)), code)
1901 getNonClobberedOperand (CmmLit lit)
1902 | not (is64BitLit lit) && not (isFloatingRep (cmmLitRep lit)) =
1903 return (OpImm (litToImm lit), nilOL)
1904 getNonClobberedOperand (CmmLoad mem pk)
1905 | IF_ARCH_i386(not (isFloatingRep pk) && pk /= I64, True) = do
1906 Amode src mem_code <- getAmode mem
1908 if (amodeCouldBeClobbered src)
1910 tmp <- getNewRegNat wordRep
1911 return (AddrBaseIndex (EABaseReg tmp) EAIndexNone (ImmInt 0),
1912 unitOL (LEA I32 (OpAddr src) (OpReg tmp)))
1915 return (OpAddr src', save_code `appOL` mem_code)
1916 getNonClobberedOperand e = do
1917 (reg, code) <- getNonClobberedReg e
1918 return (OpReg reg, code)
1920 amodeCouldBeClobbered :: AddrMode -> Bool
1921 amodeCouldBeClobbered amode = any regClobbered (addrModeRegs amode)
1923 regClobbered (RealReg rr) = isFastTrue (freeReg rr)
1924 regClobbered _ = False
1926 -- getOperand: the operand is not required to remain valid across the
1927 -- computation of an arbitrary expression.
1928 getOperand :: CmmExpr -> NatM (Operand, InstrBlock)
1929 #if x86_64_TARGET_ARCH
1930 getOperand (CmmLit lit)
1931 | isSuitableFloatingPointLit lit = do
1932 lbl <- getNewLabelNat
1933 let code = unitOL (LDATA ReadOnlyData [CmmDataLabel lbl,
1935 return (OpAddr (ripRel (ImmCLbl lbl)), code)
1937 getOperand (CmmLit lit)
1938 | not (is64BitLit lit) && not (isFloatingRep (cmmLitRep lit)) = do
1939 return (OpImm (litToImm lit), nilOL)
1940 getOperand (CmmLoad mem pk)
1941 | IF_ARCH_i386(not (isFloatingRep pk) && pk /= I64, True) = do
1942 Amode src mem_code <- getAmode mem
1943 return (OpAddr src, mem_code)
1945 (reg, code) <- getSomeReg e
1946 return (OpReg reg, code)
1948 isOperand :: CmmExpr -> Bool
1949 isOperand (CmmLoad _ _) = True
1950 isOperand (CmmLit lit) = not (is64BitLit lit)
1951 || isSuitableFloatingPointLit lit
1954 -- if we want a floating-point literal as an operand, we can
1955 -- use it directly from memory. However, if the literal is
1956 -- zero, we're better off generating it into a register using
1958 isSuitableFloatingPointLit (CmmFloat f _) = f /= 0.0
1959 isSuitableFloatingPointLit _ = False
1961 getRegOrMem :: CmmExpr -> NatM (Operand, InstrBlock)
1962 getRegOrMem (CmmLoad mem pk)
1963 | IF_ARCH_i386(not (isFloatingRep pk) && pk /= I64, True) = do
1964 Amode src mem_code <- getAmode mem
1965 return (OpAddr src, mem_code)
1967 (reg, code) <- getNonClobberedReg e
1968 return (OpReg reg, code)
1970 #if x86_64_TARGET_ARCH
1971 is64BitLit (CmmInt i I64) = i > 0x7fffffff || i < -0x80000000
1972 -- assume that labels are in the range 0-2^31-1: this assumes the
1973 -- small memory model (see gcc docs, -mcmodel=small).
1975 is64BitLit x = False
1978 -- -----------------------------------------------------------------------------
1979 -- The 'CondCode' type: Condition codes passed up the tree.
1981 data CondCode = CondCode Bool Cond InstrBlock
1983 -- Set up a condition code for a conditional branch.
1985 getCondCode :: CmmExpr -> NatM CondCode
1987 -- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
1989 #if alpha_TARGET_ARCH
1990 getCondCode = panic "MachCode.getCondCode: not on Alphas"
1991 #endif /* alpha_TARGET_ARCH */
1993 -- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
1995 #if i386_TARGET_ARCH || x86_64_TARGET_ARCH || sparc_TARGET_ARCH
1996 -- yes, they really do seem to want exactly the same!
1998 getCondCode (CmmMachOp mop [x, y])
1999 = ASSERT (cmmExprRep x /= I8) -- tmp, not set up to handle 8-bit comparisons
2001 MO_Eq F32 -> condFltCode EQQ x y
2002 MO_Ne F32 -> condFltCode NE x y
2004 MO_S_Gt F32 -> condFltCode GTT x y
2005 MO_S_Ge F32 -> condFltCode GE x y
2006 MO_S_Lt F32 -> condFltCode LTT x y
2007 MO_S_Le F32 -> condFltCode LE x y
2009 MO_Eq F64 -> condFltCode EQQ x y
2010 MO_Ne F64 -> condFltCode NE x y
2012 MO_S_Gt F64 -> condFltCode GTT x y
2013 MO_S_Ge F64 -> condFltCode GE x y
2014 MO_S_Lt F64 -> condFltCode LTT x y
2015 MO_S_Le F64 -> condFltCode LE x y
2017 MO_Eq rep -> condIntCode EQQ x y
2018 MO_Ne rep -> condIntCode NE x y
2020 MO_S_Gt rep -> condIntCode GTT x y
2021 MO_S_Ge rep -> condIntCode GE x y
2022 MO_S_Lt rep -> condIntCode LTT x y
2023 MO_S_Le rep -> condIntCode LE x y
2025 MO_U_Gt rep -> condIntCode GU x y
2026 MO_U_Ge rep -> condIntCode GEU x y
2027 MO_U_Lt rep -> condIntCode LU x y
2028 MO_U_Le rep -> condIntCode LEU x y
2030 other -> pprPanic "getCondCode(x86,sparc)" (pprMachOp mop)
2032 getCondCode other = pprPanic "getCondCode(2)(x86,sparc)" (ppr other)
2034 #elif powerpc_TARGET_ARCH
2036 -- almost the same as everywhere else - but we need to
2037 -- extend small integers to 32 bit first
2039 getCondCode (CmmMachOp mop [x, y])
2041 MO_Eq F32 -> condFltCode EQQ x y
2042 MO_Ne F32 -> condFltCode NE x y
2044 MO_S_Gt F32 -> condFltCode GTT x y
2045 MO_S_Ge F32 -> condFltCode GE x y
2046 MO_S_Lt F32 -> condFltCode LTT x y
2047 MO_S_Le F32 -> condFltCode LE x y
2049 MO_Eq F64 -> condFltCode EQQ x y
2050 MO_Ne F64 -> condFltCode NE x y
2052 MO_S_Gt F64 -> condFltCode GTT x y
2053 MO_S_Ge F64 -> condFltCode GE x y
2054 MO_S_Lt F64 -> condFltCode LTT x y
2055 MO_S_Le F64 -> condFltCode LE x y
2057 MO_Eq rep -> condIntCode EQQ (extendUExpr rep x) (extendUExpr rep y)
2058 MO_Ne rep -> condIntCode NE (extendUExpr rep x) (extendUExpr rep y)
2060 MO_S_Gt rep -> condIntCode GTT (extendSExpr rep x) (extendSExpr rep y)
2061 MO_S_Ge rep -> condIntCode GE (extendSExpr rep x) (extendSExpr rep y)
2062 MO_S_Lt rep -> condIntCode LTT (extendSExpr rep x) (extendSExpr rep y)
2063 MO_S_Le rep -> condIntCode LE (extendSExpr rep x) (extendSExpr rep y)
2065 MO_U_Gt rep -> condIntCode GU (extendUExpr rep x) (extendUExpr rep y)
2066 MO_U_Ge rep -> condIntCode GEU (extendUExpr rep x) (extendUExpr rep y)
2067 MO_U_Lt rep -> condIntCode LU (extendUExpr rep x) (extendUExpr rep y)
2068 MO_U_Le rep -> condIntCode LEU (extendUExpr rep x) (extendUExpr rep y)
2070 other -> pprPanic "getCondCode(powerpc)" (pprMachOp mop)
2072 getCondCode other = panic "getCondCode(2)(powerpc)"
2078 -- @cond(Int|Flt)Code@: Turn a boolean expression into a condition, to be
2079 -- passed back up the tree.
2081 condIntCode, condFltCode :: Cond -> CmmExpr -> CmmExpr -> NatM CondCode
2083 #if alpha_TARGET_ARCH
2084 condIntCode = panic "MachCode.condIntCode: not on Alphas"
2085 condFltCode = panic "MachCode.condFltCode: not on Alphas"
2086 #endif /* alpha_TARGET_ARCH */
2088 -- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
2089 #if i386_TARGET_ARCH || x86_64_TARGET_ARCH
2091 -- memory vs immediate
2092 condIntCode cond (CmmLoad x pk) (CmmLit lit) | not (is64BitLit lit) = do
2093 Amode x_addr x_code <- getAmode x
2096 code = x_code `snocOL`
2097 CMP pk (OpImm imm) (OpAddr x_addr)
2099 return (CondCode False cond code)
2102 condIntCode cond x (CmmLit (CmmInt 0 pk)) = do
2103 (x_reg, x_code) <- getSomeReg x
2105 code = x_code `snocOL`
2106 TEST pk (OpReg x_reg) (OpReg x_reg)
2108 return (CondCode False cond code)
2110 -- anything vs operand
2111 condIntCode cond x y | isOperand y = do
2112 (x_reg, x_code) <- getNonClobberedReg x
2113 (y_op, y_code) <- getOperand y
2115 code = x_code `appOL` y_code `snocOL`
2116 CMP (cmmExprRep x) y_op (OpReg x_reg)
2118 return (CondCode False cond code)
2120 -- anything vs anything
2121 condIntCode cond x y = do
2122 (y_reg, y_code) <- getNonClobberedReg y
2123 (x_op, x_code) <- getRegOrMem x
2125 code = y_code `appOL`
2127 CMP (cmmExprRep x) (OpReg y_reg) x_op
2129 return (CondCode False cond code)
2132 #if i386_TARGET_ARCH
2133 condFltCode cond x y
2134 = ASSERT(cond `elem` ([EQQ, NE, LE, LTT, GE, GTT])) do
2135 (x_reg, x_code) <- getNonClobberedReg x
2136 (y_reg, y_code) <- getSomeReg y
2138 code = x_code `appOL` y_code `snocOL`
2139 GCMP cond x_reg y_reg
2140 -- The GCMP insn does the test and sets the zero flag if comparable
2141 -- and true. Hence we always supply EQQ as the condition to test.
2142 return (CondCode True EQQ code)
2143 #endif /* i386_TARGET_ARCH */
2145 #if x86_64_TARGET_ARCH
2146 -- in the SSE2 comparison ops (ucomiss, ucomisd) the left arg may be
2147 -- an operand, but the right must be a reg. We can probably do better
2148 -- than this general case...
2149 condFltCode cond x y = do
2150 (x_reg, x_code) <- getNonClobberedReg x
2151 (y_op, y_code) <- getOperand y
2153 code = x_code `appOL`
2155 CMP (cmmExprRep x) y_op (OpReg x_reg)
2156 -- NB(1): we need to use the unsigned comparison operators on the
2157 -- result of this comparison.
2159 return (CondCode True (condToUnsigned cond) code)
2162 -- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
2164 #if sparc_TARGET_ARCH
2166 condIntCode cond x (CmmLit (CmmInt y rep))
2169 (src1, code) <- getSomeReg x
2171 src2 = ImmInt (fromInteger y)
2172 code' = code `snocOL` SUB False True src1 (RIImm src2) g0
2173 return (CondCode False cond code')
2175 condIntCode cond x y = do
2176 (src1, code1) <- getSomeReg x
2177 (src2, code2) <- getSomeReg y
2179 code__2 = code1 `appOL` code2 `snocOL`
2180 SUB False True src1 (RIReg src2) g0
2181 return (CondCode False cond code__2)
2184 condFltCode cond x y = do
2185 (src1, code1) <- getSomeReg x
2186 (src2, code2) <- getSomeReg y
2187 tmp <- getNewRegNat F64
2189 promote x = FxTOy F32 F64 x tmp
2196 code1 `appOL` code2 `snocOL`
2197 FCMP True pk1 src1 src2
2198 else if pk1 == F32 then
2199 code1 `snocOL` promote src1 `appOL` code2 `snocOL`
2200 FCMP True F64 tmp src2
2202 code1 `appOL` code2 `snocOL` promote src2 `snocOL`
2203 FCMP True F64 src1 tmp
2204 return (CondCode True cond code__2)
2206 #endif /* sparc_TARGET_ARCH */
2208 #if powerpc_TARGET_ARCH
2209 -- ###FIXME: I16 and I8!
2210 condIntCode cond x (CmmLit (CmmInt y rep))
2211 | Just src2 <- makeImmediate rep (not $ condUnsigned cond) y
2213 (src1, code) <- getSomeReg x
2215 code' = code `snocOL`
2216 (if condUnsigned cond then CMPL else CMP) I32 src1 (RIImm src2)
2217 return (CondCode False cond code')
2219 condIntCode cond x y = do
2220 (src1, code1) <- getSomeReg x
2221 (src2, code2) <- getSomeReg y
2223 code' = code1 `appOL` code2 `snocOL`
2224 (if condUnsigned cond then CMPL else CMP) I32 src1 (RIReg src2)
2225 return (CondCode False cond code')
2227 condFltCode cond x y = do
2228 (src1, code1) <- getSomeReg x
2229 (src2, code2) <- getSomeReg y
2231 code' = code1 `appOL` code2 `snocOL` FCMP src1 src2
2232 code'' = case cond of -- twiddle CR to handle unordered case
2233 GE -> code' `snocOL` CRNOR ltbit eqbit gtbit
2234 LE -> code' `snocOL` CRNOR gtbit eqbit ltbit
2237 ltbit = 0 ; eqbit = 2 ; gtbit = 1
2238 return (CondCode True cond code'')
2240 #endif /* powerpc_TARGET_ARCH */
2242 -- -----------------------------------------------------------------------------
2243 -- Generating assignments
2245 -- Assignments are really at the heart of the whole code generation
2246 -- business. Almost all top-level nodes of any real importance are
2247 -- assignments, which correspond to loads, stores, or register
2248 -- transfers. If we're really lucky, some of the register transfers
2249 -- will go away, because we can use the destination register to
2250 -- complete the code generation for the right hand side. This only
2251 -- fails when the right hand side is forced into a fixed register
2252 -- (e.g. the result of a call).
2254 assignMem_IntCode :: MachRep -> CmmExpr -> CmmExpr -> NatM InstrBlock
2255 assignReg_IntCode :: MachRep -> CmmReg -> CmmExpr -> NatM InstrBlock
2257 assignMem_FltCode :: MachRep -> CmmExpr -> CmmExpr -> NatM InstrBlock
2258 assignReg_FltCode :: MachRep -> CmmReg -> CmmExpr -> NatM InstrBlock
2260 -- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
2262 #if alpha_TARGET_ARCH
2264 assignIntCode pk (CmmLoad dst _) src
2265 = getNewRegNat IntRep `thenNat` \ tmp ->
2266 getAmode dst `thenNat` \ amode ->
2267 getRegister src `thenNat` \ register ->
2269 code1 = amodeCode amode []
2270 dst__2 = amodeAddr amode
2271 code2 = registerCode register tmp []
2272 src__2 = registerName register tmp
2273 sz = primRepToSize pk
2274 code__2 = asmSeqThen [code1, code2] . mkSeqInstr (ST sz src__2 dst__2)
2278 assignIntCode pk dst src
2279 = getRegister dst `thenNat` \ register1 ->
2280 getRegister src `thenNat` \ register2 ->
2282 dst__2 = registerName register1 zeroh
2283 code = registerCode register2 dst__2
2284 src__2 = registerName register2 dst__2
2285 code__2 = if isFixed register2
2286 then code . mkSeqInstr (OR src__2 (RIReg src__2) dst__2)
2291 #endif /* alpha_TARGET_ARCH */
2293 -- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
2295 #if i386_TARGET_ARCH || x86_64_TARGET_ARCH
2297 -- integer assignment to memory
2298 assignMem_IntCode pk addr src = do
2299 Amode addr code_addr <- getAmode addr
2300 (code_src, op_src) <- get_op_RI src
2302 code = code_src `appOL`
2304 MOV pk op_src (OpAddr addr)
2305 -- NOTE: op_src is stable, so it will still be valid
2306 -- after code_addr. This may involve the introduction
2307 -- of an extra MOV to a temporary register, but we hope
2308 -- the register allocator will get rid of it.
2312 get_op_RI :: CmmExpr -> NatM (InstrBlock,Operand) -- code, operator
2313 get_op_RI (CmmLit lit) | not (is64BitLit lit)
2314 = return (nilOL, OpImm (litToImm lit))
2316 = do (reg,code) <- getNonClobberedReg op
2317 return (code, OpReg reg)
2320 -- Assign; dst is a reg, rhs is mem
2321 assignReg_IntCode pk reg (CmmLoad src _) = do
2322 load_code <- intLoadCode (MOV pk) src
2323 return (load_code (getRegisterReg reg))
2325 -- dst is a reg, but src could be anything
2326 assignReg_IntCode pk reg src = do
2327 code <- getAnyReg src
2328 return (code (getRegisterReg reg))
2330 #endif /* i386_TARGET_ARCH */
2332 -- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
2334 #if sparc_TARGET_ARCH
2336 assignMem_IntCode pk addr src = do
2337 (srcReg, code) <- getSomeReg src
2338 Amode dstAddr addr_code <- getAmode addr
2339 return $ code `appOL` addr_code `snocOL` ST pk srcReg dstAddr
2341 assignReg_IntCode pk reg src = do
2342 r <- getRegister src
2344 Any _ code -> code dst
2345 Fixed _ freg fcode -> fcode `snocOL` OR False g0 (RIReg dst) freg
2347 dst = getRegisterReg reg
2350 #endif /* sparc_TARGET_ARCH */
2352 #if powerpc_TARGET_ARCH
2354 assignMem_IntCode pk addr src = do
2355 (srcReg, code) <- getSomeReg src
2356 Amode dstAddr addr_code <- getAmode addr
2357 return $ code `appOL` addr_code `snocOL` ST pk srcReg dstAddr
2359 -- dst is a reg, but src could be anything
2360 assignReg_IntCode pk reg src
2362 r <- getRegister src
2364 Any _ code -> code dst
2365 Fixed _ freg fcode -> fcode `snocOL` MR dst freg
2367 dst = getRegisterReg reg
2369 #endif /* powerpc_TARGET_ARCH */
2372 -- -----------------------------------------------------------------------------
2373 -- Floating-point assignments
2375 #if alpha_TARGET_ARCH
2377 assignFltCode pk (CmmLoad dst _) src
2378 = getNewRegNat pk `thenNat` \ tmp ->
2379 getAmode dst `thenNat` \ amode ->
2380 getRegister src `thenNat` \ register ->
2382 code1 = amodeCode amode []
2383 dst__2 = amodeAddr amode
2384 code2 = registerCode register tmp []
2385 src__2 = registerName register tmp
2386 sz = primRepToSize pk
2387 code__2 = asmSeqThen [code1, code2] . mkSeqInstr (ST sz src__2 dst__2)
2391 assignFltCode pk dst src
2392 = getRegister dst `thenNat` \ register1 ->
2393 getRegister src `thenNat` \ register2 ->
2395 dst__2 = registerName register1 zeroh
2396 code = registerCode register2 dst__2
2397 src__2 = registerName register2 dst__2
2398 code__2 = if isFixed register2
2399 then code . mkSeqInstr (FMOV src__2 dst__2)
2404 #endif /* alpha_TARGET_ARCH */
2406 -- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
2408 #if i386_TARGET_ARCH || x86_64_TARGET_ARCH
2410 -- Floating point assignment to memory
2411 assignMem_FltCode pk addr src = do
2412 (src_reg, src_code) <- getNonClobberedReg src
2413 Amode addr addr_code <- getAmode addr
2415 code = src_code `appOL`
2417 IF_ARCH_i386(GST pk src_reg addr,
2418 MOV pk (OpReg src_reg) (OpAddr addr))
2421 -- Floating point assignment to a register/temporary
2422 assignReg_FltCode pk reg src = do
2423 src_code <- getAnyReg src
2424 return (src_code (getRegisterReg reg))
2426 #endif /* i386_TARGET_ARCH */
2428 -- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
2430 #if sparc_TARGET_ARCH
2432 -- Floating point assignment to memory
2433 assignMem_FltCode pk addr src = do
2434 Amode dst__2 code1 <- getAmode addr
2435 (src__2, code2) <- getSomeReg src
2436 tmp1 <- getNewRegNat pk
2438 pk__2 = cmmExprRep src
2439 code__2 = code1 `appOL` code2 `appOL`
2441 then unitOL (ST pk src__2 dst__2)
2442 else toOL [FxTOy pk__2 pk src__2 tmp1, ST pk tmp1 dst__2]
2445 -- Floating point assignment to a register/temporary
2446 -- ToDo: Verify correctness
2447 assignReg_FltCode pk reg src = do
2448 r <- getRegister src
2449 v1 <- getNewRegNat pk
2451 Any _ code -> code dst
2452 Fixed _ freg fcode -> fcode `snocOL` FMOV pk freg v1
2454 dst = getRegisterReg reg
2456 #endif /* sparc_TARGET_ARCH */
2458 #if powerpc_TARGET_ARCH
2461 assignMem_FltCode = assignMem_IntCode
2462 assignReg_FltCode = assignReg_IntCode
2464 #endif /* powerpc_TARGET_ARCH */
2467 -- -----------------------------------------------------------------------------
2468 -- Generating an non-local jump
2470 -- (If applicable) Do not fill the delay slots here; you will confuse the
2471 -- register allocator.
2473 genJump :: CmmExpr{-the branch target-} -> NatM InstrBlock
2475 -- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
2477 #if alpha_TARGET_ARCH
2479 genJump (CmmLabel lbl)
2480 | isAsmTemp lbl = returnInstr (BR target)
2481 | otherwise = returnInstrs [LDA pv (AddrImm target), JMP zeroh (AddrReg pv) 0]
2483 target = ImmCLbl lbl
2486 = getRegister tree `thenNat` \ register ->
2487 getNewRegNat PtrRep `thenNat` \ tmp ->
2489 dst = registerName register pv
2490 code = registerCode register pv
2491 target = registerName register pv
2493 if isFixed register then
2494 returnSeq code [OR dst (RIReg dst) pv, JMP zeroh (AddrReg pv) 0]
2496 return (code . mkSeqInstr (JMP zeroh (AddrReg pv) 0))
2498 #endif /* alpha_TARGET_ARCH */
2500 -- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
2502 #if i386_TARGET_ARCH || x86_64_TARGET_ARCH
2504 genJump (CmmLoad mem pk) = do
2505 Amode target code <- getAmode mem
2506 return (code `snocOL` JMP (OpAddr target))
2508 genJump (CmmLit lit) = do
2509 return (unitOL (JMP (OpImm (litToImm lit))))
2512 (reg,code) <- getSomeReg expr
2513 return (code `snocOL` JMP (OpReg reg))
2515 #endif /* i386_TARGET_ARCH */
2517 -- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
2519 #if sparc_TARGET_ARCH
2521 genJump (CmmLit (CmmLabel lbl))
2522 = return (toOL [CALL (Left target) 0 True, NOP])
2524 target = ImmCLbl lbl
2528 (target, code) <- getSomeReg tree
2529 return (code `snocOL` JMP (AddrRegReg target g0) `snocOL` NOP)
2531 #endif /* sparc_TARGET_ARCH */
2533 #if powerpc_TARGET_ARCH
2534 genJump (CmmLit (CmmLabel lbl))
2535 = return (unitOL $ JMP lbl)
2539 (target,code) <- getSomeReg tree
2540 return (code `snocOL` MTCTR target `snocOL` BCTR [])
2541 #endif /* powerpc_TARGET_ARCH */
2544 -- -----------------------------------------------------------------------------
2545 -- Unconditional branches
2547 genBranch :: BlockId -> NatM InstrBlock
2549 #if alpha_TARGET_ARCH
2550 genBranch id = return (unitOL (BR id))
2553 #if i386_TARGET_ARCH || x86_64_TARGET_ARCH
2554 genBranch id = return (unitOL (JXX ALWAYS id))
2557 #if sparc_TARGET_ARCH
2558 genBranch (BlockId id) = return (toOL [BI ALWAYS False (ImmCLbl (mkAsmTempLabel id)), NOP])
2561 #if powerpc_TARGET_ARCH
2562 genBranch id = return (unitOL (BCC ALWAYS id))
2566 -- -----------------------------------------------------------------------------
2567 -- Conditional jumps
2570 Conditional jumps are always to local labels, so we can use branch
2571 instructions. We peek at the arguments to decide what kind of
2574 ALPHA: For comparisons with 0, we're laughing, because we can just do
2575 the desired conditional branch.
2577 I386: First, we have to ensure that the condition
2578 codes are set according to the supplied comparison operation.
2580 SPARC: First, we have to ensure that the condition codes are set
2581 according to the supplied comparison operation. We generate slightly
2582 different code for floating point comparisons, because a floating
2583 point operation cannot directly precede a @BF@. We assume the worst
2584 and fill that slot with a @NOP@.
2586 SPARC: Do not fill the delay slots here; you will confuse the register
2592 :: BlockId -- the branch target
2593 -> CmmExpr -- the condition on which to branch
2596 -- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
2598 #if alpha_TARGET_ARCH
2600 genCondJump id (StPrim op [x, StInt 0])
2601 = getRegister x `thenNat` \ register ->
2602 getNewRegNat (registerRep register)
2605 code = registerCode register tmp
2606 value = registerName register tmp
2607 pk = registerRep register
2608 target = ImmCLbl lbl
2610 returnSeq code [BI (cmpOp op) value target]
2612 cmpOp CharGtOp = GTT
2614 cmpOp CharEqOp = EQQ
2616 cmpOp CharLtOp = LTT
2625 cmpOp WordGeOp = ALWAYS
2626 cmpOp WordEqOp = EQQ
2628 cmpOp WordLtOp = NEVER
2629 cmpOp WordLeOp = EQQ
2631 cmpOp AddrGeOp = ALWAYS
2632 cmpOp AddrEqOp = EQQ
2634 cmpOp AddrLtOp = NEVER
2635 cmpOp AddrLeOp = EQQ
2637 genCondJump lbl (StPrim op [x, StDouble 0.0])
2638 = getRegister x `thenNat` \ register ->
2639 getNewRegNat (registerRep register)
2642 code = registerCode register tmp
2643 value = registerName register tmp
2644 pk = registerRep register
2645 target = ImmCLbl lbl
2647 return (code . mkSeqInstr (BF (cmpOp op) value target))
2649 cmpOp FloatGtOp = GTT
2650 cmpOp FloatGeOp = GE
2651 cmpOp FloatEqOp = EQQ
2652 cmpOp FloatNeOp = NE
2653 cmpOp FloatLtOp = LTT
2654 cmpOp FloatLeOp = LE
2655 cmpOp DoubleGtOp = GTT
2656 cmpOp DoubleGeOp = GE
2657 cmpOp DoubleEqOp = EQQ
2658 cmpOp DoubleNeOp = NE
2659 cmpOp DoubleLtOp = LTT
2660 cmpOp DoubleLeOp = LE
2662 genCondJump lbl (StPrim op [x, y])
2664 = trivialFCode pr instr x y `thenNat` \ register ->
2665 getNewRegNat F64 `thenNat` \ tmp ->
2667 code = registerCode register tmp
2668 result = registerName register tmp
2669 target = ImmCLbl lbl
2671 return (code . mkSeqInstr (BF cond result target))
2673 pr = panic "trivialU?FCode: does not use PrimRep on Alpha"
2675 fltCmpOp op = case op of
2689 (instr, cond) = case op of
2690 FloatGtOp -> (FCMP TF LE, EQQ)
2691 FloatGeOp -> (FCMP TF LTT, EQQ)
2692 FloatEqOp -> (FCMP TF EQQ, NE)
2693 FloatNeOp -> (FCMP TF EQQ, EQQ)
2694 FloatLtOp -> (FCMP TF LTT, NE)
2695 FloatLeOp -> (FCMP TF LE, NE)
2696 DoubleGtOp -> (FCMP TF LE, EQQ)
2697 DoubleGeOp -> (FCMP TF LTT, EQQ)
2698 DoubleEqOp -> (FCMP TF EQQ, NE)
2699 DoubleNeOp -> (FCMP TF EQQ, EQQ)
2700 DoubleLtOp -> (FCMP TF LTT, NE)
2701 DoubleLeOp -> (FCMP TF LE, NE)
2703 genCondJump lbl (StPrim op [x, y])
2704 = trivialCode instr x y `thenNat` \ register ->
2705 getNewRegNat IntRep `thenNat` \ tmp ->
2707 code = registerCode register tmp
2708 result = registerName register tmp
2709 target = ImmCLbl lbl
2711 return (code . mkSeqInstr (BI cond result target))
2713 (instr, cond) = case op of
2714 CharGtOp -> (CMP LE, EQQ)
2715 CharGeOp -> (CMP LTT, EQQ)
2716 CharEqOp -> (CMP EQQ, NE)
2717 CharNeOp -> (CMP EQQ, EQQ)
2718 CharLtOp -> (CMP LTT, NE)
2719 CharLeOp -> (CMP LE, NE)
2720 IntGtOp -> (CMP LE, EQQ)
2721 IntGeOp -> (CMP LTT, EQQ)
2722 IntEqOp -> (CMP EQQ, NE)
2723 IntNeOp -> (CMP EQQ, EQQ)
2724 IntLtOp -> (CMP LTT, NE)
2725 IntLeOp -> (CMP LE, NE)
2726 WordGtOp -> (CMP ULE, EQQ)
2727 WordGeOp -> (CMP ULT, EQQ)
2728 WordEqOp -> (CMP EQQ, NE)
2729 WordNeOp -> (CMP EQQ, EQQ)
2730 WordLtOp -> (CMP ULT, NE)
2731 WordLeOp -> (CMP ULE, NE)
2732 AddrGtOp -> (CMP ULE, EQQ)
2733 AddrGeOp -> (CMP ULT, EQQ)
2734 AddrEqOp -> (CMP EQQ, NE)
2735 AddrNeOp -> (CMP EQQ, EQQ)
2736 AddrLtOp -> (CMP ULT, NE)
2737 AddrLeOp -> (CMP ULE, NE)
2739 #endif /* alpha_TARGET_ARCH */
2741 -- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
2743 #if i386_TARGET_ARCH
2745 genCondJump id bool = do
2746 CondCode _ cond code <- getCondCode bool
2747 return (code `snocOL` JXX cond id)
2751 -- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
2753 #if x86_64_TARGET_ARCH
2755 genCondJump id bool = do
2756 CondCode is_float cond cond_code <- getCondCode bool
2759 return (cond_code `snocOL` JXX cond id)
2761 lbl <- getBlockIdNat
2763 -- see comment with condFltReg
2764 let code = case cond of
2770 plain_test = unitOL (
2773 or_unordered = toOL [
2777 and_ordered = toOL [
2783 return (cond_code `appOL` code)
2787 -- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
2789 #if sparc_TARGET_ARCH
2791 genCondJump (BlockId id) bool = do
2792 CondCode is_float cond code <- getCondCode bool
2797 then [NOP, BF cond False (ImmCLbl (mkAsmTempLabel id)), NOP]
2798 else [BI cond False (ImmCLbl (mkAsmTempLabel id)), NOP]
2802 #endif /* sparc_TARGET_ARCH */
2805 #if powerpc_TARGET_ARCH
2807 genCondJump id bool = do
2808 CondCode is_float cond code <- getCondCode bool
2809 return (code `snocOL` BCC cond id)
2811 #endif /* powerpc_TARGET_ARCH */
2814 -- -----------------------------------------------------------------------------
2815 -- Generating C calls
2817 -- Now the biggest nightmare---calls. Most of the nastiness is buried in
2818 -- @get_arg@, which moves the arguments to the correct registers/stack
2819 -- locations. Apart from that, the code is easy.
2821 -- (If applicable) Do not fill the delay slots here; you will confuse the
2822 -- register allocator.
2825 :: CmmCallTarget -- function to call
2826 -> [(CmmReg,MachHint)] -- where to put the result
2827 -> [(CmmExpr,MachHint)] -- arguments (of mixed type)
2828 -> Maybe [GlobalReg] -- volatile regs to save
2831 -- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
2833 #if alpha_TARGET_ARCH
2837 genCCall fn cconv result_regs args
2838 = mapAccumLNat get_arg (allArgRegs, eXTRA_STK_ARGS_HERE) args
2839 `thenNat` \ ((unused,_), argCode) ->
2841 nRegs = length allArgRegs - length unused
2842 code = asmSeqThen (map ($ []) argCode)
2845 LDA pv (AddrImm (ImmLab (ptext fn))),
2846 JSR ra (AddrReg pv) nRegs,
2847 LDGP gp (AddrReg ra)]
2849 ------------------------
2850 {- Try to get a value into a specific register (or registers) for
2851 a call. The first 6 arguments go into the appropriate
2852 argument register (separate registers for integer and floating
2853 point arguments, but used in lock-step), and the remaining
2854 arguments are dumped to the stack, beginning at 0(sp). Our
2855 first argument is a pair of the list of remaining argument
2856 registers to be assigned for this call and the next stack
2857 offset to use for overflowing arguments. This way,
2858 @get_Arg@ can be applied to all of a call's arguments using
2862 :: ([(Reg,Reg)], Int) -- Argument registers and stack offset (accumulator)
2863 -> StixTree -- Current argument
2864 -> NatM (([(Reg,Reg)],Int), InstrBlock) -- Updated accumulator and code
2866 -- We have to use up all of our argument registers first...
2868 get_arg ((iDst,fDst):dsts, offset) arg
2869 = getRegister arg `thenNat` \ register ->
2871 reg = if isFloatingRep pk then fDst else iDst
2872 code = registerCode register reg
2873 src = registerName register reg
2874 pk = registerRep register
2877 if isFloatingRep pk then
2878 ((dsts, offset), if isFixed register then
2879 code . mkSeqInstr (FMOV src fDst)
2882 ((dsts, offset), if isFixed register then
2883 code . mkSeqInstr (OR src (RIReg src) iDst)
2886 -- Once we have run out of argument registers, we move to the
2889 get_arg ([], offset) arg
2890 = getRegister arg `thenNat` \ register ->
2891 getNewRegNat (registerRep register)
2894 code = registerCode register tmp
2895 src = registerName register tmp
2896 pk = registerRep register
2897 sz = primRepToSize pk
2899 return (([], offset + 1), code . mkSeqInstr (ST sz src (spRel offset)))
2901 #endif /* alpha_TARGET_ARCH */
2903 -- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
2905 #if i386_TARGET_ARCH
2907 -- we only cope with a single result for foreign calls
2908 genCCall (CmmPrim op) [(r,_)] args vols = do
2910 MO_F32_Sqrt -> actuallyInlineFloatOp F32 (GSQRT F32) args
2911 MO_F64_Sqrt -> actuallyInlineFloatOp F64 (GSQRT F64) args
2913 MO_F32_Sin -> actuallyInlineFloatOp F32 (GSIN F32) args
2914 MO_F64_Sin -> actuallyInlineFloatOp F64 (GSIN F64) args
2916 MO_F32_Cos -> actuallyInlineFloatOp F32 (GCOS F32) args
2917 MO_F64_Cos -> actuallyInlineFloatOp F64 (GCOS F64) args
2919 MO_F32_Tan -> actuallyInlineFloatOp F32 (GTAN F32) args
2920 MO_F64_Tan -> actuallyInlineFloatOp F64 (GTAN F64) args
2922 other_op -> outOfLineFloatOp op r args vols
2924 actuallyInlineFloatOp rep instr [(x,_)]
2925 = do res <- trivialUFCode rep instr x
2927 return (any (getRegisterReg r))
2929 genCCall target dest_regs args vols = do
2931 sizes = map (arg_size . cmmExprRep . fst) (reverse args)
2932 #if !darwin_TARGET_OS
2933 tot_arg_size = sum sizes
2935 raw_arg_size = sum sizes
2936 tot_arg_size = roundTo 16 raw_arg_size
2937 arg_pad_size = tot_arg_size - raw_arg_size
2938 delta0 <- getDeltaNat
2939 setDeltaNat (delta0 - arg_pad_size)
2942 push_codes <- mapM push_arg (reverse args)
2943 delta <- getDeltaNat
2946 -- deal with static vs dynamic call targets
2947 (callinsns,cconv) <-
2950 CmmForeignCall (CmmLit (CmmLabel lbl)) conv
2951 -> -- ToDo: stdcall arg sizes
2952 return (unitOL (CALL (Left fn_imm) []), conv)
2953 where fn_imm = ImmCLbl lbl
2954 CmmForeignCall expr conv
2955 -> do (dyn_c, dyn_r, dyn_rep) <- get_op expr
2956 ASSERT(dyn_rep == I32)
2957 return (dyn_c `snocOL` CALL (Right dyn_r) [], conv)
2960 #if darwin_TARGET_OS
2962 = toOL [SUB I32 (OpImm (ImmInt arg_pad_size)) (OpReg esp),
2963 DELTA (delta0 - arg_pad_size)]
2964 `appOL` concatOL push_codes
2967 = concatOL push_codes
2968 call = callinsns `appOL`
2970 -- Deallocate parameters after call for ccall;
2971 -- but not for stdcall (callee does it)
2972 (if cconv == StdCallConv || tot_arg_size==0 then [] else
2973 [ADD I32 (OpImm (ImmInt tot_arg_size)) (OpReg esp)])
2975 [DELTA (delta + tot_arg_size)]
2978 setDeltaNat (delta + tot_arg_size)
2981 -- assign the results, if necessary
2982 assign_code [] = nilOL
2983 assign_code [(dest,_hint)] =
2985 I64 -> toOL [MOV I32 (OpReg eax) (OpReg r_dest),
2986 MOV I32 (OpReg edx) (OpReg r_dest_hi)]
2987 F32 -> unitOL (GMOV fake0 r_dest)
2988 F64 -> unitOL (GMOV fake0 r_dest)
2989 rep -> unitOL (MOV rep (OpReg eax) (OpReg r_dest))
2991 r_dest_hi = getHiVRegFromLo r_dest
2992 rep = cmmRegRep dest
2993 r_dest = getRegisterReg dest
2994 assign_code many = panic "genCCall.assign_code many"
2996 return (push_code `appOL`
2998 assign_code dest_regs)
3006 roundTo a x | x `mod` a == 0 = x
3007 | otherwise = x + a - (x `mod` a)
3010 push_arg :: (CmmExpr,MachHint){-current argument-}
3011 -> NatM InstrBlock -- code
3013 push_arg (arg,_hint) -- we don't need the hints on x86
3014 | arg_rep == I64 = do
3015 ChildCode64 code r_lo <- iselExpr64 arg
3016 delta <- getDeltaNat
3017 setDeltaNat (delta - 8)
3019 r_hi = getHiVRegFromLo r_lo
3021 return ( code `appOL`
3022 toOL [PUSH I32 (OpReg r_hi), DELTA (delta - 4),
3023 PUSH I32 (OpReg r_lo), DELTA (delta - 8),
3028 (code, reg, sz) <- get_op arg
3029 delta <- getDeltaNat
3030 let size = arg_size sz
3031 setDeltaNat (delta-size)
3032 if (case sz of F64 -> True; F32 -> True; _ -> False)
3033 then return (code `appOL`
3034 toOL [SUB I32 (OpImm (ImmInt size)) (OpReg esp),
3036 GST sz reg (AddrBaseIndex (EABaseReg esp)
3040 else return (code `snocOL`
3041 PUSH I32 (OpReg reg) `snocOL`
3045 arg_rep = cmmExprRep arg
3048 get_op :: CmmExpr -> NatM (InstrBlock, Reg, MachRep) -- code, reg, size
3050 (reg,code) <- getSomeReg op
3051 return (code, reg, cmmExprRep op)
3053 #endif /* i386_TARGET_ARCH */
3055 #if i386_TARGET_ARCH || x86_64_TARGET_ARCH
3057 outOfLineFloatOp :: CallishMachOp -> CmmReg -> [(CmmExpr,MachHint)]
3058 -> Maybe [GlobalReg] -> NatM InstrBlock
3059 outOfLineFloatOp mop res args vols
3061 targetExpr <- cmmMakeDynamicReference addImportNat True lbl
3062 let target = CmmForeignCall targetExpr CCallConv
3064 if cmmRegRep res == F64
3066 stmtToInstrs (CmmCall target [(res,FloatHint)] args vols)
3070 tmp = CmmLocal (LocalReg uq F64)
3072 code1 <- stmtToInstrs (CmmCall target [(tmp,FloatHint)]
3073 (map promote args) vols)
3074 code2 <- stmtToInstrs (CmmAssign res (demote (CmmReg tmp)))
3075 return (code1 `appOL` code2)
3077 promote (x,hint) = (CmmMachOp (MO_S_Conv F32 F64) [x], hint)
3078 demote x = CmmMachOp (MO_S_Conv F64 F32) [x]
3080 lbl = mkForeignLabel fn Nothing True
3083 MO_F32_Sqrt -> FSLIT("sqrt")
3084 MO_F32_Sin -> FSLIT("sin")
3085 MO_F32_Cos -> FSLIT("cos")
3086 MO_F32_Tan -> FSLIT("tan")
3087 MO_F32_Exp -> FSLIT("exp")
3088 MO_F32_Log -> FSLIT("log")
3090 MO_F32_Asin -> FSLIT("asin")
3091 MO_F32_Acos -> FSLIT("acos")
3092 MO_F32_Atan -> FSLIT("atan")
3094 MO_F32_Sinh -> FSLIT("sinh")
3095 MO_F32_Cosh -> FSLIT("cosh")
3096 MO_F32_Tanh -> FSLIT("tanh")
3097 MO_F32_Pwr -> FSLIT("pow")
3099 MO_F64_Sqrt -> FSLIT("sqrt")
3100 MO_F64_Sin -> FSLIT("sin")
3101 MO_F64_Cos -> FSLIT("cos")
3102 MO_F64_Tan -> FSLIT("tan")
3103 MO_F64_Exp -> FSLIT("exp")
3104 MO_F64_Log -> FSLIT("log")
3106 MO_F64_Asin -> FSLIT("asin")
3107 MO_F64_Acos -> FSLIT("acos")
3108 MO_F64_Atan -> FSLIT("atan")
3110 MO_F64_Sinh -> FSLIT("sinh")
3111 MO_F64_Cosh -> FSLIT("cosh")
3112 MO_F64_Tanh -> FSLIT("tanh")
3113 MO_F64_Pwr -> FSLIT("pow")
3115 #endif /* i386_TARGET_ARCH || x86_64_TARGET_ARCH */
3117 -- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
3119 #if x86_64_TARGET_ARCH
3121 genCCall (CmmPrim op) [(r,_)] args vols =
3122 outOfLineFloatOp op r args vols
3124 genCCall target dest_regs args vols = do
3126 -- load up the register arguments
3127 (stack_args, aregs, fregs, load_args_code)
3128 <- load_args args allArgRegs allFPArgRegs nilOL
3131 fp_regs_used = reverse (drop (length fregs) (reverse allFPArgRegs))
3132 int_regs_used = reverse (drop (length aregs) (reverse allArgRegs))
3133 arg_regs = int_regs_used ++ fp_regs_used
3134 -- for annotating the call instruction with
3136 sse_regs = length fp_regs_used
3138 tot_arg_size = arg_size * length stack_args
3140 -- On entry to the called function, %rsp should be aligned
3141 -- on a 16-byte boundary +8 (i.e. the first stack arg after
3142 -- the return address is 16-byte aligned). In STG land
3143 -- %rsp is kept 16-byte aligned (see StgCRun.c), so we just
3144 -- need to make sure we push a multiple of 16-bytes of args,
3145 -- plus the return address, to get the correct alignment.
3146 -- Urg, this is hard. We need to feed the delta back into
3147 -- the arg pushing code.
3148 (real_size, adjust_rsp) <-
3149 if tot_arg_size `rem` 16 == 0
3150 then return (tot_arg_size, nilOL)
3151 else do -- we need to adjust...
3152 delta <- getDeltaNat
3153 setDeltaNat (delta-8)
3154 return (tot_arg_size+8, toOL [
3155 SUB I64 (OpImm (ImmInt 8)) (OpReg rsp),
3159 -- push the stack args, right to left
3160 push_code <- push_args (reverse stack_args) nilOL
3161 delta <- getDeltaNat
3163 -- deal with static vs dynamic call targets
3164 (callinsns,cconv) <-
3167 CmmForeignCall (CmmLit (CmmLabel lbl)) conv
3168 -> -- ToDo: stdcall arg sizes
3169 return (unitOL (CALL (Left fn_imm) arg_regs), conv)
3170 where fn_imm = ImmCLbl lbl
3171 CmmForeignCall expr conv
3172 -> do (dyn_r, dyn_c) <- getSomeReg expr
3173 return (dyn_c `snocOL` CALL (Right dyn_r) arg_regs, conv)
3176 -- The x86_64 ABI requires us to set %al to the number of SSE
3177 -- registers that contain arguments, if the called routine
3178 -- is a varargs function. We don't know whether it's a
3179 -- varargs function or not, so we have to assume it is.
3181 -- It's not safe to omit this assignment, even if the number
3182 -- of SSE regs in use is zero. If %al is larger than 8
3183 -- on entry to a varargs function, seg faults ensue.
3184 assign_eax n = unitOL (MOV I32 (OpImm (ImmInt n)) (OpReg eax))
3186 let call = callinsns `appOL`
3188 -- Deallocate parameters after call for ccall;
3189 -- but not for stdcall (callee does it)
3190 (if cconv == StdCallConv || real_size==0 then [] else
3191 [ADD wordRep (OpImm (ImmInt real_size)) (OpReg esp)])
3193 [DELTA (delta + real_size)]
3196 setDeltaNat (delta + real_size)
3199 -- assign the results, if necessary
3200 assign_code [] = nilOL
3201 assign_code [(dest,_hint)] =
3203 F32 -> unitOL (MOV rep (OpReg xmm0) (OpReg r_dest))
3204 F64 -> unitOL (MOV rep (OpReg xmm0) (OpReg r_dest))
3205 rep -> unitOL (MOV rep (OpReg rax) (OpReg r_dest))
3207 rep = cmmRegRep dest
3208 r_dest = getRegisterReg dest
3209 assign_code many = panic "genCCall.assign_code many"
3211 return (load_args_code `appOL`
3214 assign_eax sse_regs `appOL`
3216 assign_code dest_regs)
3219 arg_size = 8 -- always, at the mo
3221 load_args :: [(CmmExpr,MachHint)]
3222 -> [Reg] -- int regs avail for args
3223 -> [Reg] -- FP regs avail for args
3225 -> NatM ([(CmmExpr,MachHint)],[Reg],[Reg],InstrBlock)
3226 load_args args [] [] code = return (args, [], [], code)
3227 -- no more regs to use
3228 load_args [] aregs fregs code = return ([], aregs, fregs, code)
3229 -- no more args to push
3230 load_args ((arg,hint) : rest) aregs fregs code
3231 | isFloatingRep arg_rep =
3235 arg_code <- getAnyReg arg
3236 load_args rest aregs rs (code `appOL` arg_code r)
3241 arg_code <- getAnyReg arg
3242 load_args rest rs fregs (code `appOL` arg_code r)
3244 arg_rep = cmmExprRep arg
3247 (args',ars,frs,code') <- load_args rest aregs fregs code
3248 return ((arg,hint):args', ars, frs, code')
3250 push_args [] code = return code
3251 push_args ((arg,hint):rest) code
3252 | isFloatingRep arg_rep = do
3253 (arg_reg, arg_code) <- getSomeReg arg
3254 delta <- getDeltaNat
3255 setDeltaNat (delta-arg_size)
3256 let code' = code `appOL` toOL [
3257 MOV arg_rep (OpReg arg_reg) (OpAddr (spRel 0)),
3258 SUB wordRep (OpImm (ImmInt arg_size)) (OpReg rsp) ,
3259 DELTA (delta-arg_size)]
3260 push_args rest code'
3263 -- we only ever generate word-sized function arguments. Promotion
3264 -- has already happened: our Int8# type is kept sign-extended
3265 -- in an Int#, for example.
3266 ASSERT(arg_rep == I64) return ()
3267 (arg_op, arg_code) <- getOperand arg
3268 delta <- getDeltaNat
3269 setDeltaNat (delta-arg_size)
3270 let code' = code `appOL` toOL [PUSH I64 arg_op,
3271 DELTA (delta-arg_size)]
3272 push_args rest code'
3274 arg_rep = cmmExprRep arg
3277 -- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
3279 #if sparc_TARGET_ARCH
3281 The SPARC calling convention is an absolute
3282 nightmare. The first 6x32 bits of arguments are mapped into
3283 %o0 through %o5, and the remaining arguments are dumped to the
3284 stack, beginning at [%sp+92]. (Note that %o6 == %sp.)
3286 If we have to put args on the stack, move %o6==%sp down by
3287 the number of words to go on the stack, to ensure there's enough space.
3289 According to Fraser and Hanson's lcc book, page 478, fig 17.2,
3290 16 words above the stack pointer is a word for the address of
3291 a structure return value. I use this as a temporary location
3292 for moving values from float to int regs. Certainly it isn't
3293 safe to put anything in the 16 words starting at %sp, since
3294 this area can get trashed at any time due to window overflows
3295 caused by signal handlers.
3297 A final complication (if the above isn't enough) is that
3298 we can't blithely calculate the arguments one by one into
3299 %o0 .. %o5. Consider the following nested calls:
3303 Naive code moves a into %o0, and (fff b c) into %o1. Unfortunately
3304 the inner call will itself use %o0, which trashes the value put there
3305 in preparation for the outer call. Upshot: we need to calculate the
3306 args into temporary regs, and move those to arg regs or onto the
3307 stack only immediately prior to the call proper. Sigh.
3310 genCCall target dest_regs argsAndHints vols = do
3312 args = map fst argsAndHints
3313 argcode_and_vregs <- mapM arg_to_int_vregs args
3315 (argcodes, vregss) = unzip argcode_and_vregs
3316 n_argRegs = length allArgRegs
3317 n_argRegs_used = min (length vregs) n_argRegs
3318 vregs = concat vregss
3319 -- deal with static vs dynamic call targets
3320 callinsns <- (case target of
3321 CmmForeignCall (CmmLit (CmmLabel lbl)) conv -> do
3322 return (unitOL (CALL (Left (litToImm (CmmLabel lbl))) n_argRegs_used False))
3323 CmmForeignCall expr conv -> do
3324 (dyn_c, [dyn_r]) <- arg_to_int_vregs expr
3325 return (dyn_c `snocOL` CALL (Right dyn_r) n_argRegs_used False)
3327 (res, reduce) <- outOfLineFloatOp mop
3328 lblOrMopExpr <- case res of
3330 return (unitOL (CALL (Left (litToImm (CmmLabel lbl))) n_argRegs_used False))
3332 (dyn_c, [dyn_r]) <- arg_to_int_vregs mopExpr
3333 return (dyn_c `snocOL` CALL (Right dyn_r) n_argRegs_used False)
3334 if reduce then panic "genCCall(sparc): can not reduce" else return lblOrMopExpr
3338 argcode = concatOL argcodes
3339 (move_sp_down, move_sp_up)
3340 = let diff = length vregs - n_argRegs
3341 nn = if odd diff then diff + 1 else diff -- keep 8-byte alignment
3344 else (unitOL (moveSp (-1*nn)), unitOL (moveSp (1*nn)))
3346 = toOL (move_final vregs allArgRegs eXTRA_STK_ARGS_HERE)
3347 return (argcode `appOL`
3348 move_sp_down `appOL`
3349 transfer_code `appOL`
3354 -- move args from the integer vregs into which they have been
3355 -- marshalled, into %o0 .. %o5, and the rest onto the stack.
3356 move_final :: [Reg] -> [Reg] -> Int -> [Instr]
3358 move_final [] _ offset -- all args done
3361 move_final (v:vs) [] offset -- out of aregs; move to stack
3362 = ST I32 v (spRel offset)
3363 : move_final vs [] (offset+1)
3365 move_final (v:vs) (a:az) offset -- move into an arg (%o[0..5]) reg
3366 = OR False g0 (RIReg v) a
3367 : move_final vs az offset
3369 -- generate code to calculate an argument, and move it into one
3370 -- or two integer vregs.
3371 arg_to_int_vregs :: CmmExpr -> NatM (OrdList Instr, [Reg])
3372 arg_to_int_vregs arg
3373 | (cmmExprRep arg) == I64
3375 (ChildCode64 code r_lo) <- iselExpr64 arg
3377 r_hi = getHiVRegFromLo r_lo
3378 return (code, [r_hi, r_lo])
3381 (src, code) <- getSomeReg arg
3382 tmp <- getNewRegNat (cmmExprRep arg)
3387 v1 <- getNewRegNat I32
3388 v2 <- getNewRegNat I32
3391 FMOV F64 src f0 `snocOL`
3392 ST F32 f0 (spRel 16) `snocOL`
3393 LD I32 (spRel 16) v1 `snocOL`
3394 ST F32 (fPair f0) (spRel 16) `snocOL`
3395 LD I32 (spRel 16) v2
3400 v1 <- getNewRegNat I32
3403 ST F32 src (spRel 16) `snocOL`
3404 LD I32 (spRel 16) v1
3409 v1 <- getNewRegNat I32
3411 code `snocOL` OR False g0 (RIReg src) v1
3415 outOfLineFloatOp mop =
3417 mopExpr <- cmmMakeDynamicReference addImportNat True $
3418 mkForeignLabel functionName Nothing True
3419 let mopLabelOrExpr = case mopExpr of
3420 CmmLit (CmmLabel lbl) -> Left lbl
3422 return (mopLabelOrExpr, reduce)
3424 (reduce, functionName) = case mop of
3425 MO_F32_Exp -> (True, FSLIT("exp"))
3426 MO_F32_Log -> (True, FSLIT("log"))
3427 MO_F32_Sqrt -> (True, FSLIT("sqrt"))
3429 MO_F32_Sin -> (True, FSLIT("sin"))
3430 MO_F32_Cos -> (True, FSLIT("cos"))
3431 MO_F32_Tan -> (True, FSLIT("tan"))
3433 MO_F32_Asin -> (True, FSLIT("asin"))
3434 MO_F32_Acos -> (True, FSLIT("acos"))
3435 MO_F32_Atan -> (True, FSLIT("atan"))
3437 MO_F32_Sinh -> (True, FSLIT("sinh"))
3438 MO_F32_Cosh -> (True, FSLIT("cosh"))
3439 MO_F32_Tanh -> (True, FSLIT("tanh"))
3441 MO_F64_Exp -> (False, FSLIT("exp"))
3442 MO_F64_Log -> (False, FSLIT("log"))
3443 MO_F64_Sqrt -> (False, FSLIT("sqrt"))
3445 MO_F64_Sin -> (False, FSLIT("sin"))
3446 MO_F64_Cos -> (False, FSLIT("cos"))
3447 MO_F64_Tan -> (False, FSLIT("tan"))
3449 MO_F64_Asin -> (False, FSLIT("asin"))
3450 MO_F64_Acos -> (False, FSLIT("acos"))
3451 MO_F64_Atan -> (False, FSLIT("atan"))
3453 MO_F64_Sinh -> (False, FSLIT("sinh"))
3454 MO_F64_Cosh -> (False, FSLIT("cosh"))
3455 MO_F64_Tanh -> (False, FSLIT("tanh"))
3457 other -> pprPanic "outOfLineFloatOp(sparc) "
3458 (pprCallishMachOp mop)
3460 #endif /* sparc_TARGET_ARCH */
3462 #if powerpc_TARGET_ARCH
3464 #if darwin_TARGET_OS || linux_TARGET_OS
3466 The PowerPC calling convention for Darwin/Mac OS X
3467 is described in Apple's document
3468 "Inside Mac OS X - Mach-O Runtime Architecture".
3470 PowerPC Linux uses the System V Release 4 Calling Convention
3471 for PowerPC. It is described in the
3472 "System V Application Binary Interface PowerPC Processor Supplement".
3474 Both conventions are similar:
3475 Parameters may be passed in general-purpose registers starting at r3, in
3476 floating point registers starting at f1, or on the stack.
3478 But there are substantial differences:
3479 * The number of registers used for parameter passing and the exact set of
3480 nonvolatile registers differs (see MachRegs.lhs).
3481 * On Darwin, stack space is always reserved for parameters, even if they are
3482 passed in registers. The called routine may choose to save parameters from
3483 registers to the corresponding space on the stack.
3484 * On Darwin, a corresponding amount of GPRs is skipped when a floating point
3485 parameter is passed in an FPR.
3486 * SysV insists on either passing I64 arguments on the stack, or in two GPRs,
3487 starting with an odd-numbered GPR. It may skip a GPR to achieve this.
3488 Darwin just treats an I64 like two separate I32s (high word first).
3489 * I64 and F64 arguments are 8-byte aligned on the stack for SysV, but only
3490 4-byte aligned like everything else on Darwin.
3491 * The SysV spec claims that F32 is represented as F64 on the stack. GCC on
3492 PowerPC Linux does not agree, so neither do we.
3494 According to both conventions, The parameter area should be part of the
3495 caller's stack frame, allocated in the caller's prologue code (large enough
3496 to hold the parameter lists for all called routines). The NCG already
3497 uses the stack for register spilling, leaving 64 bytes free at the top.
3498 If we need a larger parameter area than that, we just allocate a new stack
3499 frame just before ccalling.
3502 genCCall target dest_regs argsAndHints vols
3503 = ASSERT (not $ any (`elem` [I8,I16]) argReps)
3504 -- we rely on argument promotion in the codeGen
3506 (finalStack,passArgumentsCode,usedRegs) <- passArguments
3508 allArgRegs allFPArgRegs
3512 (labelOrExpr, reduceToF32) <- case target of
3513 CmmForeignCall (CmmLit (CmmLabel lbl)) conv -> return (Left lbl, False)
3514 CmmForeignCall expr conv -> return (Right expr, False)
3515 CmmPrim mop -> outOfLineFloatOp mop
3517 let codeBefore = move_sp_down finalStack `appOL` passArgumentsCode
3518 codeAfter = move_sp_up finalStack `appOL` moveResult reduceToF32
3523 `snocOL` BL lbl usedRegs
3526 (dynReg, dynCode) <- getSomeReg dyn
3528 `snocOL` MTCTR dynReg
3530 `snocOL` BCTRL usedRegs
3533 #if darwin_TARGET_OS
3534 initialStackOffset = 24
3535 -- size of linkage area + size of arguments, in bytes
3536 stackDelta _finalStack = roundTo 16 $ (24 +) $ max 32 $ sum $
3537 map machRepByteWidth argReps
3538 #elif linux_TARGET_OS
3539 initialStackOffset = 8
3540 stackDelta finalStack = roundTo 16 finalStack
3542 args = map fst argsAndHints
3543 argReps = map cmmExprRep args
3545 roundTo a x | x `mod` a == 0 = x
3546 | otherwise = x + a - (x `mod` a)
3548 move_sp_down finalStack
3550 toOL [STU I32 sp (AddrRegImm sp (ImmInt (-delta))),
3553 where delta = stackDelta finalStack
3554 move_sp_up finalStack
3556 toOL [ADD sp sp (RIImm (ImmInt delta)),
3559 where delta = stackDelta finalStack
3562 passArguments [] _ _ stackOffset accumCode accumUsed = return (stackOffset, accumCode, accumUsed)
3563 passArguments ((arg,I64):args) gprs fprs stackOffset
3564 accumCode accumUsed =
3566 ChildCode64 code vr_lo <- iselExpr64 arg
3567 let vr_hi = getHiVRegFromLo vr_lo
3569 #if darwin_TARGET_OS
3574 (accumCode `appOL` code
3575 `snocOL` storeWord vr_hi gprs stackOffset
3576 `snocOL` storeWord vr_lo (drop 1 gprs) (stackOffset+4))
3577 ((take 2 gprs) ++ accumUsed)
3579 storeWord vr (gpr:_) offset = MR gpr vr
3580 storeWord vr [] offset = ST I32 vr (AddrRegImm sp (ImmInt offset))
3582 #elif linux_TARGET_OS
3583 let stackOffset' = roundTo 8 stackOffset
3584 stackCode = accumCode `appOL` code
3585 `snocOL` ST I32 vr_hi (AddrRegImm sp (ImmInt stackOffset'))
3586 `snocOL` ST I32 vr_lo (AddrRegImm sp (ImmInt (stackOffset'+4)))
3587 regCode hireg loreg =
3588 accumCode `appOL` code
3589 `snocOL` MR hireg vr_hi
3590 `snocOL` MR loreg vr_lo
3593 hireg : loreg : regs | even (length gprs) ->
3594 passArguments args regs fprs stackOffset
3595 (regCode hireg loreg) (hireg : loreg : accumUsed)
3596 _skipped : hireg : loreg : regs ->
3597 passArguments args regs fprs stackOffset
3598 (regCode hireg loreg) (hireg : loreg : accumUsed)
3599 _ -> -- only one or no regs left
3600 passArguments args [] fprs (stackOffset'+8)
3604 passArguments ((arg,rep):args) gprs fprs stackOffset accumCode accumUsed
3605 | reg : _ <- regs = do
3606 register <- getRegister arg
3607 let code = case register of
3608 Fixed _ freg fcode -> fcode `snocOL` MR reg freg
3609 Any _ acode -> acode reg
3613 #if darwin_TARGET_OS
3614 -- The Darwin ABI requires that we reserve stack slots for register parameters
3615 (stackOffset + stackBytes)
3616 #elif linux_TARGET_OS
3617 -- ... the SysV ABI doesn't.
3620 (accumCode `appOL` code)
3623 (vr, code) <- getSomeReg arg
3627 (stackOffset' + stackBytes)
3628 (accumCode `appOL` code `snocOL` ST rep vr stackSlot)
3631 #if darwin_TARGET_OS
3632 -- stackOffset is at least 4-byte aligned
3633 -- The Darwin ABI is happy with that.
3634 stackOffset' = stackOffset
3636 -- ... the SysV ABI requires 8-byte alignment for doubles.
3637 stackOffset' | rep == F64 = roundTo 8 stackOffset
3638 | otherwise = stackOffset
3640 stackSlot = AddrRegImm sp (ImmInt stackOffset')
3641 (nGprs, nFprs, stackBytes, regs) = case rep of
3642 I32 -> (1, 0, 4, gprs)
3643 #if darwin_TARGET_OS
3644 -- The Darwin ABI requires that we skip a corresponding number of GPRs when
3646 F32 -> (1, 1, 4, fprs)
3647 F64 -> (2, 1, 8, fprs)
3648 #elif linux_TARGET_OS
3649 -- ... the SysV ABI doesn't.
3650 F32 -> (0, 1, 4, fprs)
3651 F64 -> (0, 1, 8, fprs)
3654 moveResult reduceToF32 =
3658 | reduceToF32 && rep == F32 -> unitOL (FRSP r_dest f1)
3659 | rep == F32 || rep == F64 -> unitOL (MR r_dest f1)
3660 | rep == I64 -> toOL [MR (getHiVRegFromLo r_dest) r3,
3662 | otherwise -> unitOL (MR r_dest r3)
3663 where rep = cmmRegRep dest
3664 r_dest = getRegisterReg dest
3666 outOfLineFloatOp mop =
3668 mopExpr <- cmmMakeDynamicReference addImportNat True $
3669 mkForeignLabel functionName Nothing True
3670 let mopLabelOrExpr = case mopExpr of
3671 CmmLit (CmmLabel lbl) -> Left lbl
3673 return (mopLabelOrExpr, reduce)
3675 (functionName, reduce) = case mop of
3676 MO_F32_Exp -> (FSLIT("exp"), True)
3677 MO_F32_Log -> (FSLIT("log"), True)
3678 MO_F32_Sqrt -> (FSLIT("sqrt"), True)
3680 MO_F32_Sin -> (FSLIT("sin"), True)
3681 MO_F32_Cos -> (FSLIT("cos"), True)
3682 MO_F32_Tan -> (FSLIT("tan"), True)
3684 MO_F32_Asin -> (FSLIT("asin"), True)
3685 MO_F32_Acos -> (FSLIT("acos"), True)
3686 MO_F32_Atan -> (FSLIT("atan"), True)
3688 MO_F32_Sinh -> (FSLIT("sinh"), True)
3689 MO_F32_Cosh -> (FSLIT("cosh"), True)
3690 MO_F32_Tanh -> (FSLIT("tanh"), True)
3691 MO_F32_Pwr -> (FSLIT("pow"), True)
3693 MO_F64_Exp -> (FSLIT("exp"), False)
3694 MO_F64_Log -> (FSLIT("log"), False)
3695 MO_F64_Sqrt -> (FSLIT("sqrt"), False)
3697 MO_F64_Sin -> (FSLIT("sin"), False)
3698 MO_F64_Cos -> (FSLIT("cos"), False)
3699 MO_F64_Tan -> (FSLIT("tan"), False)
3701 MO_F64_Asin -> (FSLIT("asin"), False)
3702 MO_F64_Acos -> (FSLIT("acos"), False)
3703 MO_F64_Atan -> (FSLIT("atan"), False)
3705 MO_F64_Sinh -> (FSLIT("sinh"), False)
3706 MO_F64_Cosh -> (FSLIT("cosh"), False)
3707 MO_F64_Tanh -> (FSLIT("tanh"), False)
3708 MO_F64_Pwr -> (FSLIT("pow"), False)
3709 other -> pprPanic "genCCall(ppc): unknown callish op"
3710 (pprCallishMachOp other)
3712 #endif /* darwin_TARGET_OS || linux_TARGET_OS */
3714 #endif /* powerpc_TARGET_ARCH */
3717 -- -----------------------------------------------------------------------------
3718 -- Generating a table-branch
3720 genSwitch :: CmmExpr -> [Maybe BlockId] -> NatM InstrBlock
3722 #if i386_TARGET_ARCH || x86_64_TARGET_ARCH
3726 (reg,e_code) <- getSomeReg expr
3727 lbl <- getNewLabelNat
3728 dynRef <- cmmMakeDynamicReference addImportNat False lbl
3729 (tableReg,t_code) <- getSomeReg $ dynRef
3731 jumpTable = map jumpTableEntryRel ids
3733 jumpTableEntryRel Nothing
3734 = CmmStaticLit (CmmInt 0 wordRep)
3735 jumpTableEntryRel (Just (BlockId id))
3736 = CmmStaticLit (CmmLabelDiffOff blockLabel lbl 0)
3737 where blockLabel = mkAsmTempLabel id
3739 op = OpAddr (AddrBaseIndex (EABaseReg tableReg)
3740 (EAIndex reg wORD_SIZE) (ImmInt 0))
3742 code = e_code `appOL` t_code `appOL` toOL [
3743 LDATA ReadOnlyData (CmmDataLabel lbl : jumpTable),
3744 ADD wordRep op (OpReg tableReg),
3745 JMP_TBL (OpReg tableReg) [ id | Just id <- ids ]
3750 (reg,e_code) <- getSomeReg expr
3751 lbl <- getNewLabelNat
3753 jumpTable = map jumpTableEntry ids
3754 op = OpAddr (AddrBaseIndex EABaseNone (EAIndex reg wORD_SIZE) (ImmCLbl lbl))
3755 code = e_code `appOL` toOL [
3756 LDATA ReadOnlyData (CmmDataLabel lbl : jumpTable),
3757 JMP_TBL op [ id | Just id <- ids ]
3761 #elif powerpc_TARGET_ARCH
3765 (reg,e_code) <- getSomeReg expr
3766 tmp <- getNewRegNat I32
3767 lbl <- getNewLabelNat
3768 dynRef <- cmmMakeDynamicReference addImportNat False lbl
3769 (tableReg,t_code) <- getSomeReg $ dynRef
3771 jumpTable = map jumpTableEntryRel ids
3773 jumpTableEntryRel Nothing
3774 = CmmStaticLit (CmmInt 0 wordRep)
3775 jumpTableEntryRel (Just (BlockId id))
3776 = CmmStaticLit (CmmLabelDiffOff blockLabel lbl 0)
3777 where blockLabel = mkAsmTempLabel id
3779 code = e_code `appOL` t_code `appOL` toOL [
3780 LDATA ReadOnlyData (CmmDataLabel lbl : jumpTable),
3781 SLW tmp reg (RIImm (ImmInt 2)),
3782 LD I32 tmp (AddrRegReg tableReg tmp),
3783 ADD tmp tmp (RIReg tableReg),
3785 BCTR [ id | Just id <- ids ]
3790 (reg,e_code) <- getSomeReg expr
3791 tmp <- getNewRegNat I32
3792 lbl <- getNewLabelNat
3794 jumpTable = map jumpTableEntry ids
3796 code = e_code `appOL` toOL [
3797 LDATA ReadOnlyData (CmmDataLabel lbl : jumpTable),
3798 SLW tmp reg (RIImm (ImmInt 2)),
3799 ADDIS tmp tmp (HA (ImmCLbl lbl)),
3800 LD I32 tmp (AddrRegImm tmp (LO (ImmCLbl lbl))),
3802 BCTR [ id | Just id <- ids ]
3806 genSwitch expr ids = panic "ToDo: genSwitch"
3809 jumpTableEntry Nothing = CmmStaticLit (CmmInt 0 wordRep)
3810 jumpTableEntry (Just (BlockId id)) = CmmStaticLit (CmmLabel blockLabel)
3811 where blockLabel = mkAsmTempLabel id
3813 -- -----------------------------------------------------------------------------
3815 -- -----------------------------------------------------------------------------
3818 -- -----------------------------------------------------------------------------
3819 -- 'condIntReg' and 'condFltReg': condition codes into registers
3821 -- Turn those condition codes into integers now (when they appear on
3822 -- the right hand side of an assignment).
3824 -- (If applicable) Do not fill the delay slots here; you will confuse the
3825 -- register allocator.
3827 condIntReg, condFltReg :: Cond -> CmmExpr -> CmmExpr -> NatM Register
3829 -- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
3831 #if alpha_TARGET_ARCH
3832 condIntReg = panic "MachCode.condIntReg (not on Alpha)"
3833 condFltReg = panic "MachCode.condFltReg (not on Alpha)"
3834 #endif /* alpha_TARGET_ARCH */
3836 -- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
3838 #if i386_TARGET_ARCH || x86_64_TARGET_ARCH
3840 condIntReg cond x y = do
3841 CondCode _ cond cond_code <- condIntCode cond x y
3842 tmp <- getNewRegNat I8
3844 code dst = cond_code `appOL` toOL [
3845 SETCC cond (OpReg tmp),
3846 MOVZxL I8 (OpReg tmp) (OpReg dst)
3849 return (Any I32 code)
3853 #if i386_TARGET_ARCH
3855 condFltReg cond x y = do
3856 CondCode _ cond cond_code <- condFltCode cond x y
3857 tmp <- getNewRegNat I8
3859 code dst = cond_code `appOL` toOL [
3860 SETCC cond (OpReg tmp),
3861 MOVZxL I8 (OpReg tmp) (OpReg dst)
3864 return (Any I32 code)
3868 #if x86_64_TARGET_ARCH
3870 condFltReg cond x y = do
3871 CondCode _ cond cond_code <- condFltCode cond x y
3872 tmp1 <- getNewRegNat wordRep
3873 tmp2 <- getNewRegNat wordRep
3875 -- We have to worry about unordered operands (eg. comparisons
3876 -- against NaN). If the operands are unordered, the comparison
3877 -- sets the parity flag, carry flag and zero flag.
3878 -- All comparisons are supposed to return false for unordered
3879 -- operands except for !=, which returns true.
3881 -- Optimisation: we don't have to test the parity flag if we
3882 -- know the test has already excluded the unordered case: eg >
3883 -- and >= test for a zero carry flag, which can only occur for
3884 -- ordered operands.
3886 -- ToDo: by reversing comparisons we could avoid testing the
3887 -- parity flag in more cases.
3892 NE -> or_unordered dst
3893 GU -> plain_test dst
3894 GEU -> plain_test dst
3895 _ -> and_ordered dst)
3897 plain_test dst = toOL [
3898 SETCC cond (OpReg tmp1),
3899 MOVZxL I8 (OpReg tmp1) (OpReg dst)
3901 or_unordered dst = toOL [
3902 SETCC cond (OpReg tmp1),
3903 SETCC PARITY (OpReg tmp2),
3904 OR I8 (OpReg tmp1) (OpReg tmp2),
3905 MOVZxL I8 (OpReg tmp2) (OpReg dst)
3907 and_ordered dst = toOL [
3908 SETCC cond (OpReg tmp1),
3909 SETCC NOTPARITY (OpReg tmp2),
3910 AND I8 (OpReg tmp1) (OpReg tmp2),
3911 MOVZxL I8 (OpReg tmp2) (OpReg dst)
3914 return (Any I32 code)
3918 -- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
3920 #if sparc_TARGET_ARCH
3922 condIntReg EQQ x (CmmLit (CmmInt 0 d)) = do
3923 (src, code) <- getSomeReg x
3924 tmp <- getNewRegNat I32
3926 code__2 dst = code `appOL` toOL [
3927 SUB False True g0 (RIReg src) g0,
3928 SUB True False g0 (RIImm (ImmInt (-1))) dst]
3929 return (Any I32 code__2)
3931 condIntReg EQQ x y = do
3932 (src1, code1) <- getSomeReg x
3933 (src2, code2) <- getSomeReg y
3934 tmp1 <- getNewRegNat I32
3935 tmp2 <- getNewRegNat I32
3937 code__2 dst = code1 `appOL` code2 `appOL` toOL [
3938 XOR False src1 (RIReg src2) dst,
3939 SUB False True g0 (RIReg dst) g0,
3940 SUB True False g0 (RIImm (ImmInt (-1))) dst]
3941 return (Any I32 code__2)
3943 condIntReg NE x (CmmLit (CmmInt 0 d)) = do
3944 (src, code) <- getSomeReg x
3945 tmp <- getNewRegNat I32
3947 code__2 dst = code `appOL` toOL [
3948 SUB False True g0 (RIReg src) g0,
3949 ADD True False g0 (RIImm (ImmInt 0)) dst]
3950 return (Any I32 code__2)
3952 condIntReg NE x y = do
3953 (src1, code1) <- getSomeReg x
3954 (src2, code2) <- getSomeReg y
3955 tmp1 <- getNewRegNat I32
3956 tmp2 <- getNewRegNat I32
3958 code__2 dst = code1 `appOL` code2 `appOL` toOL [
3959 XOR False src1 (RIReg src2) dst,
3960 SUB False True g0 (RIReg dst) g0,
3961 ADD True False g0 (RIImm (ImmInt 0)) dst]
3962 return (Any I32 code__2)
3964 condIntReg cond x y = do
3965 BlockId lbl1 <- getBlockIdNat
3966 BlockId lbl2 <- getBlockIdNat
3967 CondCode _ cond cond_code <- condIntCode cond x y
3969 code__2 dst = cond_code `appOL` toOL [
3970 BI cond False (ImmCLbl (mkAsmTempLabel lbl1)), NOP,
3971 OR False g0 (RIImm (ImmInt 0)) dst,
3972 BI ALWAYS False (ImmCLbl (mkAsmTempLabel lbl2)), NOP,
3973 NEWBLOCK (BlockId lbl1),
3974 OR False g0 (RIImm (ImmInt 1)) dst,
3975 NEWBLOCK (BlockId lbl2)]
3976 return (Any I32 code__2)
3978 condFltReg cond x y = do
3979 BlockId lbl1 <- getBlockIdNat
3980 BlockId lbl2 <- getBlockIdNat
3981 CondCode _ cond cond_code <- condFltCode cond x y
3983 code__2 dst = cond_code `appOL` toOL [
3985 BF cond False (ImmCLbl (mkAsmTempLabel lbl1)), NOP,
3986 OR False g0 (RIImm (ImmInt 0)) dst,
3987 BI ALWAYS False (ImmCLbl (mkAsmTempLabel lbl2)), NOP,
3988 NEWBLOCK (BlockId lbl1),
3989 OR False g0 (RIImm (ImmInt 1)) dst,
3990 NEWBLOCK (BlockId lbl2)]
3991 return (Any I32 code__2)
3993 #endif /* sparc_TARGET_ARCH */
3995 #if powerpc_TARGET_ARCH
3996 condReg getCond = do
3997 lbl1 <- getBlockIdNat
3998 lbl2 <- getBlockIdNat
3999 CondCode _ cond cond_code <- getCond
4001 {- code dst = cond_code `appOL` toOL [
4010 code dst = cond_code
4014 RLWINM dst dst (bit + 1) 31 31
4017 negate_code | do_negate = unitOL (CRNOR bit bit bit)
4020 (bit, do_negate) = case cond of
4034 return (Any I32 code)
4036 condIntReg cond x y = condReg (condIntCode cond x y)
4037 condFltReg cond x y = condReg (condFltCode cond x y)
4038 #endif /* powerpc_TARGET_ARCH */
4041 -- -----------------------------------------------------------------------------
4042 -- 'trivial*Code': deal with trivial instructions
4044 -- Trivial (dyadic: 'trivialCode', floating-point: 'trivialFCode',
4045 -- unary: 'trivialUCode', unary fl-pt:'trivialUFCode') instructions.
4046 -- Only look for constants on the right hand side, because that's
4047 -- where the generic optimizer will have put them.
4049 -- Similarly, for unary instructions, we don't have to worry about
4050 -- matching an StInt as the argument, because genericOpt will already
4051 -- have handled the constant-folding.
4055 -> IF_ARCH_alpha((Reg -> RI -> Reg -> Instr)
4056 ,IF_ARCH_i386 ((Operand -> Operand -> Instr)
4057 -> Maybe (Operand -> Operand -> Instr)
4058 ,IF_ARCH_x86_64 ((Operand -> Operand -> Instr)
4059 -> Maybe (Operand -> Operand -> Instr)
4060 ,IF_ARCH_sparc((Reg -> RI -> Reg -> Instr)
4061 ,IF_ARCH_powerpc(Bool -> (Reg -> Reg -> RI -> Instr)
4063 -> CmmExpr -> CmmExpr -- the two arguments
4066 #ifndef powerpc_TARGET_ARCH
4069 -> IF_ARCH_alpha((Reg -> Reg -> Reg -> Instr)
4070 ,IF_ARCH_sparc((MachRep -> Reg -> Reg -> Reg -> Instr)
4071 ,IF_ARCH_i386 ((MachRep -> Reg -> Reg -> Reg -> Instr)
4072 ,IF_ARCH_x86_64 ((MachRep -> Operand -> Operand -> Instr)
4074 -> CmmExpr -> CmmExpr -- the two arguments
4080 -> IF_ARCH_alpha((RI -> Reg -> Instr)
4081 ,IF_ARCH_i386 ((Operand -> Instr)
4082 ,IF_ARCH_x86_64 ((Operand -> Instr)
4083 ,IF_ARCH_sparc((RI -> Reg -> Instr)
4084 ,IF_ARCH_powerpc((Reg -> Reg -> Instr)
4086 -> CmmExpr -- the one argument
4089 #ifndef powerpc_TARGET_ARCH
4092 -> IF_ARCH_alpha((Reg -> Reg -> Instr)
4093 ,IF_ARCH_i386 ((Reg -> Reg -> Instr)
4094 ,IF_ARCH_x86_64 ((Reg -> Reg -> Instr)
4095 ,IF_ARCH_sparc((Reg -> Reg -> Instr)
4097 -> CmmExpr -- the one argument
4101 -- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
4103 #if alpha_TARGET_ARCH
4105 trivialCode instr x (StInt y)
4107 = getRegister x `thenNat` \ register ->
4108 getNewRegNat IntRep `thenNat` \ tmp ->
4110 code = registerCode register tmp
4111 src1 = registerName register tmp
4112 src2 = ImmInt (fromInteger y)
4113 code__2 dst = code . mkSeqInstr (instr src1 (RIImm src2) dst)
4115 return (Any IntRep code__2)
4117 trivialCode instr x y
4118 = getRegister x `thenNat` \ register1 ->
4119 getRegister y `thenNat` \ register2 ->
4120 getNewRegNat IntRep `thenNat` \ tmp1 ->
4121 getNewRegNat IntRep `thenNat` \ tmp2 ->
4123 code1 = registerCode register1 tmp1 []
4124 src1 = registerName register1 tmp1
4125 code2 = registerCode register2 tmp2 []
4126 src2 = registerName register2 tmp2
4127 code__2 dst = asmSeqThen [code1, code2] .
4128 mkSeqInstr (instr src1 (RIReg src2) dst)
4130 return (Any IntRep code__2)
4133 trivialUCode instr x
4134 = getRegister x `thenNat` \ register ->
4135 getNewRegNat IntRep `thenNat` \ tmp ->
4137 code = registerCode register tmp
4138 src = registerName register tmp
4139 code__2 dst = code . mkSeqInstr (instr (RIReg src) dst)
4141 return (Any IntRep code__2)
4144 trivialFCode _ instr x y
4145 = getRegister x `thenNat` \ register1 ->
4146 getRegister y `thenNat` \ register2 ->
4147 getNewRegNat F64 `thenNat` \ tmp1 ->
4148 getNewRegNat F64 `thenNat` \ tmp2 ->
4150 code1 = registerCode register1 tmp1
4151 src1 = registerName register1 tmp1
4153 code2 = registerCode register2 tmp2
4154 src2 = registerName register2 tmp2
4156 code__2 dst = asmSeqThen [code1 [], code2 []] .
4157 mkSeqInstr (instr src1 src2 dst)
4159 return (Any F64 code__2)
4161 trivialUFCode _ instr x
4162 = getRegister x `thenNat` \ register ->
4163 getNewRegNat F64 `thenNat` \ tmp ->
4165 code = registerCode register tmp
4166 src = registerName register tmp
4167 code__2 dst = code . mkSeqInstr (instr src dst)
4169 return (Any F64 code__2)
4171 #endif /* alpha_TARGET_ARCH */
4173 -- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
4175 #if i386_TARGET_ARCH || x86_64_TARGET_ARCH
4178 The Rules of the Game are:
4180 * You cannot assume anything about the destination register dst;
4181 it may be anything, including a fixed reg.
4183 * You may compute an operand into a fixed reg, but you may not
4184 subsequently change the contents of that fixed reg. If you
4185 want to do so, first copy the value either to a temporary
4186 or into dst. You are free to modify dst even if it happens
4187 to be a fixed reg -- that's not your problem.
4189 * You cannot assume that a fixed reg will stay live over an
4190 arbitrary computation. The same applies to the dst reg.
4192 * Temporary regs obtained from getNewRegNat are distinct from
4193 each other and from all other regs, and stay live over
4194 arbitrary computations.
4196 --------------------
4198 SDM's version of The Rules:
4200 * If getRegister returns Any, that means it can generate correct
4201 code which places the result in any register, period. Even if that
4202 register happens to be read during the computation.
4204 Corollary #1: this means that if you are generating code for an
4205 operation with two arbitrary operands, you cannot assign the result
4206 of the first operand into the destination register before computing
4207 the second operand. The second operand might require the old value
4208 of the destination register.
4210 Corollary #2: A function might be able to generate more efficient
4211 code if it knows the destination register is a new temporary (and
4212 therefore not read by any of the sub-computations).
4214 * If getRegister returns Any, then the code it generates may modify only:
4215 (a) fresh temporaries
4216 (b) the destination register
4217 (c) known registers (eg. %ecx is used by shifts)
4218 In particular, it may *not* modify global registers, unless the global
4219 register happens to be the destination register.
4222 trivialCode rep instr (Just revinstr) (CmmLit lit_a) b
4223 | not (is64BitLit lit_a) = do
4224 b_code <- getAnyReg b
4227 = b_code dst `snocOL`
4228 revinstr (OpImm (litToImm lit_a)) (OpReg dst)
4230 return (Any rep code)
4232 trivialCode rep instr maybe_revinstr a b = genTrivialCode rep instr a b
4234 -- This is re-used for floating pt instructions too.
4235 genTrivialCode rep instr a b = do
4236 (b_op, b_code) <- getNonClobberedOperand b
4237 a_code <- getAnyReg a
4238 tmp <- getNewRegNat rep
4240 -- We want the value of b to stay alive across the computation of a.
4241 -- But, we want to calculate a straight into the destination register,
4242 -- because the instruction only has two operands (dst := dst `op` src).
4243 -- The troublesome case is when the result of b is in the same register
4244 -- as the destination reg. In this case, we have to save b in a
4245 -- new temporary across the computation of a.
4247 | dst `regClashesWithOp` b_op =
4249 unitOL (MOV rep b_op (OpReg tmp)) `appOL`
4251 instr (OpReg tmp) (OpReg dst)
4255 instr b_op (OpReg dst)
4257 return (Any rep code)
4259 reg `regClashesWithOp` OpReg reg2 = reg == reg2
4260 reg `regClashesWithOp` OpAddr amode = any (==reg) (addrModeRegs amode)
4261 reg `regClashesWithOp` _ = False
4265 trivialUCode rep instr x = do
4266 x_code <- getAnyReg x
4272 return (Any rep code)
4276 #if i386_TARGET_ARCH
4278 trivialFCode pk instr x y = do
4279 (x_reg, x_code) <- getNonClobberedReg x -- these work for float regs too
4280 (y_reg, y_code) <- getSomeReg y
4285 instr pk x_reg y_reg dst
4287 return (Any pk code)
4291 #if x86_64_TARGET_ARCH
4293 trivialFCode pk instr x y = genTrivialCode pk (instr pk) x y
4299 trivialUFCode rep instr x = do
4300 (x_reg, x_code) <- getSomeReg x
4306 return (Any rep code)
4308 #endif /* i386_TARGET_ARCH */
4310 -- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
4312 #if sparc_TARGET_ARCH
4314 trivialCode pk instr x (CmmLit (CmmInt y d))
4317 (src1, code) <- getSomeReg x
4318 tmp <- getNewRegNat I32
4320 src2 = ImmInt (fromInteger y)
4321 code__2 dst = code `snocOL` instr src1 (RIImm src2) dst
4322 return (Any I32 code__2)
4324 trivialCode pk instr x y = do
4325 (src1, code1) <- getSomeReg x
4326 (src2, code2) <- getSomeReg y
4327 tmp1 <- getNewRegNat I32
4328 tmp2 <- getNewRegNat I32
4330 code__2 dst = code1 `appOL` code2 `snocOL`
4331 instr src1 (RIReg src2) dst
4332 return (Any I32 code__2)
4335 trivialFCode pk instr x y = do
4336 (src1, code1) <- getSomeReg x
4337 (src2, code2) <- getSomeReg y
4338 tmp1 <- getNewRegNat (cmmExprRep x)
4339 tmp2 <- getNewRegNat (cmmExprRep y)
4340 tmp <- getNewRegNat F64
4342 promote x = FxTOy F32 F64 x tmp
4349 code1 `appOL` code2 `snocOL`
4350 instr pk src1 src2 dst
4351 else if pk1 == F32 then
4352 code1 `snocOL` promote src1 `appOL` code2 `snocOL`
4353 instr F64 tmp src2 dst
4355 code1 `appOL` code2 `snocOL` promote src2 `snocOL`
4356 instr F64 src1 tmp dst
4357 return (Any (if pk1 == pk2 then pk1 else F64) code__2)
4360 trivialUCode pk instr x = do
4361 (src, code) <- getSomeReg x
4362 tmp <- getNewRegNat pk
4364 code__2 dst = code `snocOL` instr (RIReg src) dst
4365 return (Any pk code__2)
4368 trivialUFCode pk instr x = do
4369 (src, code) <- getSomeReg x
4370 tmp <- getNewRegNat pk
4372 code__2 dst = code `snocOL` instr src dst
4373 return (Any pk code__2)
4375 #endif /* sparc_TARGET_ARCH */
4377 #if powerpc_TARGET_ARCH
4380 Wolfgang's PowerPC version of The Rules:
4382 A slightly modified version of The Rules to take advantage of the fact
4383 that PowerPC instructions work on all registers and don't implicitly
4384 clobber any fixed registers.
4386 * The only expression for which getRegister returns Fixed is (CmmReg reg).
4388 * If getRegister returns Any, then the code it generates may modify only:
4389 (a) fresh temporaries
4390 (b) the destination register
4391 It may *not* modify global registers, unless the global
4392 register happens to be the destination register.
4393 It may not clobber any other registers. In fact, only ccalls clobber any
4395 Also, it may not modify the counter register (used by genCCall).
4397 Corollary: If a getRegister for a subexpression returns Fixed, you need
4398 not move it to a fresh temporary before evaluating the next subexpression.
4399 The Fixed register won't be modified.
4400 Therefore, we don't need a counterpart for the x86's getStableReg on PPC.
4402 * SDM's First Rule is valid for PowerPC, too: subexpressions can depend on
4403 the value of the destination register.
4406 trivialCode rep signed instr x (CmmLit (CmmInt y _))
4407 | Just imm <- makeImmediate rep signed y
4409 (src1, code1) <- getSomeReg x
4410 let code dst = code1 `snocOL` instr dst src1 (RIImm imm)
4411 return (Any rep code)
4413 trivialCode rep signed instr x y = do
4414 (src1, code1) <- getSomeReg x
4415 (src2, code2) <- getSomeReg y
4416 let code dst = code1 `appOL` code2 `snocOL` instr dst src1 (RIReg src2)
4417 return (Any rep code)
4419 trivialCodeNoImm :: MachRep -> (Reg -> Reg -> Reg -> Instr)
4420 -> CmmExpr -> CmmExpr -> NatM Register
4421 trivialCodeNoImm rep instr x y = do
4422 (src1, code1) <- getSomeReg x
4423 (src2, code2) <- getSomeReg y
4424 let code dst = code1 `appOL` code2 `snocOL` instr dst src1 src2
4425 return (Any rep code)
4427 trivialUCode rep instr x = do
4428 (src, code) <- getSomeReg x
4429 let code' dst = code `snocOL` instr dst src
4430 return (Any rep code')
4432 -- There is no "remainder" instruction on the PPC, so we have to do
4434 -- The "div" parameter is the division instruction to use (DIVW or DIVWU)
4436 remainderCode :: MachRep -> (Reg -> Reg -> Reg -> Instr)
4437 -> CmmExpr -> CmmExpr -> NatM Register
4438 remainderCode rep div x y = do
4439 (src1, code1) <- getSomeReg x
4440 (src2, code2) <- getSomeReg y
4441 let code dst = code1 `appOL` code2 `appOL` toOL [
4443 MULLW dst dst (RIReg src2),
4446 return (Any rep code)
4448 #endif /* powerpc_TARGET_ARCH */
4451 -- -----------------------------------------------------------------------------
4452 -- Coercing to/from integer/floating-point...
4454 -- @coerce(Int2FP|FP2Int)@ are more complicated integer/float
4455 -- conversions. We have to store temporaries in memory to move
4456 -- between the integer and the floating point register sets.
4458 -- @coerceDbl2Flt@ and @coerceFlt2Dbl@ are done this way because we
4459 -- pretend, on sparc at least, that double and float regs are seperate
4460 -- kinds, so the value has to be computed into one kind before being
4461 -- explicitly "converted" to live in the other kind.
4463 coerceInt2FP :: MachRep -> MachRep -> CmmExpr -> NatM Register
4464 coerceFP2Int :: MachRep -> MachRep -> CmmExpr -> NatM Register
4466 #if sparc_TARGET_ARCH
4467 coerceDbl2Flt :: CmmExpr -> NatM Register
4468 coerceFlt2Dbl :: CmmExpr -> NatM Register
4471 -- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
4473 #if alpha_TARGET_ARCH
4476 = getRegister x `thenNat` \ register ->
4477 getNewRegNat IntRep `thenNat` \ reg ->
4479 code = registerCode register reg
4480 src = registerName register reg
4482 code__2 dst = code . mkSeqInstrs [
4484 LD TF dst (spRel 0),
4487 return (Any F64 code__2)
4491 = getRegister x `thenNat` \ register ->
4492 getNewRegNat F64 `thenNat` \ tmp ->
4494 code = registerCode register tmp
4495 src = registerName register tmp
4497 code__2 dst = code . mkSeqInstrs [
4499 ST TF tmp (spRel 0),
4502 return (Any IntRep code__2)
4504 #endif /* alpha_TARGET_ARCH */
4506 -- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
4508 #if i386_TARGET_ARCH
4510 coerceInt2FP from to x = do
4511 (x_reg, x_code) <- getSomeReg x
4513 opc = case to of F32 -> GITOF; F64 -> GITOD
4514 code dst = x_code `snocOL` opc x_reg dst
4515 -- ToDo: works for non-I32 reps?
4517 return (Any to code)
4521 coerceFP2Int from to x = do
4522 (x_reg, x_code) <- getSomeReg x
4524 opc = case from of F32 -> GFTOI; F64 -> GDTOI
4525 code dst = x_code `snocOL` opc x_reg dst
4526 -- ToDo: works for non-I32 reps?
4528 return (Any to code)
4530 #endif /* i386_TARGET_ARCH */
4532 -- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
4534 #if x86_64_TARGET_ARCH
4536 coerceFP2Int from to x = do
4537 (x_op, x_code) <- getOperand x -- ToDo: could be a safe operand
4539 opc = case from of F32 -> CVTSS2SI; F64 -> CVTSD2SI
4540 code dst = x_code `snocOL` opc x_op dst
4542 return (Any to code) -- works even if the destination rep is <I32
4544 coerceInt2FP from to x = do
4545 (x_op, x_code) <- getOperand x -- ToDo: could be a safe operand
4547 opc = case to of F32 -> CVTSI2SS; F64 -> CVTSI2SD
4548 code dst = x_code `snocOL` opc x_op dst
4550 return (Any to code) -- works even if the destination rep is <I32
4552 coerceFP2FP :: MachRep -> CmmExpr -> NatM Register
4553 coerceFP2FP to x = do
4554 (x_reg, x_code) <- getSomeReg x
4556 opc = case to of F32 -> CVTSD2SS; F64 -> CVTSS2SD
4557 code dst = x_code `snocOL` opc x_reg dst
4559 return (Any to code)
4563 -- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
4565 #if sparc_TARGET_ARCH
4567 coerceInt2FP pk1 pk2 x = do
4568 (src, code) <- getSomeReg x
4570 code__2 dst = code `appOL` toOL [
4571 ST pk1 src (spRel (-2)),
4572 LD pk1 (spRel (-2)) dst,
4573 FxTOy pk1 pk2 dst dst]
4574 return (Any pk2 code__2)
4577 coerceFP2Int pk fprep x = do
4578 (src, code) <- getSomeReg x
4579 reg <- getNewRegNat fprep
4580 tmp <- getNewRegNat pk
4582 code__2 dst = ASSERT(fprep == F64 || fprep == F32)
4584 FxTOy fprep pk src tmp,
4585 ST pk tmp (spRel (-2)),
4586 LD pk (spRel (-2)) dst]
4587 return (Any pk code__2)
4590 coerceDbl2Flt x = do
4591 (src, code) <- getSomeReg x
4592 return (Any F32 (\dst -> code `snocOL` FxTOy F64 F32 src dst))
4595 coerceFlt2Dbl x = do
4596 (src, code) <- getSomeReg x
4597 return (Any F64 (\dst -> code `snocOL` FxTOy F32 F64 src dst))
4599 #endif /* sparc_TARGET_ARCH */
4601 #if powerpc_TARGET_ARCH
4602 coerceInt2FP fromRep toRep x = do
4603 (src, code) <- getSomeReg x
4604 lbl <- getNewLabelNat
4605 itmp <- getNewRegNat I32
4606 ftmp <- getNewRegNat F64
4607 dynRef <- cmmMakeDynamicReference addImportNat False lbl
4608 Amode addr addr_code <- getAmode dynRef
4610 code' dst = code `appOL` maybe_exts `appOL` toOL [
4613 CmmStaticLit (CmmInt 0x43300000 I32),
4614 CmmStaticLit (CmmInt 0x80000000 I32)],
4615 XORIS itmp src (ImmInt 0x8000),
4616 ST I32 itmp (spRel 3),
4617 LIS itmp (ImmInt 0x4330),
4618 ST I32 itmp (spRel 2),
4619 LD F64 ftmp (spRel 2)
4620 ] `appOL` addr_code `appOL` toOL [
4622 FSUB F64 dst ftmp dst
4623 ] `appOL` maybe_frsp dst
4625 maybe_exts = case fromRep of
4626 I8 -> unitOL $ EXTS I8 src src
4627 I16 -> unitOL $ EXTS I16 src src
4629 maybe_frsp dst = case toRep of
4630 F32 -> unitOL $ FRSP dst dst
4632 return (Any toRep code')
4634 coerceFP2Int fromRep toRep x = do
4635 -- the reps don't really matter: F*->F64 and I32->I* are no-ops
4636 (src, code) <- getSomeReg x
4637 tmp <- getNewRegNat F64
4639 code' dst = code `appOL` toOL [
4640 -- convert to int in FP reg
4642 -- store value (64bit) from FP to stack
4643 ST F64 tmp (spRel 2),
4644 -- read low word of value (high word is undefined)
4645 LD I32 dst (spRel 3)]
4646 return (Any toRep code')
4647 #endif /* powerpc_TARGET_ARCH */
4650 -- -----------------------------------------------------------------------------
4651 -- eXTRA_STK_ARGS_HERE
4653 -- We (allegedly) put the first six C-call arguments in registers;
4654 -- where do we start putting the rest of them?
4656 -- Moved from MachInstrs (SDM):
4658 #if alpha_TARGET_ARCH || sparc_TARGET_ARCH
4659 eXTRA_STK_ARGS_HERE :: Int
4661 = IF_ARCH_alpha(0, IF_ARCH_sparc(23, ???))