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 )
25 import RegAllocInfo ( mkBranchInstr )
27 -- Our intermediate code:
28 import PprCmm ( pprExpr )
34 import StaticFlags ( opt_PIC )
35 import ForeignCall ( CCallConv(..) )
40 import FastTypes ( isFastTrue )
41 import Constants ( wORD_SIZE )
44 import Outputable ( assertPanic )
45 import TRACE ( trace )
48 import Control.Monad ( mapAndUnzipM )
49 import Maybe ( fromJust )
53 -- -----------------------------------------------------------------------------
54 -- Top-level of the instruction selector
56 -- | 'InstrBlock's are the insn sequences generated by the insn selectors.
57 -- They are really trees of insns to facilitate fast appending, where a
58 -- left-to-right traversal (pre-order?) yields the insns in the correct
61 type InstrBlock = OrdList Instr
63 cmmTopCodeGen :: CmmTop -> NatM [NatCmmTop]
64 cmmTopCodeGen (CmmProc info lab params blocks) = do
65 (nat_blocks,statics) <- mapAndUnzipM basicBlockCodeGen blocks
66 picBaseMb <- getPicBaseMaybeNat
67 let proc = CmmProc info lab params (concat nat_blocks)
68 tops = proc : concat statics
70 Just picBase -> initializePicBase picBase tops
71 Nothing -> return tops
73 cmmTopCodeGen (CmmData sec dat) = do
74 return [CmmData sec dat] -- no translation, we just use CmmStatic
76 basicBlockCodeGen :: CmmBasicBlock -> NatM ([NatBasicBlock],[NatCmmTop])
77 basicBlockCodeGen (BasicBlock id stmts) = do
78 instrs <- stmtsToInstrs stmts
79 -- code generation may introduce new basic block boundaries, which
80 -- are indicated by the NEWBLOCK instruction. We must split up the
81 -- instruction stream into basic blocks again. Also, we extract
84 (top,other_blocks,statics) = foldrOL mkBlocks ([],[],[]) instrs
86 mkBlocks (NEWBLOCK id) (instrs,blocks,statics)
87 = ([], BasicBlock id instrs : blocks, statics)
88 mkBlocks (LDATA sec dat) (instrs,blocks,statics)
89 = (instrs, blocks, CmmData sec dat:statics)
90 mkBlocks instr (instrs,blocks,statics)
91 = (instr:instrs, blocks, statics)
93 return (BasicBlock id top : other_blocks, statics)
95 stmtsToInstrs :: [CmmStmt] -> NatM InstrBlock
97 = do instrss <- mapM stmtToInstrs stmts
98 return (concatOL instrss)
100 stmtToInstrs :: CmmStmt -> NatM InstrBlock
101 stmtToInstrs stmt = case stmt of
102 CmmNop -> return nilOL
103 CmmComment s -> return (unitOL (COMMENT s))
106 | isFloatingRep kind -> assignReg_FltCode kind reg src
107 #if WORD_SIZE_IN_BITS==32
108 | kind == I64 -> assignReg_I64Code reg src
110 | otherwise -> assignReg_IntCode kind reg src
111 where kind = cmmRegRep reg
114 | isFloatingRep kind -> assignMem_FltCode kind addr src
115 #if WORD_SIZE_IN_BITS==32
116 | kind == I64 -> assignMem_I64Code addr src
118 | otherwise -> assignMem_IntCode kind addr src
119 where kind = cmmExprRep src
121 CmmCall target result_regs args vols
122 -> genCCall target result_regs args vols
124 CmmBranch id -> genBranch id
125 CmmCondBranch arg id -> genCondJump id arg
126 CmmSwitch arg ids -> genSwitch arg ids
127 CmmJump arg params -> genJump arg
129 -- -----------------------------------------------------------------------------
130 -- General things for putting together code sequences
132 -- Expand CmmRegOff. ToDo: should we do it this way around, or convert
133 -- CmmExprs into CmmRegOff?
134 mangleIndexTree :: CmmExpr -> CmmExpr
135 mangleIndexTree (CmmRegOff reg off)
136 = CmmMachOp (MO_Add rep) [CmmReg reg, CmmLit (CmmInt (fromIntegral off) rep)]
137 where rep = cmmRegRep reg
139 -- -----------------------------------------------------------------------------
140 -- Code gen for 64-bit arithmetic on 32-bit platforms
143 Simple support for generating 64-bit code (ie, 64 bit values and 64
144 bit assignments) on 32-bit platforms. Unlike the main code generator
145 we merely shoot for generating working code as simply as possible, and
146 pay little attention to code quality. Specifically, there is no
147 attempt to deal cleverly with the fixed-vs-floating register
148 distinction; all values are generated into (pairs of) floating
149 registers, even if this would mean some redundant reg-reg moves as a
150 result. Only one of the VRegUniques is returned, since it will be
151 of the VRegUniqueLo form, and the upper-half VReg can be determined
152 by applying getHiVRegFromLo to it.
155 data ChildCode64 -- a.k.a "Register64"
158 Reg -- the lower 32-bit temporary which contains the
159 -- result; use getHiVRegFromLo to find the other
160 -- VRegUnique. Rules of this simplified insn
161 -- selection game are therefore that the returned
162 -- Reg may be modified
164 #if WORD_SIZE_IN_BITS==32
165 assignMem_I64Code :: CmmExpr -> CmmExpr -> NatM InstrBlock
166 assignReg_I64Code :: CmmReg -> CmmExpr -> NatM InstrBlock
169 #ifndef x86_64_TARGET_ARCH
170 iselExpr64 :: CmmExpr -> NatM ChildCode64
173 -- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
177 assignMem_I64Code addrTree valueTree = do
178 Amode addr addr_code <- getAmode addrTree
179 ChildCode64 vcode rlo <- iselExpr64 valueTree
181 rhi = getHiVRegFromLo rlo
183 -- Little-endian store
184 mov_lo = MOV I32 (OpReg rlo) (OpAddr addr)
185 mov_hi = MOV I32 (OpReg rhi) (OpAddr (fromJust (addrOffset addr 4)))
187 return (vcode `appOL` addr_code `snocOL` mov_lo `snocOL` mov_hi)
190 assignReg_I64Code (CmmLocal (LocalReg u_dst pk)) valueTree = do
191 ChildCode64 vcode r_src_lo <- iselExpr64 valueTree
193 r_dst_lo = mkVReg u_dst I32
194 r_dst_hi = getHiVRegFromLo r_dst_lo
195 r_src_hi = getHiVRegFromLo r_src_lo
196 mov_lo = MOV I32 (OpReg r_src_lo) (OpReg r_dst_lo)
197 mov_hi = MOV I32 (OpReg r_src_hi) (OpReg r_dst_hi)
200 vcode `snocOL` mov_lo `snocOL` mov_hi
203 assignReg_I64Code lvalue valueTree
204 = panic "assignReg_I64Code(i386): invalid lvalue"
208 iselExpr64 (CmmLit (CmmInt i _)) = do
209 (rlo,rhi) <- getNewRegPairNat I32
211 r = fromIntegral (fromIntegral i :: Word32)
212 q = fromIntegral ((fromIntegral i `shiftR` 32) :: Word32)
214 MOV I32 (OpImm (ImmInteger r)) (OpReg rlo),
215 MOV I32 (OpImm (ImmInteger q)) (OpReg rhi)
218 return (ChildCode64 code rlo)
220 iselExpr64 (CmmLoad addrTree I64) = do
221 Amode addr addr_code <- getAmode addrTree
222 (rlo,rhi) <- getNewRegPairNat I32
224 mov_lo = MOV I32 (OpAddr addr) (OpReg rlo)
225 mov_hi = MOV I32 (OpAddr (fromJust (addrOffset addr 4))) (OpReg rhi)
228 ChildCode64 (addr_code `snocOL` mov_lo `snocOL` mov_hi)
232 iselExpr64 (CmmReg (CmmLocal (LocalReg vu I64)))
233 = return (ChildCode64 nilOL (mkVReg vu I32))
235 -- we handle addition, but rather badly
236 iselExpr64 (CmmMachOp (MO_Add _) [e1, CmmLit (CmmInt i _)]) = do
237 ChildCode64 code1 r1lo <- iselExpr64 e1
238 (rlo,rhi) <- getNewRegPairNat I32
240 r = fromIntegral (fromIntegral i :: Word32)
241 q = fromIntegral ((fromIntegral i `shiftR` 32) :: Word32)
242 r1hi = getHiVRegFromLo r1lo
244 toOL [ MOV I32 (OpReg r1lo) (OpReg rlo),
245 ADD I32 (OpImm (ImmInteger r)) (OpReg rlo),
246 MOV I32 (OpReg r1hi) (OpReg rhi),
247 ADC I32 (OpImm (ImmInteger q)) (OpReg rhi) ]
249 return (ChildCode64 code rlo)
251 iselExpr64 (CmmMachOp (MO_Add _) [e1,e2]) = do
252 ChildCode64 code1 r1lo <- iselExpr64 e1
253 ChildCode64 code2 r2lo <- iselExpr64 e2
254 (rlo,rhi) <- getNewRegPairNat I32
256 r1hi = getHiVRegFromLo r1lo
257 r2hi = getHiVRegFromLo r2lo
260 toOL [ MOV I32 (OpReg r1lo) (OpReg rlo),
261 ADD I32 (OpReg r2lo) (OpReg rlo),
262 MOV I32 (OpReg r1hi) (OpReg rhi),
263 ADC I32 (OpReg r2hi) (OpReg rhi) ]
265 return (ChildCode64 code rlo)
268 = pprPanic "iselExpr64(i386)" (ppr expr)
270 #endif /* i386_TARGET_ARCH */
272 -- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
274 #if sparc_TARGET_ARCH
276 assignMem_I64Code addrTree valueTree = do
277 Amode addr addr_code <- getAmode addrTree
278 ChildCode64 vcode rlo <- iselExpr64 valueTree
279 (src, code) <- getSomeReg addrTree
281 rhi = getHiVRegFromLo rlo
283 mov_hi = ST I32 rhi (AddrRegImm src (ImmInt 0))
284 mov_lo = ST I32 rlo (AddrRegImm src (ImmInt 4))
285 return (vcode `appOL` code `snocOL` mov_hi `snocOL` mov_lo)
287 assignReg_I64Code (CmmLocal (LocalReg u_dst pk)) valueTree = do
288 ChildCode64 vcode r_src_lo <- iselExpr64 valueTree
290 r_dst_lo = mkVReg u_dst pk
291 r_dst_hi = getHiVRegFromLo r_dst_lo
292 r_src_hi = getHiVRegFromLo r_src_lo
293 mov_lo = mkMOV r_src_lo r_dst_lo
294 mov_hi = mkMOV r_src_hi r_dst_hi
295 mkMOV sreg dreg = OR False g0 (RIReg sreg) dreg
296 return (vcode `snocOL` mov_hi `snocOL` mov_lo)
297 assignReg_I64Code lvalue valueTree
298 = panic "assignReg_I64Code(sparc): invalid lvalue"
301 -- Don't delete this -- it's very handy for debugging.
303 -- | trace ("iselExpr64: " ++ showSDoc (ppr expr)) False
304 -- = panic "iselExpr64(???)"
306 iselExpr64 (CmmLoad addrTree I64) = do
307 Amode (AddrRegReg r1 r2) addr_code <- getAmode addrTree
308 rlo <- getNewRegNat I32
309 let rhi = getHiVRegFromLo rlo
310 mov_hi = LD I32 (AddrRegImm r1 (ImmInt 0)) rhi
311 mov_lo = LD I32 (AddrRegImm r1 (ImmInt 4)) rlo
313 ChildCode64 (addr_code `snocOL` mov_hi `snocOL` mov_lo)
317 iselExpr64 (CmmReg (CmmLocal (LocalReg uq I64))) = do
318 r_dst_lo <- getNewRegNat I32
319 let r_dst_hi = getHiVRegFromLo r_dst_lo
320 r_src_lo = mkVReg uq I32
321 r_src_hi = getHiVRegFromLo r_src_lo
322 mov_lo = mkMOV r_src_lo r_dst_lo
323 mov_hi = mkMOV r_src_hi r_dst_hi
324 mkMOV sreg dreg = OR False g0 (RIReg sreg) dreg
326 ChildCode64 (toOL [mov_hi, mov_lo]) r_dst_lo
330 = pprPanic "iselExpr64(sparc)" (ppr expr)
332 #endif /* sparc_TARGET_ARCH */
334 -- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
336 #if powerpc_TARGET_ARCH
338 getI64Amodes :: CmmExpr -> NatM (AddrMode, AddrMode, InstrBlock)
339 getI64Amodes addrTree = do
340 Amode hi_addr addr_code <- getAmode addrTree
341 case addrOffset hi_addr 4 of
342 Just lo_addr -> return (hi_addr, lo_addr, addr_code)
343 Nothing -> do (hi_ptr, code) <- getSomeReg addrTree
344 return (AddrRegImm hi_ptr (ImmInt 0),
345 AddrRegImm hi_ptr (ImmInt 4),
348 assignMem_I64Code addrTree valueTree = do
349 (hi_addr, lo_addr, addr_code) <- getI64Amodes addrTree
350 ChildCode64 vcode rlo <- iselExpr64 valueTree
352 rhi = getHiVRegFromLo rlo
355 mov_hi = ST I32 rhi hi_addr
356 mov_lo = ST I32 rlo lo_addr
358 return (vcode `appOL` addr_code `snocOL` mov_lo `snocOL` mov_hi)
360 assignReg_I64Code (CmmLocal (LocalReg u_dst pk)) valueTree = do
361 ChildCode64 vcode r_src_lo <- iselExpr64 valueTree
363 r_dst_lo = mkVReg u_dst I32
364 r_dst_hi = getHiVRegFromLo r_dst_lo
365 r_src_hi = getHiVRegFromLo r_src_lo
366 mov_lo = MR r_dst_lo r_src_lo
367 mov_hi = MR r_dst_hi r_src_hi
370 vcode `snocOL` mov_lo `snocOL` mov_hi
373 assignReg_I64Code lvalue valueTree
374 = panic "assignReg_I64Code(powerpc): invalid lvalue"
377 -- Don't delete this -- it's very handy for debugging.
379 -- | trace ("iselExpr64: " ++ showSDoc (pprCmmExpr expr)) False
380 -- = panic "iselExpr64(???)"
382 iselExpr64 (CmmLoad addrTree I64) = do
383 (hi_addr, lo_addr, addr_code) <- getI64Amodes addrTree
384 (rlo, rhi) <- getNewRegPairNat I32
385 let mov_hi = LD I32 rhi hi_addr
386 mov_lo = LD I32 rlo lo_addr
387 return $ ChildCode64 (addr_code `snocOL` mov_lo `snocOL` mov_hi)
390 iselExpr64 (CmmReg (CmmLocal (LocalReg vu I64)))
391 = return (ChildCode64 nilOL (mkVReg vu I32))
393 iselExpr64 (CmmLit (CmmInt i _)) = do
394 (rlo,rhi) <- getNewRegPairNat I32
396 half0 = fromIntegral (fromIntegral i :: Word16)
397 half1 = fromIntegral ((fromIntegral i `shiftR` 16) :: Word16)
398 half2 = fromIntegral ((fromIntegral i `shiftR` 32) :: Word16)
399 half3 = fromIntegral ((fromIntegral i `shiftR` 48) :: Word16)
402 LIS rlo (ImmInt half1),
403 OR rlo rlo (RIImm $ ImmInt half0),
404 LIS rhi (ImmInt half3),
405 OR rlo rlo (RIImm $ ImmInt half2)
408 return (ChildCode64 code rlo)
410 iselExpr64 (CmmMachOp (MO_Add _) [e1,e2]) = do
411 ChildCode64 code1 r1lo <- iselExpr64 e1
412 ChildCode64 code2 r2lo <- iselExpr64 e2
413 (rlo,rhi) <- getNewRegPairNat I32
415 r1hi = getHiVRegFromLo r1lo
416 r2hi = getHiVRegFromLo r2lo
419 toOL [ ADDC rlo r1lo r2lo,
422 return (ChildCode64 code rlo)
425 = pprPanic "iselExpr64(powerpc)" (ppr expr)
427 #endif /* powerpc_TARGET_ARCH */
430 -- -----------------------------------------------------------------------------
431 -- The 'Register' type
433 -- 'Register's passed up the tree. If the stix code forces the register
434 -- to live in a pre-decided machine register, it comes out as @Fixed@;
435 -- otherwise, it comes out as @Any@, and the parent can decide which
436 -- register to put it in.
439 = Fixed MachRep Reg InstrBlock
440 | Any MachRep (Reg -> InstrBlock)
442 swizzleRegisterRep :: Register -> MachRep -> Register
443 swizzleRegisterRep (Fixed _ reg code) rep = Fixed rep reg code
444 swizzleRegisterRep (Any _ codefn) rep = Any rep codefn
447 -- -----------------------------------------------------------------------------
448 -- Utils based on getRegister, below
450 -- The dual to getAnyReg: compute an expression into a register, but
451 -- we don't mind which one it is.
452 getSomeReg :: CmmExpr -> NatM (Reg, InstrBlock)
454 r <- getRegister expr
457 tmp <- getNewRegNat rep
458 return (tmp, code tmp)
462 -- -----------------------------------------------------------------------------
463 -- Grab the Reg for a CmmReg
465 getRegisterReg :: CmmReg -> Reg
467 getRegisterReg (CmmLocal (LocalReg u pk))
470 getRegisterReg (CmmGlobal mid)
471 = case get_GlobalReg_reg_or_addr mid of
472 Left (RealReg rrno) -> RealReg rrno
473 _other -> pprPanic "getRegisterReg-memory" (ppr $ CmmGlobal mid)
474 -- By this stage, the only MagicIds remaining should be the
475 -- ones which map to a real machine register on this
476 -- platform. Hence ...
479 -- -----------------------------------------------------------------------------
480 -- Generate code to get a subtree into a Register
482 -- Don't delete this -- it's very handy for debugging.
484 -- | trace ("getRegister: " ++ showSDoc (pprCmmExpr expr)) False
485 -- = panic "getRegister(???)"
487 getRegister :: CmmExpr -> NatM Register
489 getRegister (CmmReg (CmmGlobal PicBaseReg))
491 reg <- getPicBaseNat wordRep
492 return (Fixed wordRep reg nilOL)
494 getRegister (CmmReg reg)
495 = return (Fixed (cmmRegRep reg) (getRegisterReg reg) nilOL)
497 getRegister tree@(CmmRegOff _ _)
498 = getRegister (mangleIndexTree tree)
500 -- end of machine-"independent" bit; here we go on the rest...
502 #if alpha_TARGET_ARCH
504 getRegister (StDouble d)
505 = getBlockIdNat `thenNat` \ lbl ->
506 getNewRegNat PtrRep `thenNat` \ tmp ->
507 let code dst = mkSeqInstrs [
508 LDATA RoDataSegment lbl [
509 DATA TF [ImmLab (rational d)]
511 LDA tmp (AddrImm (ImmCLbl lbl)),
512 LD TF dst (AddrReg tmp)]
514 return (Any F64 code)
516 getRegister (StPrim primop [x]) -- unary PrimOps
518 IntNegOp -> trivialUCode (NEG Q False) x
520 NotOp -> trivialUCode NOT x
522 FloatNegOp -> trivialUFCode FloatRep (FNEG TF) x
523 DoubleNegOp -> trivialUFCode F64 (FNEG TF) x
525 OrdOp -> coerceIntCode IntRep x
528 Float2IntOp -> coerceFP2Int x
529 Int2FloatOp -> coerceInt2FP pr x
530 Double2IntOp -> coerceFP2Int x
531 Int2DoubleOp -> coerceInt2FP pr x
533 Double2FloatOp -> coerceFltCode x
534 Float2DoubleOp -> coerceFltCode x
536 other_op -> getRegister (StCall fn CCallConv F64 [x])
538 fn = case other_op of
539 FloatExpOp -> FSLIT("exp")
540 FloatLogOp -> FSLIT("log")
541 FloatSqrtOp -> FSLIT("sqrt")
542 FloatSinOp -> FSLIT("sin")
543 FloatCosOp -> FSLIT("cos")
544 FloatTanOp -> FSLIT("tan")
545 FloatAsinOp -> FSLIT("asin")
546 FloatAcosOp -> FSLIT("acos")
547 FloatAtanOp -> FSLIT("atan")
548 FloatSinhOp -> FSLIT("sinh")
549 FloatCoshOp -> FSLIT("cosh")
550 FloatTanhOp -> FSLIT("tanh")
551 DoubleExpOp -> FSLIT("exp")
552 DoubleLogOp -> FSLIT("log")
553 DoubleSqrtOp -> FSLIT("sqrt")
554 DoubleSinOp -> FSLIT("sin")
555 DoubleCosOp -> FSLIT("cos")
556 DoubleTanOp -> FSLIT("tan")
557 DoubleAsinOp -> FSLIT("asin")
558 DoubleAcosOp -> FSLIT("acos")
559 DoubleAtanOp -> FSLIT("atan")
560 DoubleSinhOp -> FSLIT("sinh")
561 DoubleCoshOp -> FSLIT("cosh")
562 DoubleTanhOp -> FSLIT("tanh")
564 pr = panic "MachCode.getRegister: no primrep needed for Alpha"
566 getRegister (StPrim primop [x, y]) -- dyadic PrimOps
568 CharGtOp -> trivialCode (CMP LTT) y x
569 CharGeOp -> trivialCode (CMP LE) y x
570 CharEqOp -> trivialCode (CMP EQQ) x y
571 CharNeOp -> int_NE_code x y
572 CharLtOp -> trivialCode (CMP LTT) x y
573 CharLeOp -> trivialCode (CMP LE) x y
575 IntGtOp -> trivialCode (CMP LTT) y x
576 IntGeOp -> trivialCode (CMP LE) y x
577 IntEqOp -> trivialCode (CMP EQQ) x y
578 IntNeOp -> int_NE_code x y
579 IntLtOp -> trivialCode (CMP LTT) x y
580 IntLeOp -> trivialCode (CMP LE) x y
582 WordGtOp -> trivialCode (CMP ULT) y x
583 WordGeOp -> trivialCode (CMP ULE) x y
584 WordEqOp -> trivialCode (CMP EQQ) x y
585 WordNeOp -> int_NE_code x y
586 WordLtOp -> trivialCode (CMP ULT) x y
587 WordLeOp -> trivialCode (CMP ULE) x y
589 AddrGtOp -> trivialCode (CMP ULT) y x
590 AddrGeOp -> trivialCode (CMP ULE) y x
591 AddrEqOp -> trivialCode (CMP EQQ) x y
592 AddrNeOp -> int_NE_code x y
593 AddrLtOp -> trivialCode (CMP ULT) x y
594 AddrLeOp -> trivialCode (CMP ULE) x y
596 FloatGtOp -> cmpF_code (FCMP TF LE) EQQ x y
597 FloatGeOp -> cmpF_code (FCMP TF LTT) EQQ x y
598 FloatEqOp -> cmpF_code (FCMP TF EQQ) NE x y
599 FloatNeOp -> cmpF_code (FCMP TF EQQ) EQQ x y
600 FloatLtOp -> cmpF_code (FCMP TF LTT) NE x y
601 FloatLeOp -> cmpF_code (FCMP TF LE) NE x y
603 DoubleGtOp -> cmpF_code (FCMP TF LE) EQQ x y
604 DoubleGeOp -> cmpF_code (FCMP TF LTT) EQQ x y
605 DoubleEqOp -> cmpF_code (FCMP TF EQQ) NE x y
606 DoubleNeOp -> cmpF_code (FCMP TF EQQ) EQQ x y
607 DoubleLtOp -> cmpF_code (FCMP TF LTT) NE x y
608 DoubleLeOp -> cmpF_code (FCMP TF LE) NE x y
610 IntAddOp -> trivialCode (ADD Q False) x y
611 IntSubOp -> trivialCode (SUB Q False) x y
612 IntMulOp -> trivialCode (MUL Q False) x y
613 IntQuotOp -> trivialCode (DIV Q False) x y
614 IntRemOp -> trivialCode (REM Q False) x y
616 WordAddOp -> trivialCode (ADD Q False) x y
617 WordSubOp -> trivialCode (SUB Q False) x y
618 WordMulOp -> trivialCode (MUL Q False) x y
619 WordQuotOp -> trivialCode (DIV Q True) x y
620 WordRemOp -> trivialCode (REM Q True) x y
622 FloatAddOp -> trivialFCode FloatRep (FADD TF) x y
623 FloatSubOp -> trivialFCode FloatRep (FSUB TF) x y
624 FloatMulOp -> trivialFCode FloatRep (FMUL TF) x y
625 FloatDivOp -> trivialFCode FloatRep (FDIV TF) x y
627 DoubleAddOp -> trivialFCode F64 (FADD TF) x y
628 DoubleSubOp -> trivialFCode F64 (FSUB TF) x y
629 DoubleMulOp -> trivialFCode F64 (FMUL TF) x y
630 DoubleDivOp -> trivialFCode F64 (FDIV TF) x y
632 AddrAddOp -> trivialCode (ADD Q False) x y
633 AddrSubOp -> trivialCode (SUB Q False) x y
634 AddrRemOp -> trivialCode (REM Q True) x y
636 AndOp -> trivialCode AND x y
637 OrOp -> trivialCode OR x y
638 XorOp -> trivialCode XOR x y
639 SllOp -> trivialCode SLL x y
640 SrlOp -> trivialCode SRL x y
642 ISllOp -> trivialCode SLL x y -- was: panic "AlphaGen:isll"
643 ISraOp -> trivialCode SRA x y -- was: panic "AlphaGen:isra"
644 ISrlOp -> trivialCode SRL x y -- was: panic "AlphaGen:isrl"
646 FloatPowerOp -> getRegister (StCall FSLIT("pow") CCallConv F64 [x,y])
647 DoublePowerOp -> getRegister (StCall FSLIT("pow") CCallConv F64 [x,y])
649 {- ------------------------------------------------------------
650 Some bizarre special code for getting condition codes into
651 registers. Integer non-equality is a test for equality
652 followed by an XOR with 1. (Integer comparisons always set
653 the result register to 0 or 1.) Floating point comparisons of
654 any kind leave the result in a floating point register, so we
655 need to wrangle an integer register out of things.
657 int_NE_code :: StixTree -> StixTree -> NatM Register
660 = trivialCode (CMP EQQ) x y `thenNat` \ register ->
661 getNewRegNat IntRep `thenNat` \ tmp ->
663 code = registerCode register tmp
664 src = registerName register tmp
665 code__2 dst = code . mkSeqInstr (XOR src (RIImm (ImmInt 1)) dst)
667 return (Any IntRep code__2)
669 {- ------------------------------------------------------------
670 Comments for int_NE_code also apply to cmpF_code
673 :: (Reg -> Reg -> Reg -> Instr)
675 -> StixTree -> StixTree
678 cmpF_code instr cond x y
679 = trivialFCode pr instr x y `thenNat` \ register ->
680 getNewRegNat F64 `thenNat` \ tmp ->
681 getBlockIdNat `thenNat` \ lbl ->
683 code = registerCode register tmp
684 result = registerName register tmp
686 code__2 dst = code . mkSeqInstrs [
687 OR zeroh (RIImm (ImmInt 1)) dst,
688 BF cond result (ImmCLbl lbl),
689 OR zeroh (RIReg zeroh) dst,
692 return (Any IntRep code__2)
694 pr = panic "trivialU?FCode: does not use PrimRep on Alpha"
695 ------------------------------------------------------------
697 getRegister (CmmLoad pk mem)
698 = getAmode mem `thenNat` \ amode ->
700 code = amodeCode amode
701 src = amodeAddr amode
702 size = primRepToSize pk
703 code__2 dst = code . mkSeqInstr (LD size dst src)
705 return (Any pk code__2)
707 getRegister (StInt i)
710 code dst = mkSeqInstr (OR zeroh (RIImm src) dst)
712 return (Any IntRep code)
715 code dst = mkSeqInstr (LDI Q dst src)
717 return (Any IntRep code)
719 src = ImmInt (fromInteger i)
724 code dst = mkSeqInstr (LDA dst (AddrImm imm__2))
726 return (Any PtrRep code)
729 imm__2 = case imm of Just x -> x
731 #endif /* alpha_TARGET_ARCH */
733 -- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
737 getRegister (CmmLit (CmmFloat f F32)) = do
738 lbl <- getNewLabelNat
739 dynRef <- cmmMakeDynamicReference addImportNat False lbl
740 Amode addr addr_code <- getAmode dynRef
744 CmmStaticLit (CmmFloat f F32)]
745 `consOL` (addr_code `snocOL`
748 return (Any F32 code)
751 getRegister (CmmLit (CmmFloat d F64))
753 = let code dst = unitOL (GLDZ dst)
754 in return (Any F64 code)
757 = let code dst = unitOL (GLD1 dst)
758 in return (Any F64 code)
761 lbl <- getNewLabelNat
762 dynRef <- cmmMakeDynamicReference addImportNat False lbl
763 Amode addr addr_code <- getAmode dynRef
767 CmmStaticLit (CmmFloat d F64)]
768 `consOL` (addr_code `snocOL`
771 return (Any F64 code)
773 #endif /* i386_TARGET_ARCH */
775 #if x86_64_TARGET_ARCH
777 getRegister (CmmLit (CmmFloat 0.0 rep)) = do
778 let code dst = unitOL (XOR rep (OpReg dst) (OpReg dst))
779 -- I don't know why there are xorpd, xorps, and pxor instructions.
780 -- They all appear to do the same thing --SDM
781 return (Any rep code)
783 getRegister (CmmLit (CmmFloat f rep)) = do
784 lbl <- getNewLabelNat
785 let code dst = toOL [
788 CmmStaticLit (CmmFloat f rep)],
789 MOV rep (OpAddr (ripRel (ImmCLbl lbl))) (OpReg dst)
792 return (Any rep code)
794 #endif /* x86_64_TARGET_ARCH */
796 #if i386_TARGET_ARCH || x86_64_TARGET_ARCH
798 -- catch simple cases of zero- or sign-extended load
799 getRegister (CmmMachOp (MO_U_Conv I8 I32) [CmmLoad addr _]) = do
800 code <- intLoadCode (MOVZxL I8) addr
801 return (Any I32 code)
803 getRegister (CmmMachOp (MO_S_Conv I8 I32) [CmmLoad addr _]) = do
804 code <- intLoadCode (MOVSxL I8) addr
805 return (Any I32 code)
807 getRegister (CmmMachOp (MO_U_Conv I16 I32) [CmmLoad addr _]) = do
808 code <- intLoadCode (MOVZxL I16) addr
809 return (Any I32 code)
811 getRegister (CmmMachOp (MO_S_Conv I16 I32) [CmmLoad addr _]) = do
812 code <- intLoadCode (MOVSxL I16) addr
813 return (Any I32 code)
817 #if x86_64_TARGET_ARCH
819 -- catch simple cases of zero- or sign-extended load
820 getRegister (CmmMachOp (MO_U_Conv I8 I64) [CmmLoad addr _]) = do
821 code <- intLoadCode (MOVZxL I8) addr
822 return (Any I64 code)
824 getRegister (CmmMachOp (MO_S_Conv I8 I64) [CmmLoad addr _]) = do
825 code <- intLoadCode (MOVSxL I8) addr
826 return (Any I64 code)
828 getRegister (CmmMachOp (MO_U_Conv I16 I64) [CmmLoad addr _]) = do
829 code <- intLoadCode (MOVZxL I16) addr
830 return (Any I64 code)
832 getRegister (CmmMachOp (MO_S_Conv I16 I64) [CmmLoad addr _]) = do
833 code <- intLoadCode (MOVSxL I16) addr
834 return (Any I64 code)
836 getRegister (CmmMachOp (MO_U_Conv I32 I64) [CmmLoad addr _]) = do
837 code <- intLoadCode (MOV I32) addr -- 32-bit loads zero-extend
838 return (Any I64 code)
840 getRegister (CmmMachOp (MO_S_Conv I32 I64) [CmmLoad addr _]) = do
841 code <- intLoadCode (MOVSxL I32) addr
842 return (Any I64 code)
846 #if x86_64_TARGET_ARCH
847 getRegister (CmmMachOp (MO_S_Neg F32) [x]) = do
848 x_code <- getAnyReg x
849 lbl <- getNewLabelNat
851 code dst = x_code dst `appOL` toOL [
852 -- This is how gcc does it, so it can't be that bad:
853 LDATA ReadOnlyData16 [
856 CmmStaticLit (CmmInt 0x80000000 I32),
857 CmmStaticLit (CmmInt 0 I32),
858 CmmStaticLit (CmmInt 0 I32),
859 CmmStaticLit (CmmInt 0 I32)
861 XOR F32 (OpAddr (ripRel (ImmCLbl lbl))) (OpReg dst)
862 -- xorps, so we need the 128-bit constant
863 -- ToDo: rip-relative
866 return (Any F32 code)
868 getRegister (CmmMachOp (MO_S_Neg F64) [x]) = do
869 x_code <- getAnyReg x
870 lbl <- getNewLabelNat
872 -- This is how gcc does it, so it can't be that bad:
873 code dst = x_code dst `appOL` toOL [
874 LDATA ReadOnlyData16 [
877 CmmStaticLit (CmmInt 0x8000000000000000 I64),
878 CmmStaticLit (CmmInt 0 I64)
880 -- gcc puts an unpck here. Wonder if we need it.
881 XOR F64 (OpAddr (ripRel (ImmCLbl lbl))) (OpReg dst)
882 -- xorpd, so we need the 128-bit constant
885 return (Any F64 code)
888 #if i386_TARGET_ARCH || x86_64_TARGET_ARCH
890 getRegister (CmmMachOp mop [x]) -- unary MachOps
893 MO_S_Neg F32 -> trivialUFCode F32 (GNEG F32) x
894 MO_S_Neg F64 -> trivialUFCode F64 (GNEG F64) x
897 MO_S_Neg rep -> trivialUCode rep (NEGI rep) x
898 MO_Not rep -> trivialUCode rep (NOT rep) x
901 -- TODO: these are only nops if the arg is not a fixed register that
902 -- can't be byte-addressed.
903 MO_U_Conv I32 I8 -> conversionNop I32 x
904 MO_S_Conv I32 I8 -> conversionNop I32 x
905 MO_U_Conv I16 I8 -> conversionNop I16 x
906 MO_S_Conv I16 I8 -> conversionNop I16 x
907 MO_U_Conv I32 I16 -> conversionNop I32 x
908 MO_S_Conv I32 I16 -> conversionNop I32 x
909 #if x86_64_TARGET_ARCH
910 MO_U_Conv I64 I32 -> conversionNop I64 x
911 MO_S_Conv I64 I32 -> conversionNop I64 x
912 MO_U_Conv I64 I16 -> conversionNop I64 x
913 MO_S_Conv I64 I16 -> conversionNop I64 x
914 MO_U_Conv I64 I8 -> conversionNop I64 x
915 MO_S_Conv I64 I8 -> conversionNop I64 x
918 MO_U_Conv rep1 rep2 | rep1 == rep2 -> conversionNop rep1 x
919 MO_S_Conv rep1 rep2 | rep1 == rep2 -> conversionNop rep1 x
922 MO_U_Conv I8 I32 -> integerExtend I8 I32 MOVZxL x
923 MO_U_Conv I16 I32 -> integerExtend I16 I32 MOVZxL x
924 MO_U_Conv I8 I16 -> integerExtend I8 I16 MOVZxL x
926 MO_S_Conv I8 I32 -> integerExtend I8 I32 MOVSxL x
927 MO_S_Conv I16 I32 -> integerExtend I16 I32 MOVSxL x
928 MO_S_Conv I8 I16 -> integerExtend I8 I16 MOVSxL x
930 #if x86_64_TARGET_ARCH
931 MO_U_Conv I8 I64 -> integerExtend I8 I64 MOVZxL x
932 MO_U_Conv I16 I64 -> integerExtend I16 I64 MOVZxL x
933 MO_U_Conv I32 I64 -> integerExtend I32 I64 MOVZxL x
934 MO_S_Conv I8 I64 -> integerExtend I8 I64 MOVSxL x
935 MO_S_Conv I16 I64 -> integerExtend I16 I64 MOVSxL x
936 MO_S_Conv I32 I64 -> integerExtend I32 I64 MOVSxL x
937 -- for 32-to-64 bit zero extension, amd64 uses an ordinary movl.
938 -- However, we don't want the register allocator to throw it
939 -- away as an unnecessary reg-to-reg move, so we keep it in
940 -- the form of a movzl and print it as a movl later.
944 MO_S_Conv F32 F64 -> conversionNop F64 x
945 MO_S_Conv F64 F32 -> conversionNop F32 x
947 MO_S_Conv F32 F64 -> coerceFP2FP F64 x
948 MO_S_Conv F64 F32 -> coerceFP2FP F32 x
952 | isFloatingRep from -> coerceFP2Int from to x
953 | isFloatingRep to -> coerceInt2FP from to x
955 other -> pprPanic "getRegister" (pprMachOp mop)
957 -- signed or unsigned extension.
958 integerExtend from to instr expr = do
959 (reg,e_code) <- if from == I8 then getByteReg expr
964 instr from (OpReg reg) (OpReg dst)
967 conversionNop new_rep expr
968 = do e_code <- getRegister expr
969 return (swizzleRegisterRep e_code new_rep)
972 getRegister e@(CmmMachOp mop [x, y]) -- dyadic MachOps
973 = ASSERT2(cmmExprRep x /= I8, pprExpr e)
975 MO_Eq F32 -> condFltReg EQQ x y
976 MO_Ne F32 -> condFltReg NE x y
977 MO_S_Gt F32 -> condFltReg GTT x y
978 MO_S_Ge F32 -> condFltReg GE x y
979 MO_S_Lt F32 -> condFltReg LTT x y
980 MO_S_Le F32 -> condFltReg LE x y
982 MO_Eq F64 -> condFltReg EQQ x y
983 MO_Ne F64 -> condFltReg NE x y
984 MO_S_Gt F64 -> condFltReg GTT x y
985 MO_S_Ge F64 -> condFltReg GE x y
986 MO_S_Lt F64 -> condFltReg LTT x y
987 MO_S_Le F64 -> condFltReg LE x y
989 MO_Eq rep -> condIntReg EQQ x y
990 MO_Ne rep -> condIntReg NE x y
992 MO_S_Gt rep -> condIntReg GTT x y
993 MO_S_Ge rep -> condIntReg GE x y
994 MO_S_Lt rep -> condIntReg LTT x y
995 MO_S_Le rep -> condIntReg LE x y
997 MO_U_Gt rep -> condIntReg GU x y
998 MO_U_Ge rep -> condIntReg GEU x y
999 MO_U_Lt rep -> condIntReg LU x y
1000 MO_U_Le rep -> condIntReg LEU x y
1002 #if i386_TARGET_ARCH
1003 MO_Add F32 -> trivialFCode F32 GADD x y
1004 MO_Sub F32 -> trivialFCode F32 GSUB x y
1006 MO_Add F64 -> trivialFCode F64 GADD x y
1007 MO_Sub F64 -> trivialFCode F64 GSUB x y
1009 MO_S_Quot F32 -> trivialFCode F32 GDIV x y
1010 MO_S_Quot F64 -> trivialFCode F64 GDIV x y
1013 #if x86_64_TARGET_ARCH
1014 MO_Add F32 -> trivialFCode F32 ADD x y
1015 MO_Sub F32 -> trivialFCode F32 SUB x y
1017 MO_Add F64 -> trivialFCode F64 ADD x y
1018 MO_Sub F64 -> trivialFCode F64 SUB x y
1020 MO_S_Quot F32 -> trivialFCode F32 FDIV x y
1021 MO_S_Quot F64 -> trivialFCode F64 FDIV x y
1024 MO_Add rep -> add_code rep x y
1025 MO_Sub rep -> sub_code rep x y
1027 MO_S_Quot rep -> div_code rep True True x y
1028 MO_S_Rem rep -> div_code rep True False x y
1029 MO_U_Quot rep -> div_code rep False True x y
1030 MO_U_Rem rep -> div_code rep False False x y
1032 #if i386_TARGET_ARCH
1033 MO_Mul F32 -> trivialFCode F32 GMUL x y
1034 MO_Mul F64 -> trivialFCode F64 GMUL x y
1037 #if x86_64_TARGET_ARCH
1038 MO_Mul F32 -> trivialFCode F32 MUL x y
1039 MO_Mul F64 -> trivialFCode F64 MUL x y
1042 MO_Mul rep -> let op = IMUL rep in
1043 trivialCode rep op (Just op) x y
1045 MO_S_MulMayOflo rep -> imulMayOflo rep x y
1047 MO_And rep -> let op = AND rep in
1048 trivialCode rep op (Just op) x y
1049 MO_Or rep -> let op = OR rep in
1050 trivialCode rep op (Just op) x y
1051 MO_Xor rep -> let op = XOR rep in
1052 trivialCode rep op (Just op) x y
1054 {- Shift ops on x86s have constraints on their source, it
1055 either has to be Imm, CL or 1
1056 => trivialCode is not restrictive enough (sigh.)
1058 MO_Shl rep -> shift_code rep (SHL rep) x y {-False-}
1059 MO_U_Shr rep -> shift_code rep (SHR rep) x y {-False-}
1060 MO_S_Shr rep -> shift_code rep (SAR rep) x y {-False-}
1062 other -> pprPanic "getRegister(x86) - binary CmmMachOp (1)" (pprMachOp mop)
1064 --------------------
1065 imulMayOflo :: MachRep -> CmmExpr -> CmmExpr -> NatM Register
1066 imulMayOflo rep a b = do
1067 (a_reg, a_code) <- getNonClobberedReg a
1068 b_code <- getAnyReg b
1070 shift_amt = case rep of
1073 _ -> panic "shift_amt"
1075 code = a_code `appOL` b_code eax `appOL`
1077 IMUL2 rep (OpReg a_reg), -- result in %edx:%eax
1078 SAR rep (OpImm (ImmInt shift_amt)) (OpReg eax),
1079 -- sign extend lower part
1080 SUB rep (OpReg edx) (OpReg eax)
1081 -- compare against upper
1082 -- eax==0 if high part == sign extended low part
1085 return (Fixed rep eax code)
1087 --------------------
1088 shift_code :: MachRep
1089 -> (Operand -> Operand -> Instr)
1094 {- Case1: shift length as immediate -}
1095 shift_code rep instr x y@(CmmLit lit) = do
1096 x_code <- getAnyReg x
1099 = x_code dst `snocOL`
1100 instr (OpImm (litToImm lit)) (OpReg dst)
1102 return (Any rep code)
1104 {- Case2: shift length is complex (non-immediate) -}
1105 shift_code rep instr x y{-amount-} = do
1106 (x_reg, x_code) <- getNonClobberedReg x
1107 y_code <- getAnyReg y
1109 code = x_code `appOL`
1111 instr (OpReg ecx) (OpReg x_reg)
1113 return (Fixed rep x_reg code)
1115 --------------------
1116 add_code :: MachRep -> CmmExpr -> CmmExpr -> NatM Register
1117 add_code rep x (CmmLit (CmmInt y _))
1118 | not (is64BitInteger y) = add_int rep x y
1119 add_code rep x y = trivialCode rep (ADD rep) (Just (ADD rep)) x y
1121 --------------------
1122 sub_code :: MachRep -> CmmExpr -> CmmExpr -> NatM Register
1123 sub_code rep x (CmmLit (CmmInt y _))
1124 | not (is64BitInteger (-y)) = add_int rep x (-y)
1125 sub_code rep x y = trivialCode rep (SUB rep) Nothing x y
1127 -- our three-operand add instruction:
1128 add_int rep x y = do
1129 (x_reg, x_code) <- getSomeReg x
1131 imm = ImmInt (fromInteger y)
1135 (OpAddr (AddrBaseIndex (EABaseReg x_reg) EAIndexNone imm))
1138 return (Any rep code)
1140 ----------------------
1141 div_code rep signed quotient x y = do
1142 (y_op, y_code) <- getRegOrMem y -- cannot be clobbered
1143 x_code <- getAnyReg x
1145 widen | signed = CLTD rep
1146 | otherwise = XOR rep (OpReg edx) (OpReg edx)
1148 instr | signed = IDIV
1151 code = y_code `appOL`
1153 toOL [widen, instr rep y_op]
1155 result | quotient = eax
1159 return (Fixed rep result code)
1162 getRegister (CmmLoad mem pk)
1165 Amode src mem_code <- getAmode mem
1167 code dst = mem_code `snocOL`
1168 IF_ARCH_i386(GLD pk src dst,
1169 MOV pk (OpAddr src) (OpReg dst))
1171 return (Any pk code)
1173 #if i386_TARGET_ARCH
1174 getRegister (CmmLoad mem pk)
1177 code <- intLoadCode (instr pk) mem
1178 return (Any pk code)
1180 instr I8 = MOVZxL pk
1183 -- we always zero-extend 8-bit loads, if we
1184 -- can't think of anything better. This is because
1185 -- we can't guarantee access to an 8-bit variant of every register
1186 -- (esi and edi don't have 8-bit variants), so to make things
1187 -- simpler we do our 8-bit arithmetic with full 32-bit registers.
1190 #if x86_64_TARGET_ARCH
1191 -- Simpler memory load code on x86_64
1192 getRegister (CmmLoad mem pk)
1194 code <- intLoadCode (MOV pk) mem
1195 return (Any pk code)
1198 getRegister (CmmLit (CmmInt 0 rep))
1200 -- x86_64: 32-bit xor is one byte shorter, and zero-extends to 64 bits
1201 adj_rep = case rep of I64 -> I32; _ -> rep
1202 rep1 = IF_ARCH_i386( rep, adj_rep )
1204 = unitOL (XOR rep1 (OpReg dst) (OpReg dst))
1206 return (Any rep code)
1208 #if x86_64_TARGET_ARCH
1209 -- optimisation for loading small literals on x86_64: take advantage
1210 -- of the automatic zero-extension from 32 to 64 bits, because the 32-bit
1211 -- instruction forms are shorter.
1212 getRegister (CmmLit lit)
1213 | I64 <- cmmLitRep lit, not (isBigLit lit)
1216 code dst = unitOL (MOV I32 (OpImm imm) (OpReg dst))
1218 return (Any I64 code)
1220 isBigLit (CmmInt i I64) = i < 0 || i > 0xffffffff
1222 -- note1: not the same as is64BitLit, because that checks for
1223 -- signed literals that fit in 32 bits, but we want unsigned
1225 -- note2: all labels are small, because we're assuming the
1226 -- small memory model (see gcc docs, -mcmodel=small).
1229 getRegister (CmmLit lit)
1233 code dst = unitOL (MOV rep (OpImm imm) (OpReg dst))
1235 return (Any rep code)
1237 getRegister other = pprPanic "getRegister(x86)" (ppr other)
1240 intLoadCode :: (Operand -> Operand -> Instr) -> CmmExpr
1241 -> NatM (Reg -> InstrBlock)
1242 intLoadCode instr mem = do
1243 Amode src mem_code <- getAmode mem
1244 return (\dst -> mem_code `snocOL` instr (OpAddr src) (OpReg dst))
1246 -- Compute an expression into *any* register, adding the appropriate
1247 -- move instruction if necessary.
1248 getAnyReg :: CmmExpr -> NatM (Reg -> InstrBlock)
1250 r <- getRegister expr
1253 anyReg :: Register -> NatM (Reg -> InstrBlock)
1254 anyReg (Any _ code) = return code
1255 anyReg (Fixed rep reg fcode) = return (\dst -> fcode `snocOL` reg2reg rep reg dst)
1257 -- A bit like getSomeReg, but we want a reg that can be byte-addressed.
1258 -- Fixed registers might not be byte-addressable, so we make sure we've
1259 -- got a temporary, inserting an extra reg copy if necessary.
1260 getByteReg :: CmmExpr -> NatM (Reg, InstrBlock)
1261 #if x86_64_TARGET_ARCH
1262 getByteReg = getSomeReg -- all regs are byte-addressable on x86_64
1264 getByteReg expr = do
1265 r <- getRegister expr
1268 tmp <- getNewRegNat rep
1269 return (tmp, code tmp)
1271 | isVirtualReg reg -> return (reg,code)
1273 tmp <- getNewRegNat rep
1274 return (tmp, code `snocOL` reg2reg rep reg tmp)
1275 -- ToDo: could optimise slightly by checking for byte-addressable
1276 -- real registers, but that will happen very rarely if at all.
1279 -- Another variant: this time we want the result in a register that cannot
1280 -- be modified by code to evaluate an arbitrary expression.
1281 getNonClobberedReg :: CmmExpr -> NatM (Reg, InstrBlock)
1282 getNonClobberedReg expr = do
1283 r <- getRegister expr
1286 tmp <- getNewRegNat rep
1287 return (tmp, code tmp)
1289 -- only free regs can be clobbered
1290 | RealReg rr <- reg, isFastTrue (freeReg rr) -> do
1291 tmp <- getNewRegNat rep
1292 return (tmp, code `snocOL` reg2reg rep reg tmp)
1296 reg2reg :: MachRep -> Reg -> Reg -> Instr
1298 #if i386_TARGET_ARCH
1299 | isFloatingRep rep = GMOV src dst
1301 | otherwise = MOV rep (OpReg src) (OpReg dst)
1303 #endif /* i386_TARGET_ARCH || x86_64_TARGET_ARCH */
1305 -- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
1307 #if sparc_TARGET_ARCH
1309 getRegister (CmmLit (CmmFloat f F32)) = do
1310 lbl <- getNewLabelNat
1311 let code dst = toOL [
1314 CmmStaticLit (CmmFloat f F32)],
1315 SETHI (HI (ImmCLbl lbl)) dst,
1316 LD F32 (AddrRegImm dst (LO (ImmCLbl lbl))) dst]
1317 return (Any F32 code)
1319 getRegister (CmmLit (CmmFloat d F64)) = do
1320 lbl <- getNewLabelNat
1321 let code dst = toOL [
1324 CmmStaticLit (CmmFloat d F64)],
1325 SETHI (HI (ImmCLbl lbl)) dst,
1326 LD F64 (AddrRegImm dst (LO (ImmCLbl lbl))) dst]
1327 return (Any F64 code)
1329 getRegister (CmmMachOp mop [x]) -- unary MachOps
1331 MO_S_Neg F32 -> trivialUFCode F32 (FNEG F32) x
1332 MO_S_Neg F64 -> trivialUFCode F64 (FNEG F64) x
1334 MO_S_Neg rep -> trivialUCode rep (SUB False False g0) x
1335 MO_Not rep -> trivialUCode rep (XNOR False g0) x
1337 MO_U_Conv I32 I8 -> trivialCode I8 (AND False) x (CmmLit (CmmInt 255 I8))
1339 MO_U_Conv F64 F32-> coerceDbl2Flt x
1340 MO_U_Conv F32 F64-> coerceFlt2Dbl x
1342 MO_S_Conv F32 I32-> coerceFP2Int F32 I32 x
1343 MO_S_Conv I32 F32-> coerceInt2FP I32 F32 x
1344 MO_S_Conv F64 I32-> coerceFP2Int F64 I32 x
1345 MO_S_Conv I32 F64-> coerceInt2FP I32 F64 x
1347 -- Conversions which are a nop on sparc
1349 | from == to -> conversionNop to x
1350 MO_U_Conv I32 to -> conversionNop to x
1351 MO_S_Conv I32 to -> conversionNop to x
1354 MO_U_Conv I8 I32 -> integerExtend False I8 I32 x
1355 MO_U_Conv I16 I32 -> integerExtend False I16 I32 x
1356 MO_U_Conv I8 I16 -> integerExtend False I8 I16 x
1357 MO_S_Conv I16 I32 -> integerExtend True I16 I32 x
1359 other_op -> panic "Unknown unary mach op"
1362 integerExtend signed from to expr = do
1363 (reg, e_code) <- getSomeReg expr
1367 ((if signed then SRA else SRL)
1368 reg (RIImm (ImmInt 0)) dst)
1369 return (Any to code)
1370 conversionNop new_rep expr
1371 = do e_code <- getRegister expr
1372 return (swizzleRegisterRep e_code new_rep)
1374 getRegister (CmmMachOp mop [x, y]) -- dyadic PrimOps
1376 MO_Eq F32 -> condFltReg EQQ x y
1377 MO_Ne F32 -> condFltReg NE x y
1379 MO_S_Gt F32 -> condFltReg GTT x y
1380 MO_S_Ge F32 -> condFltReg GE x y
1381 MO_S_Lt F32 -> condFltReg LTT x y
1382 MO_S_Le F32 -> condFltReg LE x y
1384 MO_Eq F64 -> condFltReg EQQ x y
1385 MO_Ne F64 -> condFltReg NE x y
1387 MO_S_Gt F64 -> condFltReg GTT x y
1388 MO_S_Ge F64 -> condFltReg GE x y
1389 MO_S_Lt F64 -> condFltReg LTT x y
1390 MO_S_Le F64 -> condFltReg LE x y
1392 MO_Eq rep -> condIntReg EQQ x y
1393 MO_Ne rep -> condIntReg NE x y
1395 MO_S_Gt rep -> condIntReg GTT x y
1396 MO_S_Ge rep -> condIntReg GE x y
1397 MO_S_Lt rep -> condIntReg LTT x y
1398 MO_S_Le rep -> condIntReg LE x y
1400 MO_U_Gt I32 -> condIntReg GTT x y
1401 MO_U_Ge I32 -> condIntReg GE x y
1402 MO_U_Lt I32 -> condIntReg LTT x y
1403 MO_U_Le I32 -> condIntReg LE x y
1405 MO_U_Gt I16 -> condIntReg GU x y
1406 MO_U_Ge I16 -> condIntReg GEU x y
1407 MO_U_Lt I16 -> condIntReg LU x y
1408 MO_U_Le I16 -> condIntReg LEU x y
1410 MO_Add I32 -> trivialCode I32 (ADD False False) x y
1411 MO_Sub I32 -> trivialCode I32 (SUB False False) x y
1413 MO_S_MulMayOflo rep -> imulMayOflo rep x y
1415 -- ToDo: teach about V8+ SPARC div instructions
1416 MO_S_Quot I32 -> idiv FSLIT(".div") x y
1417 MO_S_Rem I32 -> idiv FSLIT(".rem") x y
1418 MO_U_Quot I32 -> idiv FSLIT(".udiv") x y
1419 MO_U_Rem I32 -> idiv FSLIT(".urem") x y
1421 MO_Add F32 -> trivialFCode F32 FADD x y
1422 MO_Sub F32 -> trivialFCode F32 FSUB x y
1423 MO_Mul F32 -> trivialFCode F32 FMUL x y
1424 MO_S_Quot F32 -> trivialFCode F32 FDIV x y
1426 MO_Add F64 -> trivialFCode F64 FADD x y
1427 MO_Sub F64 -> trivialFCode F64 FSUB x y
1428 MO_Mul F64 -> trivialFCode F64 FMUL x y
1429 MO_S_Quot F64 -> trivialFCode F64 FDIV x y
1431 MO_And rep -> trivialCode rep (AND False) x y
1432 MO_Or rep -> trivialCode rep (OR False) x y
1433 MO_Xor rep -> trivialCode rep (XOR False) x y
1435 MO_Mul rep -> trivialCode rep (SMUL False) x y
1437 MO_Shl rep -> trivialCode rep SLL x y
1438 MO_U_Shr rep -> trivialCode rep SRL x y
1439 MO_S_Shr rep -> trivialCode rep SRA x y
1442 MO_F32_Pwr -> getRegister (StCall (Left FSLIT("pow")) CCallConv F64
1443 [promote x, promote y])
1444 where promote x = CmmMachOp MO_F32_to_Dbl [x]
1445 MO_F64_Pwr -> getRegister (StCall (Left FSLIT("pow")) CCallConv F64
1448 other -> pprPanic "getRegister(sparc) - binary CmmMachOp (1)" (pprMachOp mop)
1450 --idiv fn x y = getRegister (StCall (Left fn) CCallConv I32 [x, y])
1452 --------------------
1453 imulMayOflo :: MachRep -> CmmExpr -> CmmExpr -> NatM Register
1454 imulMayOflo rep a b = do
1455 (a_reg, a_code) <- getSomeReg a
1456 (b_reg, b_code) <- getSomeReg b
1457 res_lo <- getNewRegNat I32
1458 res_hi <- getNewRegNat I32
1460 shift_amt = case rep of
1463 _ -> panic "shift_amt"
1464 code dst = a_code `appOL` b_code `appOL`
1466 SMUL False a_reg (RIReg b_reg) res_lo,
1468 SRA res_lo (RIImm (ImmInt shift_amt)) res_lo,
1469 SUB False False res_lo (RIReg res_hi) dst
1471 return (Any I32 code)
1473 getRegister (CmmLoad mem pk) = do
1474 Amode src code <- getAmode mem
1476 code__2 dst = code `snocOL` LD pk src dst
1477 return (Any pk code__2)
1479 getRegister (CmmLit (CmmInt i _))
1482 src = ImmInt (fromInteger i)
1483 code dst = unitOL (OR False g0 (RIImm src) dst)
1485 return (Any I32 code)
1487 getRegister (CmmLit lit)
1488 = let rep = cmmLitRep lit
1492 OR False dst (RIImm (LO imm)) dst]
1493 in return (Any I32 code)
1495 #endif /* sparc_TARGET_ARCH */
1497 #if powerpc_TARGET_ARCH
1498 getRegister (CmmLoad mem pk)
1501 Amode addr addr_code <- getAmode mem
1502 let code dst = ASSERT((regClass dst == RcDouble) == isFloatingRep pk)
1503 addr_code `snocOL` LD pk dst addr
1504 return (Any pk code)
1506 -- catch simple cases of zero- or sign-extended load
1507 getRegister (CmmMachOp (MO_U_Conv I8 I32) [CmmLoad mem _]) = do
1508 Amode addr addr_code <- getAmode mem
1509 return (Any I32 (\dst -> addr_code `snocOL` LD I8 dst addr))
1511 -- Note: there is no Load Byte Arithmetic instruction, so no signed case here
1513 getRegister (CmmMachOp (MO_U_Conv I16 I32) [CmmLoad mem _]) = do
1514 Amode addr addr_code <- getAmode mem
1515 return (Any I32 (\dst -> addr_code `snocOL` LD I16 dst addr))
1517 getRegister (CmmMachOp (MO_S_Conv I16 I32) [CmmLoad mem _]) = do
1518 Amode addr addr_code <- getAmode mem
1519 return (Any I32 (\dst -> addr_code `snocOL` LA I16 dst addr))
1521 getRegister (CmmMachOp mop [x]) -- unary MachOps
1523 MO_Not rep -> trivialUCode rep NOT x
1525 MO_S_Conv F64 F32 -> trivialUCode F32 FRSP x
1526 MO_S_Conv F32 F64 -> conversionNop F64 x
1529 | from == to -> conversionNop to x
1530 | isFloatingRep from -> coerceFP2Int from to x
1531 | isFloatingRep to -> coerceInt2FP from to x
1533 -- narrowing is a nop: we treat the high bits as undefined
1534 MO_S_Conv I32 to -> conversionNop to x
1535 MO_S_Conv I16 I8 -> conversionNop I8 x
1536 MO_S_Conv I8 to -> trivialUCode to (EXTS I8) x
1537 MO_S_Conv I16 to -> trivialUCode to (EXTS I16) x
1540 | from == to -> conversionNop to x
1541 -- narrowing is a nop: we treat the high bits as undefined
1542 MO_U_Conv I32 to -> conversionNop to x
1543 MO_U_Conv I16 I8 -> conversionNop I8 x
1544 MO_U_Conv I8 to -> trivialCode to False AND x (CmmLit (CmmInt 255 I32))
1545 MO_U_Conv I16 to -> trivialCode to False AND x (CmmLit (CmmInt 65535 I32))
1547 MO_S_Neg F32 -> trivialUCode F32 FNEG x
1548 MO_S_Neg F64 -> trivialUCode F64 FNEG x
1549 MO_S_Neg rep -> trivialUCode rep NEG x
1552 conversionNop new_rep expr
1553 = do e_code <- getRegister expr
1554 return (swizzleRegisterRep e_code new_rep)
1556 getRegister (CmmMachOp mop [x, y]) -- dyadic PrimOps
1558 MO_Eq F32 -> condFltReg EQQ x y
1559 MO_Ne F32 -> condFltReg NE x y
1561 MO_S_Gt F32 -> condFltReg GTT x y
1562 MO_S_Ge F32 -> condFltReg GE x y
1563 MO_S_Lt F32 -> condFltReg LTT x y
1564 MO_S_Le F32 -> condFltReg LE x y
1566 MO_Eq F64 -> condFltReg EQQ x y
1567 MO_Ne F64 -> condFltReg NE x y
1569 MO_S_Gt F64 -> condFltReg GTT x y
1570 MO_S_Ge F64 -> condFltReg GE x y
1571 MO_S_Lt F64 -> condFltReg LTT x y
1572 MO_S_Le F64 -> condFltReg LE x y
1574 MO_Eq rep -> condIntReg EQQ (extendUExpr rep x) (extendUExpr rep y)
1575 MO_Ne rep -> condIntReg NE (extendUExpr rep x) (extendUExpr rep y)
1577 MO_S_Gt rep -> condIntReg GTT (extendSExpr rep x) (extendSExpr rep y)
1578 MO_S_Ge rep -> condIntReg GE (extendSExpr rep x) (extendSExpr rep y)
1579 MO_S_Lt rep -> condIntReg LTT (extendSExpr rep x) (extendSExpr rep y)
1580 MO_S_Le rep -> condIntReg LE (extendSExpr rep x) (extendSExpr rep y)
1582 MO_U_Gt rep -> condIntReg GU (extendUExpr rep x) (extendUExpr rep y)
1583 MO_U_Ge rep -> condIntReg GEU (extendUExpr rep x) (extendUExpr rep y)
1584 MO_U_Lt rep -> condIntReg LU (extendUExpr rep x) (extendUExpr rep y)
1585 MO_U_Le rep -> condIntReg LEU (extendUExpr rep x) (extendUExpr rep y)
1587 MO_Add F32 -> trivialCodeNoImm F32 (FADD F32) x y
1588 MO_Sub F32 -> trivialCodeNoImm F32 (FSUB F32) x y
1589 MO_Mul F32 -> trivialCodeNoImm F32 (FMUL F32) x y
1590 MO_S_Quot F32 -> trivialCodeNoImm F32 (FDIV F32) x y
1592 MO_Add F64 -> trivialCodeNoImm F64 (FADD F64) x y
1593 MO_Sub F64 -> trivialCodeNoImm F64 (FSUB F64) x y
1594 MO_Mul F64 -> trivialCodeNoImm F64 (FMUL F64) x y
1595 MO_S_Quot F64 -> trivialCodeNoImm F64 (FDIV F64) x y
1597 -- optimize addition with 32-bit immediate
1601 CmmLit (CmmInt imm immrep) | Just _ <- makeImmediate I32 True (-imm)
1602 -> trivialCode I32 True ADD x (CmmLit $ CmmInt imm immrep)
1605 (src, srcCode) <- getSomeReg x
1606 let imm = litToImm lit
1607 code dst = srcCode `appOL` toOL [
1608 ADDIS dst src (HA imm),
1609 ADD dst dst (RIImm (LO imm))
1611 return (Any I32 code)
1612 _ -> trivialCode I32 True ADD x y
1614 MO_Add rep -> trivialCode rep True ADD x y
1616 case y of -- subfi ('substract from' with immediate) doesn't exist
1617 CmmLit (CmmInt imm immrep) | Just _ <- makeImmediate rep True (-imm)
1618 -> trivialCode rep True ADD x (CmmLit $ CmmInt (-imm) immrep)
1619 _ -> trivialCodeNoImm rep SUBF y x
1621 MO_Mul rep -> trivialCode rep True MULLW x y
1623 MO_S_MulMayOflo I32 -> trivialCodeNoImm I32 MULLW_MayOflo x y
1625 MO_S_MulMayOflo rep -> panic "S_MulMayOflo (rep /= I32): not implemented"
1626 MO_U_MulMayOflo rep -> panic "U_MulMayOflo: not implemented"
1628 MO_S_Quot rep -> trivialCodeNoImm rep DIVW (extendSExpr rep x) (extendSExpr rep y)
1629 MO_U_Quot rep -> trivialCodeNoImm rep DIVWU (extendUExpr rep x) (extendUExpr rep y)
1631 MO_S_Rem rep -> remainderCode rep DIVW (extendSExpr rep x) (extendSExpr rep y)
1632 MO_U_Rem rep -> remainderCode rep DIVWU (extendUExpr rep x) (extendUExpr rep y)
1634 MO_And rep -> trivialCode rep False AND x y
1635 MO_Or rep -> trivialCode rep False OR x y
1636 MO_Xor rep -> trivialCode rep False XOR x y
1638 MO_Shl rep -> trivialCode rep False SLW x y
1639 MO_S_Shr rep -> trivialCode rep False SRAW (extendSExpr rep x) y
1640 MO_U_Shr rep -> trivialCode rep False SRW (extendUExpr rep x) y
1642 getRegister (CmmLit (CmmInt i rep))
1643 | Just imm <- makeImmediate rep True i
1645 code dst = unitOL (LI dst imm)
1647 return (Any rep code)
1649 getRegister (CmmLit (CmmFloat f frep)) = do
1650 lbl <- getNewLabelNat
1651 dynRef <- cmmMakeDynamicReference addImportNat False lbl
1652 Amode addr addr_code <- getAmode dynRef
1654 LDATA ReadOnlyData [CmmDataLabel lbl,
1655 CmmStaticLit (CmmFloat f frep)]
1656 `consOL` (addr_code `snocOL` LD frep dst addr)
1657 return (Any frep code)
1659 getRegister (CmmLit lit)
1660 = let rep = cmmLitRep lit
1664 OR dst dst (RIImm (LO imm))
1666 in return (Any rep code)
1668 getRegister other = pprPanic "getRegister(ppc)" (pprExpr other)
1670 -- extend?Rep: wrap integer expression of type rep
1671 -- in a conversion to I32
1672 extendSExpr I32 x = x
1673 extendSExpr rep x = CmmMachOp (MO_S_Conv rep I32) [x]
1674 extendUExpr I32 x = x
1675 extendUExpr rep x = CmmMachOp (MO_U_Conv rep I32) [x]
1677 #endif /* powerpc_TARGET_ARCH */
1680 -- -----------------------------------------------------------------------------
1681 -- The 'Amode' type: Memory addressing modes passed up the tree.
1683 data Amode = Amode AddrMode InstrBlock
1686 Now, given a tree (the argument to an CmmLoad) that references memory,
1687 produce a suitable addressing mode.
1689 A Rule of the Game (tm) for Amodes: use of the addr bit must
1690 immediately follow use of the code part, since the code part puts
1691 values in registers which the addr then refers to. So you can't put
1692 anything in between, lest it overwrite some of those registers. If
1693 you need to do some other computation between the code part and use of
1694 the addr bit, first store the effective address from the amode in a
1695 temporary, then do the other computation, and then use the temporary:
1699 ... other computation ...
1703 getAmode :: CmmExpr -> NatM Amode
1704 getAmode tree@(CmmRegOff _ _) = getAmode (mangleIndexTree tree)
1706 -- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
1708 #if alpha_TARGET_ARCH
1710 getAmode (StPrim IntSubOp [x, StInt i])
1711 = getNewRegNat PtrRep `thenNat` \ tmp ->
1712 getRegister x `thenNat` \ register ->
1714 code = registerCode register tmp
1715 reg = registerName register tmp
1716 off = ImmInt (-(fromInteger i))
1718 return (Amode (AddrRegImm reg off) code)
1720 getAmode (StPrim IntAddOp [x, StInt i])
1721 = getNewRegNat PtrRep `thenNat` \ tmp ->
1722 getRegister x `thenNat` \ register ->
1724 code = registerCode register tmp
1725 reg = registerName register tmp
1726 off = ImmInt (fromInteger i)
1728 return (Amode (AddrRegImm reg off) code)
1732 = return (Amode (AddrImm imm__2) id)
1735 imm__2 = case imm of Just x -> x
1738 = getNewRegNat PtrRep `thenNat` \ tmp ->
1739 getRegister other `thenNat` \ register ->
1741 code = registerCode register tmp
1742 reg = registerName register tmp
1744 return (Amode (AddrReg reg) code)
1746 #endif /* alpha_TARGET_ARCH */
1748 -- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
1750 #if i386_TARGET_ARCH || x86_64_TARGET_ARCH
1752 -- This is all just ridiculous, since it carefully undoes
1753 -- what mangleIndexTree has just done.
1754 getAmode (CmmMachOp (MO_Sub 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 getAmode (CmmMachOp (MO_Add rep) [x, CmmLit lit@(CmmInt i _)])
1762 | not (is64BitLit lit)
1763 -- ASSERT(rep == I32)???
1764 = do (x_reg, x_code) <- getSomeReg x
1765 let off = ImmInt (fromInteger i)
1766 return (Amode (AddrBaseIndex (EABaseReg x_reg) EAIndexNone off) x_code)
1768 -- Turn (lit1 << n + lit2) into (lit2 + lit1 << n) so it will be
1769 -- recognised by the next rule.
1770 getAmode (CmmMachOp (MO_Add rep) [a@(CmmMachOp (MO_Shl _) _),
1772 = getAmode (CmmMachOp (MO_Add rep) [b,a])
1774 getAmode (CmmMachOp (MO_Add rep) [x, CmmMachOp (MO_Shl _)
1775 [y, CmmLit (CmmInt shift _)]])
1776 | shift == 0 || shift == 1 || shift == 2 || shift == 3
1777 = do (x_reg, x_code) <- getNonClobberedReg x
1778 -- x must be in a temp, because it has to stay live over y_code
1779 -- we could compre x_reg and y_reg and do something better here...
1780 (y_reg, y_code) <- getSomeReg y
1782 code = x_code `appOL` y_code
1783 base = case shift of 0 -> 1; 1 -> 2; 2 -> 4; 3 -> 8
1784 return (Amode (AddrBaseIndex (EABaseReg x_reg) (EAIndex y_reg base) (ImmInt 0))
1787 getAmode (CmmLit lit) | not (is64BitLit lit)
1788 = return (Amode (ImmAddr (litToImm lit) 0) nilOL)
1791 (reg,code) <- getSomeReg expr
1792 return (Amode (AddrBaseIndex (EABaseReg reg) EAIndexNone (ImmInt 0)) code)
1794 #endif /* i386_TARGET_ARCH || x86_64_TARGET_ARCH */
1796 -- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
1798 #if sparc_TARGET_ARCH
1800 getAmode (CmmMachOp (MO_Sub rep) [x, CmmLit (CmmInt i _)])
1803 (reg, code) <- getSomeReg x
1805 off = ImmInt (-(fromInteger i))
1806 return (Amode (AddrRegImm reg off) code)
1809 getAmode (CmmMachOp (MO_Add rep) [x, CmmLit (CmmInt i _)])
1812 (reg, code) <- getSomeReg x
1814 off = ImmInt (fromInteger i)
1815 return (Amode (AddrRegImm reg off) code)
1817 getAmode (CmmMachOp (MO_Add rep) [x, y])
1819 (regX, codeX) <- getSomeReg x
1820 (regY, codeY) <- getSomeReg y
1822 code = codeX `appOL` codeY
1823 return (Amode (AddrRegReg regX regY) code)
1825 -- XXX Is this same as "leaf" in Stix?
1826 getAmode (CmmLit lit)
1828 tmp <- getNewRegNat I32
1830 code = unitOL (SETHI (HI imm__2) tmp)
1831 return (Amode (AddrRegImm tmp (LO imm__2)) code)
1833 imm__2 = litToImm lit
1837 (reg, code) <- getSomeReg other
1840 return (Amode (AddrRegImm reg off) code)
1842 #endif /* sparc_TARGET_ARCH */
1844 #ifdef powerpc_TARGET_ARCH
1845 getAmode (CmmMachOp (MO_Sub I32) [x, CmmLit (CmmInt i _)])
1846 | Just off <- makeImmediate I32 True (-i)
1848 (reg, code) <- getSomeReg x
1849 return (Amode (AddrRegImm reg off) code)
1852 getAmode (CmmMachOp (MO_Add I32) [x, CmmLit (CmmInt i _)])
1853 | Just off <- makeImmediate I32 True i
1855 (reg, code) <- getSomeReg x
1856 return (Amode (AddrRegImm reg off) code)
1858 -- optimize addition with 32-bit immediate
1860 getAmode (CmmMachOp (MO_Add I32) [x, CmmLit lit])
1862 tmp <- getNewRegNat I32
1863 (src, srcCode) <- getSomeReg x
1864 let imm = litToImm lit
1865 code = srcCode `snocOL` ADDIS tmp src (HA imm)
1866 return (Amode (AddrRegImm tmp (LO imm)) code)
1868 getAmode (CmmLit lit)
1870 tmp <- getNewRegNat I32
1871 let imm = litToImm lit
1872 code = unitOL (LIS tmp (HA imm))
1873 return (Amode (AddrRegImm tmp (LO imm)) code)
1875 getAmode (CmmMachOp (MO_Add I32) [x, y])
1877 (regX, codeX) <- getSomeReg x
1878 (regY, codeY) <- getSomeReg y
1879 return (Amode (AddrRegReg regX regY) (codeX `appOL` codeY))
1883 (reg, code) <- getSomeReg other
1886 return (Amode (AddrRegImm reg off) code)
1887 #endif /* powerpc_TARGET_ARCH */
1889 -- -----------------------------------------------------------------------------
1890 -- getOperand: sometimes any operand will do.
1892 -- getNonClobberedOperand: the value of the operand will remain valid across
1893 -- the computation of an arbitrary expression, unless the expression
1894 -- is computed directly into a register which the operand refers to
1895 -- (see trivialCode where this function is used for an example).
1897 #if i386_TARGET_ARCH || x86_64_TARGET_ARCH
1899 getNonClobberedOperand :: CmmExpr -> NatM (Operand, InstrBlock)
1900 #if x86_64_TARGET_ARCH
1901 getNonClobberedOperand (CmmLit lit)
1902 | isSuitableFloatingPointLit lit = do
1903 lbl <- getNewLabelNat
1904 let code = unitOL (LDATA ReadOnlyData [CmmDataLabel lbl,
1906 return (OpAddr (ripRel (ImmCLbl lbl)), code)
1908 getNonClobberedOperand (CmmLit lit)
1909 | not (is64BitLit lit) && not (isFloatingRep (cmmLitRep lit)) =
1910 return (OpImm (litToImm lit), nilOL)
1911 getNonClobberedOperand (CmmLoad mem pk)
1912 | IF_ARCH_i386(not (isFloatingRep pk) && pk /= I64, True) = do
1913 Amode src mem_code <- getAmode mem
1915 if (amodeCouldBeClobbered src)
1917 tmp <- getNewRegNat wordRep
1918 return (AddrBaseIndex (EABaseReg tmp) EAIndexNone (ImmInt 0),
1919 unitOL (LEA I32 (OpAddr src) (OpReg tmp)))
1922 return (OpAddr src', save_code `appOL` mem_code)
1923 getNonClobberedOperand e = do
1924 (reg, code) <- getNonClobberedReg e
1925 return (OpReg reg, code)
1927 amodeCouldBeClobbered :: AddrMode -> Bool
1928 amodeCouldBeClobbered amode = any regClobbered (addrModeRegs amode)
1930 regClobbered (RealReg rr) = isFastTrue (freeReg rr)
1931 regClobbered _ = False
1933 -- getOperand: the operand is not required to remain valid across the
1934 -- computation of an arbitrary expression.
1935 getOperand :: CmmExpr -> NatM (Operand, InstrBlock)
1936 #if x86_64_TARGET_ARCH
1937 getOperand (CmmLit lit)
1938 | isSuitableFloatingPointLit lit = do
1939 lbl <- getNewLabelNat
1940 let code = unitOL (LDATA ReadOnlyData [CmmDataLabel lbl,
1942 return (OpAddr (ripRel (ImmCLbl lbl)), code)
1944 getOperand (CmmLit lit)
1945 | not (is64BitLit lit) && not (isFloatingRep (cmmLitRep lit)) = do
1946 return (OpImm (litToImm lit), nilOL)
1947 getOperand (CmmLoad mem pk)
1948 | IF_ARCH_i386(not (isFloatingRep pk) && pk /= I64, True) = do
1949 Amode src mem_code <- getAmode mem
1950 return (OpAddr src, mem_code)
1952 (reg, code) <- getSomeReg e
1953 return (OpReg reg, code)
1955 isOperand :: CmmExpr -> Bool
1956 isOperand (CmmLoad _ _) = True
1957 isOperand (CmmLit lit) = not (is64BitLit lit)
1958 || isSuitableFloatingPointLit lit
1961 -- if we want a floating-point literal as an operand, we can
1962 -- use it directly from memory. However, if the literal is
1963 -- zero, we're better off generating it into a register using
1965 isSuitableFloatingPointLit (CmmFloat f _) = f /= 0.0
1966 isSuitableFloatingPointLit _ = False
1968 getRegOrMem :: CmmExpr -> NatM (Operand, InstrBlock)
1969 getRegOrMem (CmmLoad mem pk)
1970 | IF_ARCH_i386(not (isFloatingRep pk) && pk /= I64, True) = do
1971 Amode src mem_code <- getAmode mem
1972 return (OpAddr src, mem_code)
1974 (reg, code) <- getNonClobberedReg e
1975 return (OpReg reg, code)
1977 #if x86_64_TARGET_ARCH
1978 is64BitLit (CmmInt i I64) = is64BitInteger i
1979 -- assume that labels are in the range 0-2^31-1: this assumes the
1980 -- small memory model (see gcc docs, -mcmodel=small).
1982 is64BitLit x = False
1985 is64BitInteger :: Integer -> Bool
1986 is64BitInteger i = i > 0x7fffffff || i < -0x80000000
1988 -- -----------------------------------------------------------------------------
1989 -- The 'CondCode' type: Condition codes passed up the tree.
1991 data CondCode = CondCode Bool Cond InstrBlock
1993 -- Set up a condition code for a conditional branch.
1995 getCondCode :: CmmExpr -> NatM CondCode
1997 -- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
1999 #if alpha_TARGET_ARCH
2000 getCondCode = panic "MachCode.getCondCode: not on Alphas"
2001 #endif /* alpha_TARGET_ARCH */
2003 -- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
2005 #if i386_TARGET_ARCH || x86_64_TARGET_ARCH || sparc_TARGET_ARCH
2006 -- yes, they really do seem to want exactly the same!
2008 getCondCode (CmmMachOp mop [x, y])
2009 = ASSERT (cmmExprRep x /= I8) -- tmp, not set up to handle 8-bit comparisons
2011 MO_Eq F32 -> condFltCode EQQ x y
2012 MO_Ne F32 -> condFltCode NE x y
2014 MO_S_Gt F32 -> condFltCode GTT x y
2015 MO_S_Ge F32 -> condFltCode GE x y
2016 MO_S_Lt F32 -> condFltCode LTT x y
2017 MO_S_Le F32 -> condFltCode LE x y
2019 MO_Eq F64 -> condFltCode EQQ x y
2020 MO_Ne F64 -> condFltCode NE x y
2022 MO_S_Gt F64 -> condFltCode GTT x y
2023 MO_S_Ge F64 -> condFltCode GE x y
2024 MO_S_Lt F64 -> condFltCode LTT x y
2025 MO_S_Le F64 -> condFltCode LE x y
2027 MO_Eq rep -> condIntCode EQQ x y
2028 MO_Ne rep -> condIntCode NE x y
2030 MO_S_Gt rep -> condIntCode GTT x y
2031 MO_S_Ge rep -> condIntCode GE x y
2032 MO_S_Lt rep -> condIntCode LTT x y
2033 MO_S_Le rep -> condIntCode LE x y
2035 MO_U_Gt rep -> condIntCode GU x y
2036 MO_U_Ge rep -> condIntCode GEU x y
2037 MO_U_Lt rep -> condIntCode LU x y
2038 MO_U_Le rep -> condIntCode LEU x y
2040 other -> pprPanic "getCondCode(x86,sparc)" (pprMachOp mop)
2042 getCondCode other = pprPanic "getCondCode(2)(x86,sparc)" (ppr other)
2044 #elif powerpc_TARGET_ARCH
2046 -- almost the same as everywhere else - but we need to
2047 -- extend small integers to 32 bit first
2049 getCondCode (CmmMachOp mop [x, y])
2051 MO_Eq F32 -> condFltCode EQQ x y
2052 MO_Ne F32 -> condFltCode NE x y
2054 MO_S_Gt F32 -> condFltCode GTT x y
2055 MO_S_Ge F32 -> condFltCode GE x y
2056 MO_S_Lt F32 -> condFltCode LTT x y
2057 MO_S_Le F32 -> condFltCode LE x y
2059 MO_Eq F64 -> condFltCode EQQ x y
2060 MO_Ne F64 -> condFltCode NE x y
2062 MO_S_Gt F64 -> condFltCode GTT x y
2063 MO_S_Ge F64 -> condFltCode GE x y
2064 MO_S_Lt F64 -> condFltCode LTT x y
2065 MO_S_Le F64 -> condFltCode LE x y
2067 MO_Eq rep -> condIntCode EQQ (extendUExpr rep x) (extendUExpr rep y)
2068 MO_Ne rep -> condIntCode NE (extendUExpr rep x) (extendUExpr rep y)
2070 MO_S_Gt rep -> condIntCode GTT (extendSExpr rep x) (extendSExpr rep y)
2071 MO_S_Ge rep -> condIntCode GE (extendSExpr rep x) (extendSExpr rep y)
2072 MO_S_Lt rep -> condIntCode LTT (extendSExpr rep x) (extendSExpr rep y)
2073 MO_S_Le rep -> condIntCode LE (extendSExpr rep x) (extendSExpr rep y)
2075 MO_U_Gt rep -> condIntCode GU (extendUExpr rep x) (extendUExpr rep y)
2076 MO_U_Ge rep -> condIntCode GEU (extendUExpr rep x) (extendUExpr rep y)
2077 MO_U_Lt rep -> condIntCode LU (extendUExpr rep x) (extendUExpr rep y)
2078 MO_U_Le rep -> condIntCode LEU (extendUExpr rep x) (extendUExpr rep y)
2080 other -> pprPanic "getCondCode(powerpc)" (pprMachOp mop)
2082 getCondCode other = panic "getCondCode(2)(powerpc)"
2088 -- @cond(Int|Flt)Code@: Turn a boolean expression into a condition, to be
2089 -- passed back up the tree.
2091 condIntCode, condFltCode :: Cond -> CmmExpr -> CmmExpr -> NatM CondCode
2093 #if alpha_TARGET_ARCH
2094 condIntCode = panic "MachCode.condIntCode: not on Alphas"
2095 condFltCode = panic "MachCode.condFltCode: not on Alphas"
2096 #endif /* alpha_TARGET_ARCH */
2098 -- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
2099 #if i386_TARGET_ARCH || x86_64_TARGET_ARCH
2101 -- memory vs immediate
2102 condIntCode cond (CmmLoad x pk) (CmmLit lit) | not (is64BitLit lit) = do
2103 Amode x_addr x_code <- getAmode x
2106 code = x_code `snocOL`
2107 CMP pk (OpImm imm) (OpAddr x_addr)
2109 return (CondCode False cond code)
2112 condIntCode cond x (CmmLit (CmmInt 0 pk)) = do
2113 (x_reg, x_code) <- getSomeReg x
2115 code = x_code `snocOL`
2116 TEST pk (OpReg x_reg) (OpReg x_reg)
2118 return (CondCode False cond code)
2120 -- anything vs operand
2121 condIntCode cond x y | isOperand y = do
2122 (x_reg, x_code) <- getNonClobberedReg x
2123 (y_op, y_code) <- getOperand y
2125 code = x_code `appOL` y_code `snocOL`
2126 CMP (cmmExprRep x) y_op (OpReg x_reg)
2128 return (CondCode False cond code)
2130 -- anything vs anything
2131 condIntCode cond x y = do
2132 (y_reg, y_code) <- getNonClobberedReg y
2133 (x_op, x_code) <- getRegOrMem x
2135 code = y_code `appOL`
2137 CMP (cmmExprRep x) (OpReg y_reg) x_op
2139 return (CondCode False cond code)
2142 #if i386_TARGET_ARCH
2143 condFltCode cond x y
2144 = ASSERT(cond `elem` ([EQQ, NE, LE, LTT, GE, GTT])) do
2145 (x_reg, x_code) <- getNonClobberedReg x
2146 (y_reg, y_code) <- getSomeReg y
2148 code = x_code `appOL` y_code `snocOL`
2149 GCMP cond x_reg y_reg
2150 -- The GCMP insn does the test and sets the zero flag if comparable
2151 -- and true. Hence we always supply EQQ as the condition to test.
2152 return (CondCode True EQQ code)
2153 #endif /* i386_TARGET_ARCH */
2155 #if x86_64_TARGET_ARCH
2156 -- in the SSE2 comparison ops (ucomiss, ucomisd) the left arg may be
2157 -- an operand, but the right must be a reg. We can probably do better
2158 -- than this general case...
2159 condFltCode cond x y = do
2160 (x_reg, x_code) <- getNonClobberedReg x
2161 (y_op, y_code) <- getOperand y
2163 code = x_code `appOL`
2165 CMP (cmmExprRep x) y_op (OpReg x_reg)
2166 -- NB(1): we need to use the unsigned comparison operators on the
2167 -- result of this comparison.
2169 return (CondCode True (condToUnsigned cond) code)
2172 -- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
2174 #if sparc_TARGET_ARCH
2176 condIntCode cond x (CmmLit (CmmInt y rep))
2179 (src1, code) <- getSomeReg x
2181 src2 = ImmInt (fromInteger y)
2182 code' = code `snocOL` SUB False True src1 (RIImm src2) g0
2183 return (CondCode False cond code')
2185 condIntCode cond x y = do
2186 (src1, code1) <- getSomeReg x
2187 (src2, code2) <- getSomeReg y
2189 code__2 = code1 `appOL` code2 `snocOL`
2190 SUB False True src1 (RIReg src2) g0
2191 return (CondCode False cond code__2)
2194 condFltCode cond x y = do
2195 (src1, code1) <- getSomeReg x
2196 (src2, code2) <- getSomeReg y
2197 tmp <- getNewRegNat F64
2199 promote x = FxTOy F32 F64 x tmp
2206 code1 `appOL` code2 `snocOL`
2207 FCMP True pk1 src1 src2
2208 else if pk1 == F32 then
2209 code1 `snocOL` promote src1 `appOL` code2 `snocOL`
2210 FCMP True F64 tmp src2
2212 code1 `appOL` code2 `snocOL` promote src2 `snocOL`
2213 FCMP True F64 src1 tmp
2214 return (CondCode True cond code__2)
2216 #endif /* sparc_TARGET_ARCH */
2218 #if powerpc_TARGET_ARCH
2219 -- ###FIXME: I16 and I8!
2220 condIntCode cond x (CmmLit (CmmInt y rep))
2221 | Just src2 <- makeImmediate rep (not $ condUnsigned cond) y
2223 (src1, code) <- getSomeReg x
2225 code' = code `snocOL`
2226 (if condUnsigned cond then CMPL else CMP) I32 src1 (RIImm src2)
2227 return (CondCode False cond code')
2229 condIntCode cond x y = do
2230 (src1, code1) <- getSomeReg x
2231 (src2, code2) <- getSomeReg y
2233 code' = code1 `appOL` code2 `snocOL`
2234 (if condUnsigned cond then CMPL else CMP) I32 src1 (RIReg src2)
2235 return (CondCode False cond code')
2237 condFltCode cond x y = do
2238 (src1, code1) <- getSomeReg x
2239 (src2, code2) <- getSomeReg y
2241 code' = code1 `appOL` code2 `snocOL` FCMP src1 src2
2242 code'' = case cond of -- twiddle CR to handle unordered case
2243 GE -> code' `snocOL` CRNOR ltbit eqbit gtbit
2244 LE -> code' `snocOL` CRNOR gtbit eqbit ltbit
2247 ltbit = 0 ; eqbit = 2 ; gtbit = 1
2248 return (CondCode True cond code'')
2250 #endif /* powerpc_TARGET_ARCH */
2252 -- -----------------------------------------------------------------------------
2253 -- Generating assignments
2255 -- Assignments are really at the heart of the whole code generation
2256 -- business. Almost all top-level nodes of any real importance are
2257 -- assignments, which correspond to loads, stores, or register
2258 -- transfers. If we're really lucky, some of the register transfers
2259 -- will go away, because we can use the destination register to
2260 -- complete the code generation for the right hand side. This only
2261 -- fails when the right hand side is forced into a fixed register
2262 -- (e.g. the result of a call).
2264 assignMem_IntCode :: MachRep -> CmmExpr -> CmmExpr -> NatM InstrBlock
2265 assignReg_IntCode :: MachRep -> CmmReg -> CmmExpr -> NatM InstrBlock
2267 assignMem_FltCode :: MachRep -> CmmExpr -> CmmExpr -> NatM InstrBlock
2268 assignReg_FltCode :: MachRep -> CmmReg -> CmmExpr -> NatM InstrBlock
2270 -- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
2272 #if alpha_TARGET_ARCH
2274 assignIntCode pk (CmmLoad dst _) src
2275 = getNewRegNat IntRep `thenNat` \ tmp ->
2276 getAmode dst `thenNat` \ amode ->
2277 getRegister src `thenNat` \ register ->
2279 code1 = amodeCode amode []
2280 dst__2 = amodeAddr amode
2281 code2 = registerCode register tmp []
2282 src__2 = registerName register tmp
2283 sz = primRepToSize pk
2284 code__2 = asmSeqThen [code1, code2] . mkSeqInstr (ST sz src__2 dst__2)
2288 assignIntCode pk dst src
2289 = getRegister dst `thenNat` \ register1 ->
2290 getRegister src `thenNat` \ register2 ->
2292 dst__2 = registerName register1 zeroh
2293 code = registerCode register2 dst__2
2294 src__2 = registerName register2 dst__2
2295 code__2 = if isFixed register2
2296 then code . mkSeqInstr (OR src__2 (RIReg src__2) dst__2)
2301 #endif /* alpha_TARGET_ARCH */
2303 -- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
2305 #if i386_TARGET_ARCH || x86_64_TARGET_ARCH
2307 -- integer assignment to memory
2308 assignMem_IntCode pk addr src = do
2309 Amode addr code_addr <- getAmode addr
2310 (code_src, op_src) <- get_op_RI src
2312 code = code_src `appOL`
2314 MOV pk op_src (OpAddr addr)
2315 -- NOTE: op_src is stable, so it will still be valid
2316 -- after code_addr. This may involve the introduction
2317 -- of an extra MOV to a temporary register, but we hope
2318 -- the register allocator will get rid of it.
2322 get_op_RI :: CmmExpr -> NatM (InstrBlock,Operand) -- code, operator
2323 get_op_RI (CmmLit lit) | not (is64BitLit lit)
2324 = return (nilOL, OpImm (litToImm lit))
2326 = do (reg,code) <- getNonClobberedReg op
2327 return (code, OpReg reg)
2330 -- Assign; dst is a reg, rhs is mem
2331 assignReg_IntCode pk reg (CmmLoad src _) = do
2332 load_code <- intLoadCode (MOV pk) src
2333 return (load_code (getRegisterReg reg))
2335 -- dst is a reg, but src could be anything
2336 assignReg_IntCode pk reg src = do
2337 code <- getAnyReg src
2338 return (code (getRegisterReg reg))
2340 #endif /* i386_TARGET_ARCH */
2342 -- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
2344 #if sparc_TARGET_ARCH
2346 assignMem_IntCode pk addr src = do
2347 (srcReg, code) <- getSomeReg src
2348 Amode dstAddr addr_code <- getAmode addr
2349 return $ code `appOL` addr_code `snocOL` ST pk srcReg dstAddr
2351 assignReg_IntCode pk reg src = do
2352 r <- getRegister src
2354 Any _ code -> code dst
2355 Fixed _ freg fcode -> fcode `snocOL` OR False g0 (RIReg dst) freg
2357 dst = getRegisterReg reg
2360 #endif /* sparc_TARGET_ARCH */
2362 #if powerpc_TARGET_ARCH
2364 assignMem_IntCode pk addr src = do
2365 (srcReg, code) <- getSomeReg src
2366 Amode dstAddr addr_code <- getAmode addr
2367 return $ code `appOL` addr_code `snocOL` ST pk srcReg dstAddr
2369 -- dst is a reg, but src could be anything
2370 assignReg_IntCode pk reg src
2372 r <- getRegister src
2374 Any _ code -> code dst
2375 Fixed _ freg fcode -> fcode `snocOL` MR dst freg
2377 dst = getRegisterReg reg
2379 #endif /* powerpc_TARGET_ARCH */
2382 -- -----------------------------------------------------------------------------
2383 -- Floating-point assignments
2385 #if alpha_TARGET_ARCH
2387 assignFltCode pk (CmmLoad dst _) src
2388 = getNewRegNat pk `thenNat` \ tmp ->
2389 getAmode dst `thenNat` \ amode ->
2390 getRegister src `thenNat` \ register ->
2392 code1 = amodeCode amode []
2393 dst__2 = amodeAddr amode
2394 code2 = registerCode register tmp []
2395 src__2 = registerName register tmp
2396 sz = primRepToSize pk
2397 code__2 = asmSeqThen [code1, code2] . mkSeqInstr (ST sz src__2 dst__2)
2401 assignFltCode pk dst src
2402 = getRegister dst `thenNat` \ register1 ->
2403 getRegister src `thenNat` \ register2 ->
2405 dst__2 = registerName register1 zeroh
2406 code = registerCode register2 dst__2
2407 src__2 = registerName register2 dst__2
2408 code__2 = if isFixed register2
2409 then code . mkSeqInstr (FMOV src__2 dst__2)
2414 #endif /* alpha_TARGET_ARCH */
2416 -- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
2418 #if i386_TARGET_ARCH || x86_64_TARGET_ARCH
2420 -- Floating point assignment to memory
2421 assignMem_FltCode pk addr src = do
2422 (src_reg, src_code) <- getNonClobberedReg src
2423 Amode addr addr_code <- getAmode addr
2425 code = src_code `appOL`
2427 IF_ARCH_i386(GST pk src_reg addr,
2428 MOV pk (OpReg src_reg) (OpAddr addr))
2431 -- Floating point assignment to a register/temporary
2432 assignReg_FltCode pk reg src = do
2433 src_code <- getAnyReg src
2434 return (src_code (getRegisterReg reg))
2436 #endif /* i386_TARGET_ARCH */
2438 -- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
2440 #if sparc_TARGET_ARCH
2442 -- Floating point assignment to memory
2443 assignMem_FltCode pk addr src = do
2444 Amode dst__2 code1 <- getAmode addr
2445 (src__2, code2) <- getSomeReg src
2446 tmp1 <- getNewRegNat pk
2448 pk__2 = cmmExprRep src
2449 code__2 = code1 `appOL` code2 `appOL`
2451 then unitOL (ST pk src__2 dst__2)
2452 else toOL [FxTOy pk__2 pk src__2 tmp1, ST pk tmp1 dst__2]
2455 -- Floating point assignment to a register/temporary
2456 -- ToDo: Verify correctness
2457 assignReg_FltCode pk reg src = do
2458 r <- getRegister src
2459 v1 <- getNewRegNat pk
2461 Any _ code -> code dst
2462 Fixed _ freg fcode -> fcode `snocOL` FMOV pk freg v1
2464 dst = getRegisterReg reg
2466 #endif /* sparc_TARGET_ARCH */
2468 #if powerpc_TARGET_ARCH
2471 assignMem_FltCode = assignMem_IntCode
2472 assignReg_FltCode = assignReg_IntCode
2474 #endif /* powerpc_TARGET_ARCH */
2477 -- -----------------------------------------------------------------------------
2478 -- Generating an non-local jump
2480 -- (If applicable) Do not fill the delay slots here; you will confuse the
2481 -- register allocator.
2483 genJump :: CmmExpr{-the branch target-} -> NatM InstrBlock
2485 -- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
2487 #if alpha_TARGET_ARCH
2489 genJump (CmmLabel lbl)
2490 | isAsmTemp lbl = returnInstr (BR target)
2491 | otherwise = returnInstrs [LDA pv (AddrImm target), JMP zeroh (AddrReg pv) 0]
2493 target = ImmCLbl lbl
2496 = getRegister tree `thenNat` \ register ->
2497 getNewRegNat PtrRep `thenNat` \ tmp ->
2499 dst = registerName register pv
2500 code = registerCode register pv
2501 target = registerName register pv
2503 if isFixed register then
2504 returnSeq code [OR dst (RIReg dst) pv, JMP zeroh (AddrReg pv) 0]
2506 return (code . mkSeqInstr (JMP zeroh (AddrReg pv) 0))
2508 #endif /* alpha_TARGET_ARCH */
2510 -- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
2512 #if i386_TARGET_ARCH || x86_64_TARGET_ARCH
2514 genJump (CmmLoad mem pk) = do
2515 Amode target code <- getAmode mem
2516 return (code `snocOL` JMP (OpAddr target))
2518 genJump (CmmLit lit) = do
2519 return (unitOL (JMP (OpImm (litToImm lit))))
2522 (reg,code) <- getSomeReg expr
2523 return (code `snocOL` JMP (OpReg reg))
2525 #endif /* i386_TARGET_ARCH */
2527 -- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
2529 #if sparc_TARGET_ARCH
2531 genJump (CmmLit (CmmLabel lbl))
2532 = return (toOL [CALL (Left target) 0 True, NOP])
2534 target = ImmCLbl lbl
2538 (target, code) <- getSomeReg tree
2539 return (code `snocOL` JMP (AddrRegReg target g0) `snocOL` NOP)
2541 #endif /* sparc_TARGET_ARCH */
2543 #if powerpc_TARGET_ARCH
2544 genJump (CmmLit (CmmLabel lbl))
2545 = return (unitOL $ JMP lbl)
2549 (target,code) <- getSomeReg tree
2550 return (code `snocOL` MTCTR target `snocOL` BCTR [])
2551 #endif /* powerpc_TARGET_ARCH */
2554 -- -----------------------------------------------------------------------------
2555 -- Unconditional branches
2557 genBranch :: BlockId -> NatM InstrBlock
2559 genBranch = return . toOL . mkBranchInstr
2561 -- -----------------------------------------------------------------------------
2562 -- Conditional jumps
2565 Conditional jumps are always to local labels, so we can use branch
2566 instructions. We peek at the arguments to decide what kind of
2569 ALPHA: For comparisons with 0, we're laughing, because we can just do
2570 the desired conditional branch.
2572 I386: First, we have to ensure that the condition
2573 codes are set according to the supplied comparison operation.
2575 SPARC: First, we have to ensure that the condition codes are set
2576 according to the supplied comparison operation. We generate slightly
2577 different code for floating point comparisons, because a floating
2578 point operation cannot directly precede a @BF@. We assume the worst
2579 and fill that slot with a @NOP@.
2581 SPARC: Do not fill the delay slots here; you will confuse the register
2587 :: BlockId -- the branch target
2588 -> CmmExpr -- the condition on which to branch
2591 -- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
2593 #if alpha_TARGET_ARCH
2595 genCondJump id (StPrim op [x, StInt 0])
2596 = getRegister x `thenNat` \ register ->
2597 getNewRegNat (registerRep register)
2600 code = registerCode register tmp
2601 value = registerName register tmp
2602 pk = registerRep register
2603 target = ImmCLbl lbl
2605 returnSeq code [BI (cmpOp op) value target]
2607 cmpOp CharGtOp = GTT
2609 cmpOp CharEqOp = EQQ
2611 cmpOp CharLtOp = LTT
2620 cmpOp WordGeOp = ALWAYS
2621 cmpOp WordEqOp = EQQ
2623 cmpOp WordLtOp = NEVER
2624 cmpOp WordLeOp = EQQ
2626 cmpOp AddrGeOp = ALWAYS
2627 cmpOp AddrEqOp = EQQ
2629 cmpOp AddrLtOp = NEVER
2630 cmpOp AddrLeOp = EQQ
2632 genCondJump lbl (StPrim op [x, StDouble 0.0])
2633 = getRegister x `thenNat` \ register ->
2634 getNewRegNat (registerRep register)
2637 code = registerCode register tmp
2638 value = registerName register tmp
2639 pk = registerRep register
2640 target = ImmCLbl lbl
2642 return (code . mkSeqInstr (BF (cmpOp op) value target))
2644 cmpOp FloatGtOp = GTT
2645 cmpOp FloatGeOp = GE
2646 cmpOp FloatEqOp = EQQ
2647 cmpOp FloatNeOp = NE
2648 cmpOp FloatLtOp = LTT
2649 cmpOp FloatLeOp = LE
2650 cmpOp DoubleGtOp = GTT
2651 cmpOp DoubleGeOp = GE
2652 cmpOp DoubleEqOp = EQQ
2653 cmpOp DoubleNeOp = NE
2654 cmpOp DoubleLtOp = LTT
2655 cmpOp DoubleLeOp = LE
2657 genCondJump lbl (StPrim op [x, y])
2659 = trivialFCode pr instr x y `thenNat` \ register ->
2660 getNewRegNat F64 `thenNat` \ tmp ->
2662 code = registerCode register tmp
2663 result = registerName register tmp
2664 target = ImmCLbl lbl
2666 return (code . mkSeqInstr (BF cond result target))
2668 pr = panic "trivialU?FCode: does not use PrimRep on Alpha"
2670 fltCmpOp op = case op of
2684 (instr, cond) = case op of
2685 FloatGtOp -> (FCMP TF LE, EQQ)
2686 FloatGeOp -> (FCMP TF LTT, EQQ)
2687 FloatEqOp -> (FCMP TF EQQ, NE)
2688 FloatNeOp -> (FCMP TF EQQ, EQQ)
2689 FloatLtOp -> (FCMP TF LTT, NE)
2690 FloatLeOp -> (FCMP TF LE, NE)
2691 DoubleGtOp -> (FCMP TF LE, EQQ)
2692 DoubleGeOp -> (FCMP TF LTT, EQQ)
2693 DoubleEqOp -> (FCMP TF EQQ, NE)
2694 DoubleNeOp -> (FCMP TF EQQ, EQQ)
2695 DoubleLtOp -> (FCMP TF LTT, NE)
2696 DoubleLeOp -> (FCMP TF LE, NE)
2698 genCondJump lbl (StPrim op [x, y])
2699 = trivialCode instr x y `thenNat` \ register ->
2700 getNewRegNat IntRep `thenNat` \ tmp ->
2702 code = registerCode register tmp
2703 result = registerName register tmp
2704 target = ImmCLbl lbl
2706 return (code . mkSeqInstr (BI cond result target))
2708 (instr, cond) = case op of
2709 CharGtOp -> (CMP LE, EQQ)
2710 CharGeOp -> (CMP LTT, EQQ)
2711 CharEqOp -> (CMP EQQ, NE)
2712 CharNeOp -> (CMP EQQ, EQQ)
2713 CharLtOp -> (CMP LTT, NE)
2714 CharLeOp -> (CMP LE, NE)
2715 IntGtOp -> (CMP LE, EQQ)
2716 IntGeOp -> (CMP LTT, EQQ)
2717 IntEqOp -> (CMP EQQ, NE)
2718 IntNeOp -> (CMP EQQ, EQQ)
2719 IntLtOp -> (CMP LTT, NE)
2720 IntLeOp -> (CMP LE, NE)
2721 WordGtOp -> (CMP ULE, EQQ)
2722 WordGeOp -> (CMP ULT, EQQ)
2723 WordEqOp -> (CMP EQQ, NE)
2724 WordNeOp -> (CMP EQQ, EQQ)
2725 WordLtOp -> (CMP ULT, NE)
2726 WordLeOp -> (CMP ULE, NE)
2727 AddrGtOp -> (CMP ULE, EQQ)
2728 AddrGeOp -> (CMP ULT, EQQ)
2729 AddrEqOp -> (CMP EQQ, NE)
2730 AddrNeOp -> (CMP EQQ, EQQ)
2731 AddrLtOp -> (CMP ULT, NE)
2732 AddrLeOp -> (CMP ULE, NE)
2734 #endif /* alpha_TARGET_ARCH */
2736 -- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
2738 #if i386_TARGET_ARCH
2740 genCondJump id bool = do
2741 CondCode _ cond code <- getCondCode bool
2742 return (code `snocOL` JXX cond id)
2746 -- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
2748 #if x86_64_TARGET_ARCH
2750 genCondJump id bool = do
2751 CondCode is_float cond cond_code <- getCondCode bool
2754 return (cond_code `snocOL` JXX cond id)
2756 lbl <- getBlockIdNat
2758 -- see comment with condFltReg
2759 let code = case cond of
2765 plain_test = unitOL (
2768 or_unordered = toOL [
2772 and_ordered = toOL [
2778 return (cond_code `appOL` code)
2782 -- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
2784 #if sparc_TARGET_ARCH
2786 genCondJump (BlockId id) bool = do
2787 CondCode is_float cond code <- getCondCode bool
2792 then [NOP, BF cond False (ImmCLbl (mkAsmTempLabel id)), NOP]
2793 else [BI cond False (ImmCLbl (mkAsmTempLabel id)), NOP]
2797 #endif /* sparc_TARGET_ARCH */
2800 #if powerpc_TARGET_ARCH
2802 genCondJump id bool = do
2803 CondCode is_float cond code <- getCondCode bool
2804 return (code `snocOL` BCC cond id)
2806 #endif /* powerpc_TARGET_ARCH */
2809 -- -----------------------------------------------------------------------------
2810 -- Generating C calls
2812 -- Now the biggest nightmare---calls. Most of the nastiness is buried in
2813 -- @get_arg@, which moves the arguments to the correct registers/stack
2814 -- locations. Apart from that, the code is easy.
2816 -- (If applicable) Do not fill the delay slots here; you will confuse the
2817 -- register allocator.
2820 :: CmmCallTarget -- function to call
2821 -> [(CmmReg,MachHint)] -- where to put the result
2822 -> [(CmmExpr,MachHint)] -- arguments (of mixed type)
2823 -> Maybe [GlobalReg] -- volatile regs to save
2826 -- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
2828 #if alpha_TARGET_ARCH
2832 genCCall fn cconv result_regs args
2833 = mapAccumLNat get_arg (allArgRegs, eXTRA_STK_ARGS_HERE) args
2834 `thenNat` \ ((unused,_), argCode) ->
2836 nRegs = length allArgRegs - length unused
2837 code = asmSeqThen (map ($ []) argCode)
2840 LDA pv (AddrImm (ImmLab (ptext fn))),
2841 JSR ra (AddrReg pv) nRegs,
2842 LDGP gp (AddrReg ra)]
2844 ------------------------
2845 {- Try to get a value into a specific register (or registers) for
2846 a call. The first 6 arguments go into the appropriate
2847 argument register (separate registers for integer and floating
2848 point arguments, but used in lock-step), and the remaining
2849 arguments are dumped to the stack, beginning at 0(sp). Our
2850 first argument is a pair of the list of remaining argument
2851 registers to be assigned for this call and the next stack
2852 offset to use for overflowing arguments. This way,
2853 @get_Arg@ can be applied to all of a call's arguments using
2857 :: ([(Reg,Reg)], Int) -- Argument registers and stack offset (accumulator)
2858 -> StixTree -- Current argument
2859 -> NatM (([(Reg,Reg)],Int), InstrBlock) -- Updated accumulator and code
2861 -- We have to use up all of our argument registers first...
2863 get_arg ((iDst,fDst):dsts, offset) arg
2864 = getRegister arg `thenNat` \ register ->
2866 reg = if isFloatingRep pk then fDst else iDst
2867 code = registerCode register reg
2868 src = registerName register reg
2869 pk = registerRep register
2872 if isFloatingRep pk then
2873 ((dsts, offset), if isFixed register then
2874 code . mkSeqInstr (FMOV src fDst)
2877 ((dsts, offset), if isFixed register then
2878 code . mkSeqInstr (OR src (RIReg src) iDst)
2881 -- Once we have run out of argument registers, we move to the
2884 get_arg ([], offset) arg
2885 = getRegister arg `thenNat` \ register ->
2886 getNewRegNat (registerRep register)
2889 code = registerCode register tmp
2890 src = registerName register tmp
2891 pk = registerRep register
2892 sz = primRepToSize pk
2894 return (([], offset + 1), code . mkSeqInstr (ST sz src (spRel offset)))
2896 #endif /* alpha_TARGET_ARCH */
2898 -- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
2900 #if i386_TARGET_ARCH
2902 -- we only cope with a single result for foreign calls
2903 genCCall (CmmPrim op) [(r,_)] args vols = do
2905 MO_F32_Sqrt -> actuallyInlineFloatOp F32 (GSQRT F32) args
2906 MO_F64_Sqrt -> actuallyInlineFloatOp F64 (GSQRT F64) args
2908 MO_F32_Sin -> actuallyInlineFloatOp F32 (GSIN F32) args
2909 MO_F64_Sin -> actuallyInlineFloatOp F64 (GSIN F64) args
2911 MO_F32_Cos -> actuallyInlineFloatOp F32 (GCOS F32) args
2912 MO_F64_Cos -> actuallyInlineFloatOp F64 (GCOS F64) args
2914 MO_F32_Tan -> actuallyInlineFloatOp F32 (GTAN F32) args
2915 MO_F64_Tan -> actuallyInlineFloatOp F64 (GTAN F64) args
2917 other_op -> outOfLineFloatOp op r args vols
2919 actuallyInlineFloatOp rep instr [(x,_)]
2920 = do res <- trivialUFCode rep instr x
2922 return (any (getRegisterReg r))
2924 genCCall target dest_regs args vols = do
2926 sizes = map (arg_size . cmmExprRep . fst) (reverse args)
2927 #if !darwin_TARGET_OS
2928 tot_arg_size = sum sizes
2930 raw_arg_size = sum sizes
2931 tot_arg_size = roundTo 16 raw_arg_size
2932 arg_pad_size = tot_arg_size - raw_arg_size
2933 delta0 <- getDeltaNat
2934 setDeltaNat (delta0 - arg_pad_size)
2937 push_codes <- mapM push_arg (reverse args)
2938 delta <- getDeltaNat
2941 -- deal with static vs dynamic call targets
2942 (callinsns,cconv) <-
2945 CmmForeignCall (CmmLit (CmmLabel lbl)) conv
2946 -> -- ToDo: stdcall arg sizes
2947 return (unitOL (CALL (Left fn_imm) []), conv)
2948 where fn_imm = ImmCLbl lbl
2949 CmmForeignCall expr conv
2950 -> do (dyn_c, dyn_r, dyn_rep) <- get_op expr
2951 ASSERT(dyn_rep == I32)
2952 return (dyn_c `snocOL` CALL (Right dyn_r) [], conv)
2955 #if darwin_TARGET_OS
2957 = toOL [SUB I32 (OpImm (ImmInt arg_pad_size)) (OpReg esp),
2958 DELTA (delta0 - arg_pad_size)]
2959 `appOL` concatOL push_codes
2962 = concatOL push_codes
2963 call = callinsns `appOL`
2965 -- Deallocate parameters after call for ccall;
2966 -- but not for stdcall (callee does it)
2967 (if cconv == StdCallConv || tot_arg_size==0 then [] else
2968 [ADD I32 (OpImm (ImmInt tot_arg_size)) (OpReg esp)])
2970 [DELTA (delta + tot_arg_size)]
2973 setDeltaNat (delta + tot_arg_size)
2976 -- assign the results, if necessary
2977 assign_code [] = nilOL
2978 assign_code [(dest,_hint)] =
2980 I64 -> toOL [MOV I32 (OpReg eax) (OpReg r_dest),
2981 MOV I32 (OpReg edx) (OpReg r_dest_hi)]
2982 F32 -> unitOL (GMOV fake0 r_dest)
2983 F64 -> unitOL (GMOV fake0 r_dest)
2984 rep -> unitOL (MOV rep (OpReg eax) (OpReg r_dest))
2986 r_dest_hi = getHiVRegFromLo r_dest
2987 rep = cmmRegRep dest
2988 r_dest = getRegisterReg dest
2989 assign_code many = panic "genCCall.assign_code many"
2991 return (push_code `appOL`
2993 assign_code dest_regs)
3001 roundTo a x | x `mod` a == 0 = x
3002 | otherwise = x + a - (x `mod` a)
3005 push_arg :: (CmmExpr,MachHint){-current argument-}
3006 -> NatM InstrBlock -- code
3008 push_arg (arg,_hint) -- we don't need the hints on x86
3009 | arg_rep == I64 = do
3010 ChildCode64 code r_lo <- iselExpr64 arg
3011 delta <- getDeltaNat
3012 setDeltaNat (delta - 8)
3014 r_hi = getHiVRegFromLo r_lo
3016 return ( code `appOL`
3017 toOL [PUSH I32 (OpReg r_hi), DELTA (delta - 4),
3018 PUSH I32 (OpReg r_lo), DELTA (delta - 8),
3023 (code, reg, sz) <- get_op arg
3024 delta <- getDeltaNat
3025 let size = arg_size sz
3026 setDeltaNat (delta-size)
3027 if (case sz of F64 -> True; F32 -> True; _ -> False)
3028 then return (code `appOL`
3029 toOL [SUB I32 (OpImm (ImmInt size)) (OpReg esp),
3031 GST sz reg (AddrBaseIndex (EABaseReg esp)
3035 else return (code `snocOL`
3036 PUSH I32 (OpReg reg) `snocOL`
3040 arg_rep = cmmExprRep arg
3043 get_op :: CmmExpr -> NatM (InstrBlock, Reg, MachRep) -- code, reg, size
3045 (reg,code) <- getSomeReg op
3046 return (code, reg, cmmExprRep op)
3048 #endif /* i386_TARGET_ARCH */
3050 #if i386_TARGET_ARCH || x86_64_TARGET_ARCH
3052 outOfLineFloatOp :: CallishMachOp -> CmmReg -> [(CmmExpr,MachHint)]
3053 -> Maybe [GlobalReg] -> NatM InstrBlock
3054 outOfLineFloatOp mop res args vols
3056 targetExpr <- cmmMakeDynamicReference addImportNat True lbl
3057 let target = CmmForeignCall targetExpr CCallConv
3059 if cmmRegRep res == F64
3061 stmtToInstrs (CmmCall target [(res,FloatHint)] args vols)
3065 tmp = CmmLocal (LocalReg uq F64)
3067 code1 <- stmtToInstrs (CmmCall target [(tmp,FloatHint)] args vols)
3068 code2 <- stmtToInstrs (CmmAssign res (CmmReg tmp))
3069 return (code1 `appOL` code2)
3071 lbl = mkForeignLabel fn Nothing True
3074 MO_F32_Sqrt -> FSLIT("sqrtf")
3075 MO_F32_Sin -> FSLIT("sinf")
3076 MO_F32_Cos -> FSLIT("cosf")
3077 MO_F32_Tan -> FSLIT("tanf")
3078 MO_F32_Exp -> FSLIT("expf")
3079 MO_F32_Log -> FSLIT("logf")
3081 MO_F32_Asin -> FSLIT("asinf")
3082 MO_F32_Acos -> FSLIT("acosf")
3083 MO_F32_Atan -> FSLIT("atanf")
3085 MO_F32_Sinh -> FSLIT("sinhf")
3086 MO_F32_Cosh -> FSLIT("coshf")
3087 MO_F32_Tanh -> FSLIT("tanhf")
3088 MO_F32_Pwr -> FSLIT("powf")
3090 MO_F64_Sqrt -> FSLIT("sqrt")
3091 MO_F64_Sin -> FSLIT("sin")
3092 MO_F64_Cos -> FSLIT("cos")
3093 MO_F64_Tan -> FSLIT("tan")
3094 MO_F64_Exp -> FSLIT("exp")
3095 MO_F64_Log -> FSLIT("log")
3097 MO_F64_Asin -> FSLIT("asin")
3098 MO_F64_Acos -> FSLIT("acos")
3099 MO_F64_Atan -> FSLIT("atan")
3101 MO_F64_Sinh -> FSLIT("sinh")
3102 MO_F64_Cosh -> FSLIT("cosh")
3103 MO_F64_Tanh -> FSLIT("tanh")
3104 MO_F64_Pwr -> FSLIT("pow")
3106 #endif /* i386_TARGET_ARCH || x86_64_TARGET_ARCH */
3108 -- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
3110 #if x86_64_TARGET_ARCH
3112 genCCall (CmmPrim op) [(r,_)] args vols =
3113 outOfLineFloatOp op r args vols
3115 genCCall target dest_regs args vols = do
3117 -- load up the register arguments
3118 (stack_args, aregs, fregs, load_args_code)
3119 <- load_args args allArgRegs allFPArgRegs nilOL
3122 fp_regs_used = reverse (drop (length fregs) (reverse allFPArgRegs))
3123 int_regs_used = reverse (drop (length aregs) (reverse allArgRegs))
3124 arg_regs = int_regs_used ++ fp_regs_used
3125 -- for annotating the call instruction with
3127 sse_regs = length fp_regs_used
3129 tot_arg_size = arg_size * length stack_args
3131 -- On entry to the called function, %rsp should be aligned
3132 -- on a 16-byte boundary +8 (i.e. the first stack arg after
3133 -- the return address is 16-byte aligned). In STG land
3134 -- %rsp is kept 16-byte aligned (see StgCRun.c), so we just
3135 -- need to make sure we push a multiple of 16-bytes of args,
3136 -- plus the return address, to get the correct alignment.
3137 -- Urg, this is hard. We need to feed the delta back into
3138 -- the arg pushing code.
3139 (real_size, adjust_rsp) <-
3140 if tot_arg_size `rem` 16 == 0
3141 then return (tot_arg_size, nilOL)
3142 else do -- we need to adjust...
3143 delta <- getDeltaNat
3144 setDeltaNat (delta-8)
3145 return (tot_arg_size+8, toOL [
3146 SUB I64 (OpImm (ImmInt 8)) (OpReg rsp),
3150 -- push the stack args, right to left
3151 push_code <- push_args (reverse stack_args) nilOL
3152 delta <- getDeltaNat
3154 -- deal with static vs dynamic call targets
3155 (callinsns,cconv) <-
3158 CmmForeignCall (CmmLit (CmmLabel lbl)) conv
3159 -> -- ToDo: stdcall arg sizes
3160 return (unitOL (CALL (Left fn_imm) arg_regs), conv)
3161 where fn_imm = ImmCLbl lbl
3162 CmmForeignCall expr conv
3163 -> do (dyn_r, dyn_c) <- getSomeReg expr
3164 return (dyn_c `snocOL` CALL (Right dyn_r) arg_regs, conv)
3167 -- The x86_64 ABI requires us to set %al to the number of SSE
3168 -- registers that contain arguments, if the called routine
3169 -- is a varargs function. We don't know whether it's a
3170 -- varargs function or not, so we have to assume it is.
3172 -- It's not safe to omit this assignment, even if the number
3173 -- of SSE regs in use is zero. If %al is larger than 8
3174 -- on entry to a varargs function, seg faults ensue.
3175 assign_eax n = unitOL (MOV I32 (OpImm (ImmInt n)) (OpReg eax))
3177 let call = callinsns `appOL`
3179 -- Deallocate parameters after call for ccall;
3180 -- but not for stdcall (callee does it)
3181 (if cconv == StdCallConv || real_size==0 then [] else
3182 [ADD wordRep (OpImm (ImmInt real_size)) (OpReg esp)])
3184 [DELTA (delta + real_size)]
3187 setDeltaNat (delta + real_size)
3190 -- assign the results, if necessary
3191 assign_code [] = nilOL
3192 assign_code [(dest,_hint)] =
3194 F32 -> unitOL (MOV rep (OpReg xmm0) (OpReg r_dest))
3195 F64 -> unitOL (MOV rep (OpReg xmm0) (OpReg r_dest))
3196 rep -> unitOL (MOV rep (OpReg rax) (OpReg r_dest))
3198 rep = cmmRegRep dest
3199 r_dest = getRegisterReg dest
3200 assign_code many = panic "genCCall.assign_code many"
3202 return (load_args_code `appOL`
3205 assign_eax sse_regs `appOL`
3207 assign_code dest_regs)
3210 arg_size = 8 -- always, at the mo
3212 load_args :: [(CmmExpr,MachHint)]
3213 -> [Reg] -- int regs avail for args
3214 -> [Reg] -- FP regs avail for args
3216 -> NatM ([(CmmExpr,MachHint)],[Reg],[Reg],InstrBlock)
3217 load_args args [] [] code = return (args, [], [], code)
3218 -- no more regs to use
3219 load_args [] aregs fregs code = return ([], aregs, fregs, code)
3220 -- no more args to push
3221 load_args ((arg,hint) : rest) aregs fregs code
3222 | isFloatingRep arg_rep =
3226 arg_code <- getAnyReg arg
3227 load_args rest aregs rs (code `appOL` arg_code r)
3232 arg_code <- getAnyReg arg
3233 load_args rest rs fregs (code `appOL` arg_code r)
3235 arg_rep = cmmExprRep arg
3238 (args',ars,frs,code') <- load_args rest aregs fregs code
3239 return ((arg,hint):args', ars, frs, code')
3241 push_args [] code = return code
3242 push_args ((arg,hint):rest) code
3243 | isFloatingRep arg_rep = do
3244 (arg_reg, arg_code) <- getSomeReg arg
3245 delta <- getDeltaNat
3246 setDeltaNat (delta-arg_size)
3247 let code' = code `appOL` toOL [
3248 MOV arg_rep (OpReg arg_reg) (OpAddr (spRel 0)),
3249 SUB wordRep (OpImm (ImmInt arg_size)) (OpReg rsp) ,
3250 DELTA (delta-arg_size)]
3251 push_args rest code'
3254 -- we only ever generate word-sized function arguments. Promotion
3255 -- has already happened: our Int8# type is kept sign-extended
3256 -- in an Int#, for example.
3257 ASSERT(arg_rep == I64) return ()
3258 (arg_op, arg_code) <- getOperand arg
3259 delta <- getDeltaNat
3260 setDeltaNat (delta-arg_size)
3261 let code' = code `appOL` toOL [PUSH I64 arg_op,
3262 DELTA (delta-arg_size)]
3263 push_args rest code'
3265 arg_rep = cmmExprRep arg
3268 -- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
3270 #if sparc_TARGET_ARCH
3272 The SPARC calling convention is an absolute
3273 nightmare. The first 6x32 bits of arguments are mapped into
3274 %o0 through %o5, and the remaining arguments are dumped to the
3275 stack, beginning at [%sp+92]. (Note that %o6 == %sp.)
3277 If we have to put args on the stack, move %o6==%sp down by
3278 the number of words to go on the stack, to ensure there's enough space.
3280 According to Fraser and Hanson's lcc book, page 478, fig 17.2,
3281 16 words above the stack pointer is a word for the address of
3282 a structure return value. I use this as a temporary location
3283 for moving values from float to int regs. Certainly it isn't
3284 safe to put anything in the 16 words starting at %sp, since
3285 this area can get trashed at any time due to window overflows
3286 caused by signal handlers.
3288 A final complication (if the above isn't enough) is that
3289 we can't blithely calculate the arguments one by one into
3290 %o0 .. %o5. Consider the following nested calls:
3294 Naive code moves a into %o0, and (fff b c) into %o1. Unfortunately
3295 the inner call will itself use %o0, which trashes the value put there
3296 in preparation for the outer call. Upshot: we need to calculate the
3297 args into temporary regs, and move those to arg regs or onto the
3298 stack only immediately prior to the call proper. Sigh.
3301 genCCall target dest_regs argsAndHints vols = do
3303 args = map fst argsAndHints
3304 argcode_and_vregs <- mapM arg_to_int_vregs args
3306 (argcodes, vregss) = unzip argcode_and_vregs
3307 n_argRegs = length allArgRegs
3308 n_argRegs_used = min (length vregs) n_argRegs
3309 vregs = concat vregss
3310 -- deal with static vs dynamic call targets
3311 callinsns <- (case target of
3312 CmmForeignCall (CmmLit (CmmLabel lbl)) conv -> do
3313 return (unitOL (CALL (Left (litToImm (CmmLabel lbl))) n_argRegs_used False))
3314 CmmForeignCall expr conv -> do
3315 (dyn_c, [dyn_r]) <- arg_to_int_vregs expr
3316 return (dyn_c `snocOL` CALL (Right dyn_r) n_argRegs_used False)
3318 (res, reduce) <- outOfLineFloatOp mop
3319 lblOrMopExpr <- case res of
3321 return (unitOL (CALL (Left (litToImm (CmmLabel lbl))) n_argRegs_used False))
3323 (dyn_c, [dyn_r]) <- arg_to_int_vregs mopExpr
3324 return (dyn_c `snocOL` CALL (Right dyn_r) n_argRegs_used False)
3325 if reduce then panic "genCCall(sparc): can not reduce" else return lblOrMopExpr
3329 argcode = concatOL argcodes
3330 (move_sp_down, move_sp_up)
3331 = let diff = length vregs - n_argRegs
3332 nn = if odd diff then diff + 1 else diff -- keep 8-byte alignment
3335 else (unitOL (moveSp (-1*nn)), unitOL (moveSp (1*nn)))
3337 = toOL (move_final vregs allArgRegs eXTRA_STK_ARGS_HERE)
3338 return (argcode `appOL`
3339 move_sp_down `appOL`
3340 transfer_code `appOL`
3345 -- move args from the integer vregs into which they have been
3346 -- marshalled, into %o0 .. %o5, and the rest onto the stack.
3347 move_final :: [Reg] -> [Reg] -> Int -> [Instr]
3349 move_final [] _ offset -- all args done
3352 move_final (v:vs) [] offset -- out of aregs; move to stack
3353 = ST I32 v (spRel offset)
3354 : move_final vs [] (offset+1)
3356 move_final (v:vs) (a:az) offset -- move into an arg (%o[0..5]) reg
3357 = OR False g0 (RIReg v) a
3358 : move_final vs az offset
3360 -- generate code to calculate an argument, and move it into one
3361 -- or two integer vregs.
3362 arg_to_int_vregs :: CmmExpr -> NatM (OrdList Instr, [Reg])
3363 arg_to_int_vregs arg
3364 | (cmmExprRep arg) == I64
3366 (ChildCode64 code r_lo) <- iselExpr64 arg
3368 r_hi = getHiVRegFromLo r_lo
3369 return (code, [r_hi, r_lo])
3372 (src, code) <- getSomeReg arg
3373 tmp <- getNewRegNat (cmmExprRep arg)
3378 v1 <- getNewRegNat I32
3379 v2 <- getNewRegNat I32
3382 FMOV F64 src f0 `snocOL`
3383 ST F32 f0 (spRel 16) `snocOL`
3384 LD I32 (spRel 16) v1 `snocOL`
3385 ST F32 (fPair f0) (spRel 16) `snocOL`
3386 LD I32 (spRel 16) v2
3391 v1 <- getNewRegNat I32
3394 ST F32 src (spRel 16) `snocOL`
3395 LD I32 (spRel 16) v1
3400 v1 <- getNewRegNat I32
3402 code `snocOL` OR False g0 (RIReg src) v1
3406 outOfLineFloatOp mop =
3408 mopExpr <- cmmMakeDynamicReference addImportNat True $
3409 mkForeignLabel functionName Nothing True
3410 let mopLabelOrExpr = case mopExpr of
3411 CmmLit (CmmLabel lbl) -> Left lbl
3413 return (mopLabelOrExpr, reduce)
3415 (reduce, functionName) = case mop of
3416 MO_F32_Exp -> (True, FSLIT("exp"))
3417 MO_F32_Log -> (True, FSLIT("log"))
3418 MO_F32_Sqrt -> (True, FSLIT("sqrt"))
3420 MO_F32_Sin -> (True, FSLIT("sin"))
3421 MO_F32_Cos -> (True, FSLIT("cos"))
3422 MO_F32_Tan -> (True, FSLIT("tan"))
3424 MO_F32_Asin -> (True, FSLIT("asin"))
3425 MO_F32_Acos -> (True, FSLIT("acos"))
3426 MO_F32_Atan -> (True, FSLIT("atan"))
3428 MO_F32_Sinh -> (True, FSLIT("sinh"))
3429 MO_F32_Cosh -> (True, FSLIT("cosh"))
3430 MO_F32_Tanh -> (True, FSLIT("tanh"))
3432 MO_F64_Exp -> (False, FSLIT("exp"))
3433 MO_F64_Log -> (False, FSLIT("log"))
3434 MO_F64_Sqrt -> (False, FSLIT("sqrt"))
3436 MO_F64_Sin -> (False, FSLIT("sin"))
3437 MO_F64_Cos -> (False, FSLIT("cos"))
3438 MO_F64_Tan -> (False, FSLIT("tan"))
3440 MO_F64_Asin -> (False, FSLIT("asin"))
3441 MO_F64_Acos -> (False, FSLIT("acos"))
3442 MO_F64_Atan -> (False, FSLIT("atan"))
3444 MO_F64_Sinh -> (False, FSLIT("sinh"))
3445 MO_F64_Cosh -> (False, FSLIT("cosh"))
3446 MO_F64_Tanh -> (False, FSLIT("tanh"))
3448 other -> pprPanic "outOfLineFloatOp(sparc) "
3449 (pprCallishMachOp mop)
3451 #endif /* sparc_TARGET_ARCH */
3453 #if powerpc_TARGET_ARCH
3455 #if darwin_TARGET_OS || linux_TARGET_OS
3457 The PowerPC calling convention for Darwin/Mac OS X
3458 is described in Apple's document
3459 "Inside Mac OS X - Mach-O Runtime Architecture".
3461 PowerPC Linux uses the System V Release 4 Calling Convention
3462 for PowerPC. It is described in the
3463 "System V Application Binary Interface PowerPC Processor Supplement".
3465 Both conventions are similar:
3466 Parameters may be passed in general-purpose registers starting at r3, in
3467 floating point registers starting at f1, or on the stack.
3469 But there are substantial differences:
3470 * The number of registers used for parameter passing and the exact set of
3471 nonvolatile registers differs (see MachRegs.lhs).
3472 * On Darwin, stack space is always reserved for parameters, even if they are
3473 passed in registers. The called routine may choose to save parameters from
3474 registers to the corresponding space on the stack.
3475 * On Darwin, a corresponding amount of GPRs is skipped when a floating point
3476 parameter is passed in an FPR.
3477 * SysV insists on either passing I64 arguments on the stack, or in two GPRs,
3478 starting with an odd-numbered GPR. It may skip a GPR to achieve this.
3479 Darwin just treats an I64 like two separate I32s (high word first).
3480 * I64 and F64 arguments are 8-byte aligned on the stack for SysV, but only
3481 4-byte aligned like everything else on Darwin.
3482 * The SysV spec claims that F32 is represented as F64 on the stack. GCC on
3483 PowerPC Linux does not agree, so neither do we.
3485 According to both conventions, The parameter area should be part of the
3486 caller's stack frame, allocated in the caller's prologue code (large enough
3487 to hold the parameter lists for all called routines). The NCG already
3488 uses the stack for register spilling, leaving 64 bytes free at the top.
3489 If we need a larger parameter area than that, we just allocate a new stack
3490 frame just before ccalling.
3493 genCCall target dest_regs argsAndHints vols
3494 = ASSERT (not $ any (`elem` [I8,I16]) argReps)
3495 -- we rely on argument promotion in the codeGen
3497 (finalStack,passArgumentsCode,usedRegs) <- passArguments
3499 allArgRegs allFPArgRegs
3503 (labelOrExpr, reduceToF32) <- case target of
3504 CmmForeignCall (CmmLit (CmmLabel lbl)) conv -> return (Left lbl, False)
3505 CmmForeignCall expr conv -> return (Right expr, False)
3506 CmmPrim mop -> outOfLineFloatOp mop
3508 let codeBefore = move_sp_down finalStack `appOL` passArgumentsCode
3509 codeAfter = move_sp_up finalStack `appOL` moveResult reduceToF32
3514 `snocOL` BL lbl usedRegs
3517 (dynReg, dynCode) <- getSomeReg dyn
3519 `snocOL` MTCTR dynReg
3521 `snocOL` BCTRL usedRegs
3524 #if darwin_TARGET_OS
3525 initialStackOffset = 24
3526 -- size of linkage area + size of arguments, in bytes
3527 stackDelta _finalStack = roundTo 16 $ (24 +) $ max 32 $ sum $
3528 map machRepByteWidth argReps
3529 #elif linux_TARGET_OS
3530 initialStackOffset = 8
3531 stackDelta finalStack = roundTo 16 finalStack
3533 args = map fst argsAndHints
3534 argReps = map cmmExprRep args
3536 roundTo a x | x `mod` a == 0 = x
3537 | otherwise = x + a - (x `mod` a)
3539 move_sp_down finalStack
3541 toOL [STU I32 sp (AddrRegImm sp (ImmInt (-delta))),
3544 where delta = stackDelta finalStack
3545 move_sp_up finalStack
3547 toOL [ADD sp sp (RIImm (ImmInt delta)),
3550 where delta = stackDelta finalStack
3553 passArguments [] _ _ stackOffset accumCode accumUsed = return (stackOffset, accumCode, accumUsed)
3554 passArguments ((arg,I64):args) gprs fprs stackOffset
3555 accumCode accumUsed =
3557 ChildCode64 code vr_lo <- iselExpr64 arg
3558 let vr_hi = getHiVRegFromLo vr_lo
3560 #if darwin_TARGET_OS
3565 (accumCode `appOL` code
3566 `snocOL` storeWord vr_hi gprs stackOffset
3567 `snocOL` storeWord vr_lo (drop 1 gprs) (stackOffset+4))
3568 ((take 2 gprs) ++ accumUsed)
3570 storeWord vr (gpr:_) offset = MR gpr vr
3571 storeWord vr [] offset = ST I32 vr (AddrRegImm sp (ImmInt offset))
3573 #elif linux_TARGET_OS
3574 let stackOffset' = roundTo 8 stackOffset
3575 stackCode = accumCode `appOL` code
3576 `snocOL` ST I32 vr_hi (AddrRegImm sp (ImmInt stackOffset'))
3577 `snocOL` ST I32 vr_lo (AddrRegImm sp (ImmInt (stackOffset'+4)))
3578 regCode hireg loreg =
3579 accumCode `appOL` code
3580 `snocOL` MR hireg vr_hi
3581 `snocOL` MR loreg vr_lo
3584 hireg : loreg : regs | even (length gprs) ->
3585 passArguments args regs fprs stackOffset
3586 (regCode hireg loreg) (hireg : loreg : accumUsed)
3587 _skipped : hireg : loreg : regs ->
3588 passArguments args regs fprs stackOffset
3589 (regCode hireg loreg) (hireg : loreg : accumUsed)
3590 _ -> -- only one or no regs left
3591 passArguments args [] fprs (stackOffset'+8)
3595 passArguments ((arg,rep):args) gprs fprs stackOffset accumCode accumUsed
3596 | reg : _ <- regs = do
3597 register <- getRegister arg
3598 let code = case register of
3599 Fixed _ freg fcode -> fcode `snocOL` MR reg freg
3600 Any _ acode -> acode reg
3604 #if darwin_TARGET_OS
3605 -- The Darwin ABI requires that we reserve stack slots for register parameters
3606 (stackOffset + stackBytes)
3607 #elif linux_TARGET_OS
3608 -- ... the SysV ABI doesn't.
3611 (accumCode `appOL` code)
3614 (vr, code) <- getSomeReg arg
3618 (stackOffset' + stackBytes)
3619 (accumCode `appOL` code `snocOL` ST rep vr stackSlot)
3622 #if darwin_TARGET_OS
3623 -- stackOffset is at least 4-byte aligned
3624 -- The Darwin ABI is happy with that.
3625 stackOffset' = stackOffset
3627 -- ... the SysV ABI requires 8-byte alignment for doubles.
3628 stackOffset' | rep == F64 = roundTo 8 stackOffset
3629 | otherwise = stackOffset
3631 stackSlot = AddrRegImm sp (ImmInt stackOffset')
3632 (nGprs, nFprs, stackBytes, regs) = case rep of
3633 I32 -> (1, 0, 4, gprs)
3634 #if darwin_TARGET_OS
3635 -- The Darwin ABI requires that we skip a corresponding number of GPRs when
3637 F32 -> (1, 1, 4, fprs)
3638 F64 -> (2, 1, 8, fprs)
3639 #elif linux_TARGET_OS
3640 -- ... the SysV ABI doesn't.
3641 F32 -> (0, 1, 4, fprs)
3642 F64 -> (0, 1, 8, fprs)
3645 moveResult reduceToF32 =
3649 | reduceToF32 && rep == F32 -> unitOL (FRSP r_dest f1)
3650 | rep == F32 || rep == F64 -> unitOL (MR r_dest f1)
3651 | rep == I64 -> toOL [MR (getHiVRegFromLo r_dest) r3,
3653 | otherwise -> unitOL (MR r_dest r3)
3654 where rep = cmmRegRep dest
3655 r_dest = getRegisterReg dest
3657 outOfLineFloatOp mop =
3659 mopExpr <- cmmMakeDynamicReference addImportNat True $
3660 mkForeignLabel functionName Nothing True
3661 let mopLabelOrExpr = case mopExpr of
3662 CmmLit (CmmLabel lbl) -> Left lbl
3664 return (mopLabelOrExpr, reduce)
3666 (functionName, reduce) = case mop of
3667 MO_F32_Exp -> (FSLIT("exp"), True)
3668 MO_F32_Log -> (FSLIT("log"), True)
3669 MO_F32_Sqrt -> (FSLIT("sqrt"), True)
3671 MO_F32_Sin -> (FSLIT("sin"), True)
3672 MO_F32_Cos -> (FSLIT("cos"), True)
3673 MO_F32_Tan -> (FSLIT("tan"), True)
3675 MO_F32_Asin -> (FSLIT("asin"), True)
3676 MO_F32_Acos -> (FSLIT("acos"), True)
3677 MO_F32_Atan -> (FSLIT("atan"), True)
3679 MO_F32_Sinh -> (FSLIT("sinh"), True)
3680 MO_F32_Cosh -> (FSLIT("cosh"), True)
3681 MO_F32_Tanh -> (FSLIT("tanh"), True)
3682 MO_F32_Pwr -> (FSLIT("pow"), True)
3684 MO_F64_Exp -> (FSLIT("exp"), False)
3685 MO_F64_Log -> (FSLIT("log"), False)
3686 MO_F64_Sqrt -> (FSLIT("sqrt"), False)
3688 MO_F64_Sin -> (FSLIT("sin"), False)
3689 MO_F64_Cos -> (FSLIT("cos"), False)
3690 MO_F64_Tan -> (FSLIT("tan"), False)
3692 MO_F64_Asin -> (FSLIT("asin"), False)
3693 MO_F64_Acos -> (FSLIT("acos"), False)
3694 MO_F64_Atan -> (FSLIT("atan"), False)
3696 MO_F64_Sinh -> (FSLIT("sinh"), False)
3697 MO_F64_Cosh -> (FSLIT("cosh"), False)
3698 MO_F64_Tanh -> (FSLIT("tanh"), False)
3699 MO_F64_Pwr -> (FSLIT("pow"), False)
3700 other -> pprPanic "genCCall(ppc): unknown callish op"
3701 (pprCallishMachOp other)
3703 #endif /* darwin_TARGET_OS || linux_TARGET_OS */
3705 #endif /* powerpc_TARGET_ARCH */
3708 -- -----------------------------------------------------------------------------
3709 -- Generating a table-branch
3711 genSwitch :: CmmExpr -> [Maybe BlockId] -> NatM InstrBlock
3713 #if i386_TARGET_ARCH || x86_64_TARGET_ARCH
3717 (reg,e_code) <- getSomeReg expr
3718 lbl <- getNewLabelNat
3719 dynRef <- cmmMakeDynamicReference addImportNat False lbl
3720 (tableReg,t_code) <- getSomeReg $ dynRef
3722 jumpTable = map jumpTableEntryRel ids
3724 jumpTableEntryRel Nothing
3725 = CmmStaticLit (CmmInt 0 wordRep)
3726 jumpTableEntryRel (Just (BlockId id))
3727 = CmmStaticLit (CmmLabelDiffOff blockLabel lbl 0)
3728 where blockLabel = mkAsmTempLabel id
3730 op = OpAddr (AddrBaseIndex (EABaseReg tableReg)
3731 (EAIndex reg wORD_SIZE) (ImmInt 0))
3733 code = e_code `appOL` t_code `appOL` toOL [
3734 LDATA ReadOnlyData (CmmDataLabel lbl : jumpTable),
3735 ADD wordRep op (OpReg tableReg),
3736 JMP_TBL (OpReg tableReg) [ id | Just id <- ids ]
3741 (reg,e_code) <- getSomeReg expr
3742 lbl <- getNewLabelNat
3744 jumpTable = map jumpTableEntry ids
3745 op = OpAddr (AddrBaseIndex EABaseNone (EAIndex reg wORD_SIZE) (ImmCLbl lbl))
3746 code = e_code `appOL` toOL [
3747 LDATA ReadOnlyData (CmmDataLabel lbl : jumpTable),
3748 JMP_TBL op [ id | Just id <- ids ]
3752 #elif powerpc_TARGET_ARCH
3756 (reg,e_code) <- getSomeReg expr
3757 tmp <- getNewRegNat I32
3758 lbl <- getNewLabelNat
3759 dynRef <- cmmMakeDynamicReference addImportNat False lbl
3760 (tableReg,t_code) <- getSomeReg $ dynRef
3762 jumpTable = map jumpTableEntryRel ids
3764 jumpTableEntryRel Nothing
3765 = CmmStaticLit (CmmInt 0 wordRep)
3766 jumpTableEntryRel (Just (BlockId id))
3767 = CmmStaticLit (CmmLabelDiffOff blockLabel lbl 0)
3768 where blockLabel = mkAsmTempLabel id
3770 code = e_code `appOL` t_code `appOL` toOL [
3771 LDATA ReadOnlyData (CmmDataLabel lbl : jumpTable),
3772 SLW tmp reg (RIImm (ImmInt 2)),
3773 LD I32 tmp (AddrRegReg tableReg tmp),
3774 ADD tmp tmp (RIReg tableReg),
3776 BCTR [ id | Just id <- ids ]
3781 (reg,e_code) <- getSomeReg expr
3782 tmp <- getNewRegNat I32
3783 lbl <- getNewLabelNat
3785 jumpTable = map jumpTableEntry ids
3787 code = e_code `appOL` toOL [
3788 LDATA ReadOnlyData (CmmDataLabel lbl : jumpTable),
3789 SLW tmp reg (RIImm (ImmInt 2)),
3790 ADDIS tmp tmp (HA (ImmCLbl lbl)),
3791 LD I32 tmp (AddrRegImm tmp (LO (ImmCLbl lbl))),
3793 BCTR [ id | Just id <- ids ]
3797 genSwitch expr ids = panic "ToDo: genSwitch"
3800 jumpTableEntry Nothing = CmmStaticLit (CmmInt 0 wordRep)
3801 jumpTableEntry (Just (BlockId id)) = CmmStaticLit (CmmLabel blockLabel)
3802 where blockLabel = mkAsmTempLabel id
3804 -- -----------------------------------------------------------------------------
3806 -- -----------------------------------------------------------------------------
3809 -- -----------------------------------------------------------------------------
3810 -- 'condIntReg' and 'condFltReg': condition codes into registers
3812 -- Turn those condition codes into integers now (when they appear on
3813 -- the right hand side of an assignment).
3815 -- (If applicable) Do not fill the delay slots here; you will confuse the
3816 -- register allocator.
3818 condIntReg, condFltReg :: Cond -> CmmExpr -> CmmExpr -> NatM Register
3820 -- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
3822 #if alpha_TARGET_ARCH
3823 condIntReg = panic "MachCode.condIntReg (not on Alpha)"
3824 condFltReg = panic "MachCode.condFltReg (not on Alpha)"
3825 #endif /* alpha_TARGET_ARCH */
3827 -- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
3829 #if i386_TARGET_ARCH || x86_64_TARGET_ARCH
3831 condIntReg cond x y = do
3832 CondCode _ cond cond_code <- condIntCode cond x y
3833 tmp <- getNewRegNat I8
3835 code dst = cond_code `appOL` toOL [
3836 SETCC cond (OpReg tmp),
3837 MOVZxL I8 (OpReg tmp) (OpReg dst)
3840 return (Any I32 code)
3844 #if i386_TARGET_ARCH
3846 condFltReg cond x y = do
3847 CondCode _ cond cond_code <- condFltCode cond x y
3848 tmp <- getNewRegNat I8
3850 code dst = cond_code `appOL` toOL [
3851 SETCC cond (OpReg tmp),
3852 MOVZxL I8 (OpReg tmp) (OpReg dst)
3855 return (Any I32 code)
3859 #if x86_64_TARGET_ARCH
3861 condFltReg cond x y = do
3862 CondCode _ cond cond_code <- condFltCode cond x y
3863 tmp1 <- getNewRegNat wordRep
3864 tmp2 <- getNewRegNat wordRep
3866 -- We have to worry about unordered operands (eg. comparisons
3867 -- against NaN). If the operands are unordered, the comparison
3868 -- sets the parity flag, carry flag and zero flag.
3869 -- All comparisons are supposed to return false for unordered
3870 -- operands except for !=, which returns true.
3872 -- Optimisation: we don't have to test the parity flag if we
3873 -- know the test has already excluded the unordered case: eg >
3874 -- and >= test for a zero carry flag, which can only occur for
3875 -- ordered operands.
3877 -- ToDo: by reversing comparisons we could avoid testing the
3878 -- parity flag in more cases.
3883 NE -> or_unordered dst
3884 GU -> plain_test dst
3885 GEU -> plain_test dst
3886 _ -> and_ordered dst)
3888 plain_test dst = toOL [
3889 SETCC cond (OpReg tmp1),
3890 MOVZxL I8 (OpReg tmp1) (OpReg dst)
3892 or_unordered dst = toOL [
3893 SETCC cond (OpReg tmp1),
3894 SETCC PARITY (OpReg tmp2),
3895 OR I8 (OpReg tmp1) (OpReg tmp2),
3896 MOVZxL I8 (OpReg tmp2) (OpReg dst)
3898 and_ordered dst = toOL [
3899 SETCC cond (OpReg tmp1),
3900 SETCC NOTPARITY (OpReg tmp2),
3901 AND I8 (OpReg tmp1) (OpReg tmp2),
3902 MOVZxL I8 (OpReg tmp2) (OpReg dst)
3905 return (Any I32 code)
3909 -- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
3911 #if sparc_TARGET_ARCH
3913 condIntReg EQQ x (CmmLit (CmmInt 0 d)) = do
3914 (src, code) <- getSomeReg x
3915 tmp <- getNewRegNat I32
3917 code__2 dst = code `appOL` toOL [
3918 SUB False True g0 (RIReg src) g0,
3919 SUB True False g0 (RIImm (ImmInt (-1))) dst]
3920 return (Any I32 code__2)
3922 condIntReg EQQ x y = do
3923 (src1, code1) <- getSomeReg x
3924 (src2, code2) <- getSomeReg y
3925 tmp1 <- getNewRegNat I32
3926 tmp2 <- getNewRegNat I32
3928 code__2 dst = code1 `appOL` code2 `appOL` toOL [
3929 XOR False src1 (RIReg src2) dst,
3930 SUB False True g0 (RIReg dst) g0,
3931 SUB True False g0 (RIImm (ImmInt (-1))) dst]
3932 return (Any I32 code__2)
3934 condIntReg NE x (CmmLit (CmmInt 0 d)) = do
3935 (src, code) <- getSomeReg x
3936 tmp <- getNewRegNat I32
3938 code__2 dst = code `appOL` toOL [
3939 SUB False True g0 (RIReg src) g0,
3940 ADD True False g0 (RIImm (ImmInt 0)) dst]
3941 return (Any I32 code__2)
3943 condIntReg NE x y = do
3944 (src1, code1) <- getSomeReg x
3945 (src2, code2) <- getSomeReg y
3946 tmp1 <- getNewRegNat I32
3947 tmp2 <- getNewRegNat I32
3949 code__2 dst = code1 `appOL` code2 `appOL` toOL [
3950 XOR False src1 (RIReg src2) dst,
3951 SUB False True g0 (RIReg dst) g0,
3952 ADD True False g0 (RIImm (ImmInt 0)) dst]
3953 return (Any I32 code__2)
3955 condIntReg cond x y = do
3956 BlockId lbl1 <- getBlockIdNat
3957 BlockId lbl2 <- getBlockIdNat
3958 CondCode _ cond cond_code <- condIntCode cond x y
3960 code__2 dst = cond_code `appOL` toOL [
3961 BI cond False (ImmCLbl (mkAsmTempLabel lbl1)), NOP,
3962 OR False g0 (RIImm (ImmInt 0)) dst,
3963 BI ALWAYS False (ImmCLbl (mkAsmTempLabel lbl2)), NOP,
3964 NEWBLOCK (BlockId lbl1),
3965 OR False g0 (RIImm (ImmInt 1)) dst,
3966 NEWBLOCK (BlockId lbl2)]
3967 return (Any I32 code__2)
3969 condFltReg cond x y = do
3970 BlockId lbl1 <- getBlockIdNat
3971 BlockId lbl2 <- getBlockIdNat
3972 CondCode _ cond cond_code <- condFltCode cond x y
3974 code__2 dst = cond_code `appOL` toOL [
3976 BF cond False (ImmCLbl (mkAsmTempLabel lbl1)), NOP,
3977 OR False g0 (RIImm (ImmInt 0)) dst,
3978 BI ALWAYS False (ImmCLbl (mkAsmTempLabel lbl2)), NOP,
3979 NEWBLOCK (BlockId lbl1),
3980 OR False g0 (RIImm (ImmInt 1)) dst,
3981 NEWBLOCK (BlockId lbl2)]
3982 return (Any I32 code__2)
3984 #endif /* sparc_TARGET_ARCH */
3986 #if powerpc_TARGET_ARCH
3987 condReg getCond = do
3988 lbl1 <- getBlockIdNat
3989 lbl2 <- getBlockIdNat
3990 CondCode _ cond cond_code <- getCond
3992 {- code dst = cond_code `appOL` toOL [
4001 code dst = cond_code
4005 RLWINM dst dst (bit + 1) 31 31
4008 negate_code | do_negate = unitOL (CRNOR bit bit bit)
4011 (bit, do_negate) = case cond of
4025 return (Any I32 code)
4027 condIntReg cond x y = condReg (condIntCode cond x y)
4028 condFltReg cond x y = condReg (condFltCode cond x y)
4029 #endif /* powerpc_TARGET_ARCH */
4032 -- -----------------------------------------------------------------------------
4033 -- 'trivial*Code': deal with trivial instructions
4035 -- Trivial (dyadic: 'trivialCode', floating-point: 'trivialFCode',
4036 -- unary: 'trivialUCode', unary fl-pt:'trivialUFCode') instructions.
4037 -- Only look for constants on the right hand side, because that's
4038 -- where the generic optimizer will have put them.
4040 -- Similarly, for unary instructions, we don't have to worry about
4041 -- matching an StInt as the argument, because genericOpt will already
4042 -- have handled the constant-folding.
4046 -> IF_ARCH_alpha((Reg -> RI -> Reg -> Instr)
4047 ,IF_ARCH_i386 ((Operand -> Operand -> Instr)
4048 -> Maybe (Operand -> Operand -> Instr)
4049 ,IF_ARCH_x86_64 ((Operand -> Operand -> Instr)
4050 -> Maybe (Operand -> Operand -> Instr)
4051 ,IF_ARCH_sparc((Reg -> RI -> Reg -> Instr)
4052 ,IF_ARCH_powerpc(Bool -> (Reg -> Reg -> RI -> Instr)
4054 -> CmmExpr -> CmmExpr -- the two arguments
4057 #ifndef powerpc_TARGET_ARCH
4060 -> IF_ARCH_alpha((Reg -> Reg -> Reg -> Instr)
4061 ,IF_ARCH_sparc((MachRep -> Reg -> Reg -> Reg -> Instr)
4062 ,IF_ARCH_i386 ((MachRep -> Reg -> Reg -> Reg -> Instr)
4063 ,IF_ARCH_x86_64 ((MachRep -> Operand -> Operand -> Instr)
4065 -> CmmExpr -> CmmExpr -- the two arguments
4071 -> IF_ARCH_alpha((RI -> Reg -> Instr)
4072 ,IF_ARCH_i386 ((Operand -> Instr)
4073 ,IF_ARCH_x86_64 ((Operand -> Instr)
4074 ,IF_ARCH_sparc((RI -> Reg -> Instr)
4075 ,IF_ARCH_powerpc((Reg -> Reg -> Instr)
4077 -> CmmExpr -- the one argument
4080 #ifndef powerpc_TARGET_ARCH
4083 -> IF_ARCH_alpha((Reg -> Reg -> Instr)
4084 ,IF_ARCH_i386 ((Reg -> Reg -> Instr)
4085 ,IF_ARCH_x86_64 ((Reg -> Reg -> Instr)
4086 ,IF_ARCH_sparc((Reg -> Reg -> Instr)
4088 -> CmmExpr -- the one argument
4092 -- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
4094 #if alpha_TARGET_ARCH
4096 trivialCode instr x (StInt y)
4098 = getRegister x `thenNat` \ register ->
4099 getNewRegNat IntRep `thenNat` \ tmp ->
4101 code = registerCode register tmp
4102 src1 = registerName register tmp
4103 src2 = ImmInt (fromInteger y)
4104 code__2 dst = code . mkSeqInstr (instr src1 (RIImm src2) dst)
4106 return (Any IntRep code__2)
4108 trivialCode instr x y
4109 = getRegister x `thenNat` \ register1 ->
4110 getRegister y `thenNat` \ register2 ->
4111 getNewRegNat IntRep `thenNat` \ tmp1 ->
4112 getNewRegNat IntRep `thenNat` \ tmp2 ->
4114 code1 = registerCode register1 tmp1 []
4115 src1 = registerName register1 tmp1
4116 code2 = registerCode register2 tmp2 []
4117 src2 = registerName register2 tmp2
4118 code__2 dst = asmSeqThen [code1, code2] .
4119 mkSeqInstr (instr src1 (RIReg src2) dst)
4121 return (Any IntRep code__2)
4124 trivialUCode instr x
4125 = getRegister x `thenNat` \ register ->
4126 getNewRegNat IntRep `thenNat` \ tmp ->
4128 code = registerCode register tmp
4129 src = registerName register tmp
4130 code__2 dst = code . mkSeqInstr (instr (RIReg src) dst)
4132 return (Any IntRep code__2)
4135 trivialFCode _ instr x y
4136 = getRegister x `thenNat` \ register1 ->
4137 getRegister y `thenNat` \ register2 ->
4138 getNewRegNat F64 `thenNat` \ tmp1 ->
4139 getNewRegNat F64 `thenNat` \ tmp2 ->
4141 code1 = registerCode register1 tmp1
4142 src1 = registerName register1 tmp1
4144 code2 = registerCode register2 tmp2
4145 src2 = registerName register2 tmp2
4147 code__2 dst = asmSeqThen [code1 [], code2 []] .
4148 mkSeqInstr (instr src1 src2 dst)
4150 return (Any F64 code__2)
4152 trivialUFCode _ instr x
4153 = getRegister x `thenNat` \ register ->
4154 getNewRegNat F64 `thenNat` \ tmp ->
4156 code = registerCode register tmp
4157 src = registerName register tmp
4158 code__2 dst = code . mkSeqInstr (instr src dst)
4160 return (Any F64 code__2)
4162 #endif /* alpha_TARGET_ARCH */
4164 -- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
4166 #if i386_TARGET_ARCH || x86_64_TARGET_ARCH
4169 The Rules of the Game are:
4171 * You cannot assume anything about the destination register dst;
4172 it may be anything, including a fixed reg.
4174 * You may compute an operand into a fixed reg, but you may not
4175 subsequently change the contents of that fixed reg. If you
4176 want to do so, first copy the value either to a temporary
4177 or into dst. You are free to modify dst even if it happens
4178 to be a fixed reg -- that's not your problem.
4180 * You cannot assume that a fixed reg will stay live over an
4181 arbitrary computation. The same applies to the dst reg.
4183 * Temporary regs obtained from getNewRegNat are distinct from
4184 each other and from all other regs, and stay live over
4185 arbitrary computations.
4187 --------------------
4189 SDM's version of The Rules:
4191 * If getRegister returns Any, that means it can generate correct
4192 code which places the result in any register, period. Even if that
4193 register happens to be read during the computation.
4195 Corollary #1: this means that if you are generating code for an
4196 operation with two arbitrary operands, you cannot assign the result
4197 of the first operand into the destination register before computing
4198 the second operand. The second operand might require the old value
4199 of the destination register.
4201 Corollary #2: A function might be able to generate more efficient
4202 code if it knows the destination register is a new temporary (and
4203 therefore not read by any of the sub-computations).
4205 * If getRegister returns Any, then the code it generates may modify only:
4206 (a) fresh temporaries
4207 (b) the destination register
4208 (c) known registers (eg. %ecx is used by shifts)
4209 In particular, it may *not* modify global registers, unless the global
4210 register happens to be the destination register.
4213 trivialCode rep instr (Just revinstr) (CmmLit lit_a) b
4214 | not (is64BitLit lit_a) = do
4215 b_code <- getAnyReg b
4218 = b_code dst `snocOL`
4219 revinstr (OpImm (litToImm lit_a)) (OpReg dst)
4221 return (Any rep code)
4223 trivialCode rep instr maybe_revinstr a b = genTrivialCode rep instr a b
4225 -- This is re-used for floating pt instructions too.
4226 genTrivialCode rep instr a b = do
4227 (b_op, b_code) <- getNonClobberedOperand b
4228 a_code <- getAnyReg a
4229 tmp <- getNewRegNat rep
4231 -- We want the value of b to stay alive across the computation of a.
4232 -- But, we want to calculate a straight into the destination register,
4233 -- because the instruction only has two operands (dst := dst `op` src).
4234 -- The troublesome case is when the result of b is in the same register
4235 -- as the destination reg. In this case, we have to save b in a
4236 -- new temporary across the computation of a.
4238 | dst `regClashesWithOp` b_op =
4240 unitOL (MOV rep b_op (OpReg tmp)) `appOL`
4242 instr (OpReg tmp) (OpReg dst)
4246 instr b_op (OpReg dst)
4248 return (Any rep code)
4250 reg `regClashesWithOp` OpReg reg2 = reg == reg2
4251 reg `regClashesWithOp` OpAddr amode = any (==reg) (addrModeRegs amode)
4252 reg `regClashesWithOp` _ = False
4256 trivialUCode rep instr x = do
4257 x_code <- getAnyReg x
4263 return (Any rep code)
4267 #if i386_TARGET_ARCH
4269 trivialFCode pk instr x y = do
4270 (x_reg, x_code) <- getNonClobberedReg x -- these work for float regs too
4271 (y_reg, y_code) <- getSomeReg y
4276 instr pk x_reg y_reg dst
4278 return (Any pk code)
4282 #if x86_64_TARGET_ARCH
4284 trivialFCode pk instr x y = genTrivialCode pk (instr pk) x y
4290 trivialUFCode rep instr x = do
4291 (x_reg, x_code) <- getSomeReg x
4297 return (Any rep code)
4299 #endif /* i386_TARGET_ARCH */
4301 -- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
4303 #if sparc_TARGET_ARCH
4305 trivialCode pk instr x (CmmLit (CmmInt y d))
4308 (src1, code) <- getSomeReg x
4309 tmp <- getNewRegNat I32
4311 src2 = ImmInt (fromInteger y)
4312 code__2 dst = code `snocOL` instr src1 (RIImm src2) dst
4313 return (Any I32 code__2)
4315 trivialCode pk instr x y = do
4316 (src1, code1) <- getSomeReg x
4317 (src2, code2) <- getSomeReg y
4318 tmp1 <- getNewRegNat I32
4319 tmp2 <- getNewRegNat I32
4321 code__2 dst = code1 `appOL` code2 `snocOL`
4322 instr src1 (RIReg src2) dst
4323 return (Any I32 code__2)
4326 trivialFCode pk instr x y = do
4327 (src1, code1) <- getSomeReg x
4328 (src2, code2) <- getSomeReg y
4329 tmp1 <- getNewRegNat (cmmExprRep x)
4330 tmp2 <- getNewRegNat (cmmExprRep y)
4331 tmp <- getNewRegNat F64
4333 promote x = FxTOy F32 F64 x tmp
4340 code1 `appOL` code2 `snocOL`
4341 instr pk src1 src2 dst
4342 else if pk1 == F32 then
4343 code1 `snocOL` promote src1 `appOL` code2 `snocOL`
4344 instr F64 tmp src2 dst
4346 code1 `appOL` code2 `snocOL` promote src2 `snocOL`
4347 instr F64 src1 tmp dst
4348 return (Any (if pk1 == pk2 then pk1 else F64) code__2)
4351 trivialUCode pk instr x = do
4352 (src, code) <- getSomeReg x
4353 tmp <- getNewRegNat pk
4355 code__2 dst = code `snocOL` instr (RIReg src) dst
4356 return (Any pk code__2)
4359 trivialUFCode pk instr x = do
4360 (src, code) <- getSomeReg x
4361 tmp <- getNewRegNat pk
4363 code__2 dst = code `snocOL` instr src dst
4364 return (Any pk code__2)
4366 #endif /* sparc_TARGET_ARCH */
4368 #if powerpc_TARGET_ARCH
4371 Wolfgang's PowerPC version of The Rules:
4373 A slightly modified version of The Rules to take advantage of the fact
4374 that PowerPC instructions work on all registers and don't implicitly
4375 clobber any fixed registers.
4377 * The only expression for which getRegister returns Fixed is (CmmReg reg).
4379 * If getRegister returns Any, then the code it generates may modify only:
4380 (a) fresh temporaries
4381 (b) the destination register
4382 It may *not* modify global registers, unless the global
4383 register happens to be the destination register.
4384 It may not clobber any other registers. In fact, only ccalls clobber any
4386 Also, it may not modify the counter register (used by genCCall).
4388 Corollary: If a getRegister for a subexpression returns Fixed, you need
4389 not move it to a fresh temporary before evaluating the next subexpression.
4390 The Fixed register won't be modified.
4391 Therefore, we don't need a counterpart for the x86's getStableReg on PPC.
4393 * SDM's First Rule is valid for PowerPC, too: subexpressions can depend on
4394 the value of the destination register.
4397 trivialCode rep signed instr x (CmmLit (CmmInt y _))
4398 | Just imm <- makeImmediate rep signed y
4400 (src1, code1) <- getSomeReg x
4401 let code dst = code1 `snocOL` instr dst src1 (RIImm imm)
4402 return (Any rep code)
4404 trivialCode rep signed instr x y = do
4405 (src1, code1) <- getSomeReg x
4406 (src2, code2) <- getSomeReg y
4407 let code dst = code1 `appOL` code2 `snocOL` instr dst src1 (RIReg src2)
4408 return (Any rep code)
4410 trivialCodeNoImm :: MachRep -> (Reg -> Reg -> Reg -> Instr)
4411 -> CmmExpr -> CmmExpr -> NatM Register
4412 trivialCodeNoImm rep instr x y = do
4413 (src1, code1) <- getSomeReg x
4414 (src2, code2) <- getSomeReg y
4415 let code dst = code1 `appOL` code2 `snocOL` instr dst src1 src2
4416 return (Any rep code)
4418 trivialUCode rep instr x = do
4419 (src, code) <- getSomeReg x
4420 let code' dst = code `snocOL` instr dst src
4421 return (Any rep code')
4423 -- There is no "remainder" instruction on the PPC, so we have to do
4425 -- The "div" parameter is the division instruction to use (DIVW or DIVWU)
4427 remainderCode :: MachRep -> (Reg -> Reg -> Reg -> Instr)
4428 -> CmmExpr -> CmmExpr -> NatM Register
4429 remainderCode rep div x y = do
4430 (src1, code1) <- getSomeReg x
4431 (src2, code2) <- getSomeReg y
4432 let code dst = code1 `appOL` code2 `appOL` toOL [
4434 MULLW dst dst (RIReg src2),
4437 return (Any rep code)
4439 #endif /* powerpc_TARGET_ARCH */
4442 -- -----------------------------------------------------------------------------
4443 -- Coercing to/from integer/floating-point...
4445 -- @coerce(Int2FP|FP2Int)@ are more complicated integer/float
4446 -- conversions. We have to store temporaries in memory to move
4447 -- between the integer and the floating point register sets.
4449 -- @coerceDbl2Flt@ and @coerceFlt2Dbl@ are done this way because we
4450 -- pretend, on sparc at least, that double and float regs are seperate
4451 -- kinds, so the value has to be computed into one kind before being
4452 -- explicitly "converted" to live in the other kind.
4454 coerceInt2FP :: MachRep -> MachRep -> CmmExpr -> NatM Register
4455 coerceFP2Int :: MachRep -> MachRep -> CmmExpr -> NatM Register
4457 #if sparc_TARGET_ARCH
4458 coerceDbl2Flt :: CmmExpr -> NatM Register
4459 coerceFlt2Dbl :: CmmExpr -> NatM Register
4462 -- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
4464 #if alpha_TARGET_ARCH
4467 = getRegister x `thenNat` \ register ->
4468 getNewRegNat IntRep `thenNat` \ reg ->
4470 code = registerCode register reg
4471 src = registerName register reg
4473 code__2 dst = code . mkSeqInstrs [
4475 LD TF dst (spRel 0),
4478 return (Any F64 code__2)
4482 = getRegister x `thenNat` \ register ->
4483 getNewRegNat F64 `thenNat` \ tmp ->
4485 code = registerCode register tmp
4486 src = registerName register tmp
4488 code__2 dst = code . mkSeqInstrs [
4490 ST TF tmp (spRel 0),
4493 return (Any IntRep code__2)
4495 #endif /* alpha_TARGET_ARCH */
4497 -- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
4499 #if i386_TARGET_ARCH
4501 coerceInt2FP from to x = do
4502 (x_reg, x_code) <- getSomeReg x
4504 opc = case to of F32 -> GITOF; F64 -> GITOD
4505 code dst = x_code `snocOL` opc x_reg dst
4506 -- ToDo: works for non-I32 reps?
4508 return (Any to code)
4512 coerceFP2Int from to x = do
4513 (x_reg, x_code) <- getSomeReg x
4515 opc = case from of F32 -> GFTOI; F64 -> GDTOI
4516 code dst = x_code `snocOL` opc x_reg dst
4517 -- ToDo: works for non-I32 reps?
4519 return (Any to code)
4521 #endif /* i386_TARGET_ARCH */
4523 -- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
4525 #if x86_64_TARGET_ARCH
4527 coerceFP2Int from to x = do
4528 (x_op, x_code) <- getOperand x -- ToDo: could be a safe operand
4530 opc = case from of F32 -> CVTSS2SI; F64 -> CVTSD2SI
4531 code dst = x_code `snocOL` opc x_op dst
4533 return (Any to code) -- works even if the destination rep is <I32
4535 coerceInt2FP from to x = do
4536 (x_op, x_code) <- getOperand x -- ToDo: could be a safe operand
4538 opc = case to of F32 -> CVTSI2SS; F64 -> CVTSI2SD
4539 code dst = x_code `snocOL` opc x_op dst
4541 return (Any to code) -- works even if the destination rep is <I32
4543 coerceFP2FP :: MachRep -> CmmExpr -> NatM Register
4544 coerceFP2FP to x = do
4545 (x_reg, x_code) <- getSomeReg x
4547 opc = case to of F32 -> CVTSD2SS; F64 -> CVTSS2SD
4548 code dst = x_code `snocOL` opc x_reg dst
4550 return (Any to code)
4554 -- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
4556 #if sparc_TARGET_ARCH
4558 coerceInt2FP pk1 pk2 x = do
4559 (src, code) <- getSomeReg x
4561 code__2 dst = code `appOL` toOL [
4562 ST pk1 src (spRel (-2)),
4563 LD pk1 (spRel (-2)) dst,
4564 FxTOy pk1 pk2 dst dst]
4565 return (Any pk2 code__2)
4568 coerceFP2Int pk fprep x = do
4569 (src, code) <- getSomeReg x
4570 reg <- getNewRegNat fprep
4571 tmp <- getNewRegNat pk
4573 code__2 dst = ASSERT(fprep == F64 || fprep == F32)
4575 FxTOy fprep pk src tmp,
4576 ST pk tmp (spRel (-2)),
4577 LD pk (spRel (-2)) dst]
4578 return (Any pk code__2)
4581 coerceDbl2Flt x = do
4582 (src, code) <- getSomeReg x
4583 return (Any F32 (\dst -> code `snocOL` FxTOy F64 F32 src dst))
4586 coerceFlt2Dbl x = do
4587 (src, code) <- getSomeReg x
4588 return (Any F64 (\dst -> code `snocOL` FxTOy F32 F64 src dst))
4590 #endif /* sparc_TARGET_ARCH */
4592 #if powerpc_TARGET_ARCH
4593 coerceInt2FP fromRep toRep x = do
4594 (src, code) <- getSomeReg x
4595 lbl <- getNewLabelNat
4596 itmp <- getNewRegNat I32
4597 ftmp <- getNewRegNat F64
4598 dynRef <- cmmMakeDynamicReference addImportNat False lbl
4599 Amode addr addr_code <- getAmode dynRef
4601 code' dst = code `appOL` maybe_exts `appOL` toOL [
4604 CmmStaticLit (CmmInt 0x43300000 I32),
4605 CmmStaticLit (CmmInt 0x80000000 I32)],
4606 XORIS itmp src (ImmInt 0x8000),
4607 ST I32 itmp (spRel 3),
4608 LIS itmp (ImmInt 0x4330),
4609 ST I32 itmp (spRel 2),
4610 LD F64 ftmp (spRel 2)
4611 ] `appOL` addr_code `appOL` toOL [
4613 FSUB F64 dst ftmp dst
4614 ] `appOL` maybe_frsp dst
4616 maybe_exts = case fromRep of
4617 I8 -> unitOL $ EXTS I8 src src
4618 I16 -> unitOL $ EXTS I16 src src
4620 maybe_frsp dst = case toRep of
4621 F32 -> unitOL $ FRSP dst dst
4623 return (Any toRep code')
4625 coerceFP2Int fromRep toRep x = do
4626 -- the reps don't really matter: F*->F64 and I32->I* are no-ops
4627 (src, code) <- getSomeReg x
4628 tmp <- getNewRegNat F64
4630 code' dst = code `appOL` toOL [
4631 -- convert to int in FP reg
4633 -- store value (64bit) from FP to stack
4634 ST F64 tmp (spRel 2),
4635 -- read low word of value (high word is undefined)
4636 LD I32 dst (spRel 3)]
4637 return (Any toRep code')
4638 #endif /* powerpc_TARGET_ARCH */
4641 -- -----------------------------------------------------------------------------
4642 -- eXTRA_STK_ARGS_HERE
4644 -- We (allegedly) put the first six C-call arguments in registers;
4645 -- where do we start putting the rest of them?
4647 -- Moved from MachInstrs (SDM):
4649 #if alpha_TARGET_ARCH || sparc_TARGET_ARCH
4650 eXTRA_STK_ARGS_HERE :: Int
4652 = IF_ARCH_alpha(0, IF_ARCH_sparc(23, ???))