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"
23 import PositionIndependentCode ( cmmMakeDynamicReference, initializePicBase )
25 -- Our intermediate code:
26 import PprCmm ( pprExpr )
32 import CmdLineOpts ( opt_PIC )
33 import ForeignCall ( CCallConv(..) )
37 import qualified Outputable
39 import FastTypes ( isFastTrue )
42 import Outputable ( assertPanic )
43 import TRACE ( trace )
46 import Control.Monad ( mapAndUnzipM )
47 import Maybe ( fromJust )
51 -- -----------------------------------------------------------------------------
52 -- Top-level of the instruction selector
54 -- | 'InstrBlock's are the insn sequences generated by the insn selectors.
55 -- They are really trees of insns to facilitate fast appending, where a
56 -- left-to-right traversal (pre-order?) yields the insns in the correct
59 type InstrBlock = OrdList Instr
61 cmmTopCodeGen :: CmmTop -> NatM [NatCmmTop]
62 cmmTopCodeGen (CmmProc info lab params blocks) = do
63 (nat_blocks,statics) <- mapAndUnzipM basicBlockCodeGen blocks
64 picBaseMb <- getPicBaseMaybeNat
65 let proc = CmmProc info lab params (concat nat_blocks)
66 tops = proc : concat statics
68 Just picBase -> initializePicBase picBase tops
69 Nothing -> return tops
71 cmmTopCodeGen (CmmData sec dat) = do
72 return [CmmData sec dat] -- no translation, we just use CmmStatic
74 basicBlockCodeGen :: CmmBasicBlock -> NatM ([NatBasicBlock],[NatCmmTop])
75 basicBlockCodeGen (BasicBlock id stmts) = do
76 instrs <- stmtsToInstrs stmts
77 -- code generation may introduce new basic block boundaries, which
78 -- are indicated by the NEWBLOCK instruction. We must split up the
79 -- instruction stream into basic blocks again. Also, we extract
82 (top,other_blocks,statics) = foldrOL mkBlocks ([],[],[]) instrs
84 mkBlocks (NEWBLOCK id) (instrs,blocks,statics)
85 = ([], BasicBlock id instrs : blocks, statics)
86 mkBlocks (LDATA sec dat) (instrs,blocks,statics)
87 = (instrs, blocks, CmmData sec dat:statics)
88 mkBlocks instr (instrs,blocks,statics)
89 = (instr:instrs, blocks, statics)
91 return (BasicBlock id top : other_blocks, statics)
93 stmtsToInstrs :: [CmmStmt] -> NatM InstrBlock
95 = do instrss <- mapM stmtToInstrs stmts
96 return (concatOL instrss)
98 stmtToInstrs :: CmmStmt -> NatM InstrBlock
99 stmtToInstrs stmt = case stmt of
100 CmmNop -> return nilOL
101 CmmComment s -> return (unitOL (COMMENT s))
104 | isFloatingRep kind -> assignReg_FltCode kind reg src
105 | wordRep == I32 && kind == I64
106 -> assignReg_I64Code reg src
107 | otherwise -> assignReg_IntCode kind reg src
108 where kind = cmmRegRep reg
111 | isFloatingRep kind -> assignMem_FltCode kind addr src
112 | wordRep == I32 && kind == I64
113 -> assignMem_I64Code addr src
114 | otherwise -> assignMem_IntCode kind addr src
115 where kind = cmmExprRep src
117 CmmCall target result_regs args vols
118 -> genCCall target result_regs args vols
120 CmmBranch id -> genBranch id
121 CmmCondBranch arg id -> genCondJump id arg
122 CmmSwitch arg ids -> genSwitch arg ids
123 CmmJump arg params -> genJump arg
125 -- -----------------------------------------------------------------------------
126 -- General things for putting together code sequences
128 -- Expand CmmRegOff. ToDo: should we do it this way around, or convert
129 -- CmmExprs into CmmRegOff?
130 mangleIndexTree :: CmmExpr -> CmmExpr
131 mangleIndexTree (CmmRegOff reg off)
132 = CmmMachOp (MO_Add rep) [CmmReg reg, CmmLit (CmmInt (fromIntegral off) rep)]
133 where rep = cmmRegRep reg
135 -- -----------------------------------------------------------------------------
136 -- Code gen for 64-bit arithmetic on 32-bit platforms
139 Simple support for generating 64-bit code (ie, 64 bit values and 64
140 bit assignments) on 32-bit platforms. Unlike the main code generator
141 we merely shoot for generating working code as simply as possible, and
142 pay little attention to code quality. Specifically, there is no
143 attempt to deal cleverly with the fixed-vs-floating register
144 distinction; all values are generated into (pairs of) floating
145 registers, even if this would mean some redundant reg-reg moves as a
146 result. Only one of the VRegUniques is returned, since it will be
147 of the VRegUniqueLo form, and the upper-half VReg can be determined
148 by applying getHiVRegFromLo to it.
151 data ChildCode64 -- a.k.a "Register64"
154 Reg -- the lower 32-bit temporary which contains the
155 -- result; use getHiVRegFromLo to find the other
156 -- VRegUnique. Rules of this simplified insn
157 -- selection game are therefore that the returned
158 -- Reg may be modified
160 assignMem_I64Code :: CmmExpr -> CmmExpr -> NatM InstrBlock
161 assignReg_I64Code :: CmmReg -> CmmExpr -> NatM InstrBlock
162 iselExpr64 :: CmmExpr -> NatM ChildCode64
164 -- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
168 assignMem_I64Code addrTree valueTree = do
169 Amode addr addr_code <- getAmode addrTree
170 ChildCode64 vcode rlo <- iselExpr64 valueTree
172 rhi = getHiVRegFromLo rlo
174 -- Little-endian store
175 mov_lo = MOV I32 (OpReg rlo) (OpAddr addr)
176 mov_hi = MOV I32 (OpReg rhi) (OpAddr (fromJust (addrOffset addr 4)))
178 return (vcode `appOL` addr_code `snocOL` mov_lo `snocOL` mov_hi)
181 assignReg_I64Code (CmmLocal (LocalReg u_dst pk)) valueTree = do
182 ChildCode64 vcode r_src_lo <- iselExpr64 valueTree
184 r_dst_lo = mkVReg u_dst I32
185 r_dst_hi = getHiVRegFromLo r_dst_lo
186 r_src_hi = getHiVRegFromLo r_src_lo
187 mov_lo = MOV I32 (OpReg r_src_lo) (OpReg r_dst_lo)
188 mov_hi = MOV I32 (OpReg r_src_hi) (OpReg r_dst_hi)
191 vcode `snocOL` mov_lo `snocOL` mov_hi
194 assignReg_I64Code lvalue valueTree
195 = panic "assignReg_I64Code(i386): invalid lvalue"
199 iselExpr64 (CmmLit (CmmInt i _)) = do
200 (rlo,rhi) <- getNewRegPairNat I32
202 r = fromIntegral (fromIntegral i :: Word32)
203 q = fromIntegral ((fromIntegral i `shiftR` 32) :: Word32)
205 MOV I32 (OpImm (ImmInteger r)) (OpReg rlo),
206 MOV I32 (OpImm (ImmInteger q)) (OpReg rhi)
209 return (ChildCode64 code rlo)
211 iselExpr64 (CmmLoad addrTree I64) = do
212 Amode addr addr_code <- getAmode addrTree
213 (rlo,rhi) <- getNewRegPairNat I32
215 mov_lo = MOV I32 (OpAddr addr) (OpReg rlo)
216 mov_hi = MOV I32 (OpAddr (fromJust (addrOffset addr 4))) (OpReg rhi)
219 ChildCode64 (addr_code `snocOL` mov_lo `snocOL` mov_hi)
223 iselExpr64 (CmmReg (CmmLocal (LocalReg vu I64)))
224 = return (ChildCode64 nilOL (mkVReg vu I32))
226 -- we handle addition, but rather badly
227 iselExpr64 (CmmMachOp (MO_Add _) [e1, CmmLit (CmmInt i _)]) = do
228 ChildCode64 code1 r1lo <- iselExpr64 e1
229 (rlo,rhi) <- getNewRegPairNat I32
231 r = fromIntegral (fromIntegral i :: Word32)
232 q = fromIntegral ((fromIntegral i `shiftR` 32) :: Word32)
233 r1hi = getHiVRegFromLo r1lo
235 toOL [ MOV I32 (OpReg r1lo) (OpReg rlo),
236 ADD I32 (OpImm (ImmInteger r)) (OpReg rlo),
237 MOV I32 (OpReg r1hi) (OpReg rhi),
238 ADC I32 (OpImm (ImmInteger q)) (OpReg rhi) ]
240 return (ChildCode64 code rlo)
242 iselExpr64 (CmmMachOp (MO_Add _) [e1,e2]) = do
243 ChildCode64 code1 r1lo <- iselExpr64 e1
244 ChildCode64 code2 r2lo <- iselExpr64 e2
245 (rlo,rhi) <- getNewRegPairNat I32
247 r1hi = getHiVRegFromLo r1lo
248 r2hi = getHiVRegFromLo r2lo
251 toOL [ MOV I32 (OpReg r1lo) (OpReg rlo),
252 ADD I32 (OpReg r2lo) (OpReg rlo),
253 MOV I32 (OpReg r1hi) (OpReg rhi),
254 ADC I32 (OpReg r2hi) (OpReg rhi) ]
256 return (ChildCode64 code rlo)
259 = pprPanic "iselExpr64(i386)" (ppr expr)
261 #endif /* i386_TARGET_ARCH */
263 -- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
265 #if sparc_TARGET_ARCH
267 assignMem_I64Code addrTree valueTree
268 = iselExpr64 valueTree `thenNat` \ (ChildCode64 vcode vrlo) ->
269 getRegister addrTree `thenNat` \ register_addr ->
270 getNewRegNat IntRep `thenNat` \ t_addr ->
271 let rlo = VirtualRegI vrlo
272 rhi = getHiVRegFromLo rlo
273 code_addr = registerCode register_addr t_addr
274 reg_addr = registerName register_addr t_addr
276 mov_hi = ST W rhi (AddrRegImm reg_addr (ImmInt 0))
277 mov_lo = ST W rlo (AddrRegImm reg_addr (ImmInt 4))
279 return (vcode `appOL` code_addr `snocOL` mov_hi `snocOL` mov_lo)
282 assignReg_I64Code (StixTemp (StixVReg u_dst pk)) valueTree
283 = iselExpr64 valueTree `thenNat` \ (ChildCode64 vcode vr_src_lo) ->
285 r_dst_lo = mkVReg u_dst IntRep
286 r_src_lo = VirtualRegI vr_src_lo
287 r_dst_hi = getHiVRegFromLo r_dst_lo
288 r_src_hi = getHiVRegFromLo r_src_lo
289 mov_lo = mkMOV r_src_lo r_dst_lo
290 mov_hi = mkMOV r_src_hi r_dst_hi
291 mkMOV sreg dreg = OR False g0 (RIReg sreg) dreg
294 vcode `snocOL` mov_hi `snocOL` mov_lo
296 assignReg_I64Code lvalue valueTree
297 = pprPanic "assignReg_I64Code(sparc): invalid lvalue"
301 -- Don't delete this -- it's very handy for debugging.
303 -- | trace ("iselExpr64: " ++ showSDoc (pprCmmExpr expr)) False
304 -- = panic "iselExpr64(???)"
306 iselExpr64 (CmmLoad I64 addrTree)
307 = getRegister addrTree `thenNat` \ register_addr ->
308 getNewRegNat IntRep `thenNat` \ t_addr ->
309 getNewRegNat IntRep `thenNat` \ rlo ->
310 let rhi = getHiVRegFromLo rlo
311 code_addr = registerCode register_addr t_addr
312 reg_addr = registerName register_addr t_addr
313 mov_hi = LD W (AddrRegImm reg_addr (ImmInt 0)) rhi
314 mov_lo = LD W (AddrRegImm reg_addr (ImmInt 4)) rlo
317 ChildCode64 (code_addr `snocOL` mov_hi `snocOL` mov_lo)
321 iselExpr64 (CmmReg (CmmLocal (LocalReg uq I64)))
322 = getNewRegNat IntRep `thenNat` \ r_dst_lo ->
323 let r_dst_hi = getHiVRegFromLo r_dst_lo
324 r_src_lo = mkVReg vu IntRep
325 r_src_hi = getHiVRegFromLo r_src_lo
326 mov_lo = mkMOV r_src_lo r_dst_lo
327 mov_hi = mkMOV r_src_hi r_dst_hi
328 mkMOV sreg dreg = OR False g0 (RIReg sreg) dreg
331 ChildCode64 (toOL [mov_hi, mov_lo]) (getVRegUnique r_dst_lo)
334 iselExpr64 (StCall fn cconv I64 args)
335 = genCCall fn cconv kind args `thenNat` \ call ->
336 getNewRegNat IntRep `thenNat` \ r_dst_lo ->
337 let r_dst_hi = getHiVRegFromLo r_dst_lo
338 mov_lo = mkMOV o0 r_dst_lo
339 mov_hi = mkMOV o1 r_dst_hi
340 mkMOV sreg dreg = OR False g0 (RIReg sreg) dreg
343 ChildCode64 (call `snocOL` mov_hi `snocOL` mov_lo)
344 (getVRegUnique r_dst_lo)
348 = pprPanic "iselExpr64(sparc)" (pprCmmExpr expr)
350 #endif /* sparc_TARGET_ARCH */
352 -- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
354 #if powerpc_TARGET_ARCH
356 getI64Amodes :: CmmExpr -> NatM (AddrMode, AddrMode, InstrBlock)
357 getI64Amodes addrTree = do
358 Amode hi_addr addr_code <- getAmode addrTree
359 case addrOffset hi_addr 4 of
360 Just lo_addr -> return (hi_addr, lo_addr, addr_code)
361 Nothing -> do (hi_ptr, code) <- getSomeReg addrTree
362 return (AddrRegImm hi_ptr (ImmInt 0),
363 AddrRegImm hi_ptr (ImmInt 4),
366 assignMem_I64Code addrTree valueTree = do
367 (hi_addr, lo_addr, addr_code) <- getI64Amodes addrTree
368 ChildCode64 vcode rlo <- iselExpr64 valueTree
370 rhi = getHiVRegFromLo rlo
373 mov_hi = ST I32 rhi hi_addr
374 mov_lo = ST I32 rlo lo_addr
376 return (vcode `appOL` addr_code `snocOL` mov_lo `snocOL` mov_hi)
378 assignReg_I64Code (CmmLocal (LocalReg u_dst pk)) valueTree = do
379 ChildCode64 vcode r_src_lo <- iselExpr64 valueTree
381 r_dst_lo = mkVReg u_dst I32
382 r_dst_hi = getHiVRegFromLo r_dst_lo
383 r_src_hi = getHiVRegFromLo r_src_lo
384 mov_lo = MR r_dst_lo r_src_lo
385 mov_hi = MR r_dst_hi r_src_hi
388 vcode `snocOL` mov_lo `snocOL` mov_hi
391 assignReg_I64Code lvalue valueTree
392 = panic "assignReg_I64Code(powerpc): invalid lvalue"
395 -- Don't delete this -- it's very handy for debugging.
397 -- | trace ("iselExpr64: " ++ showSDoc (pprCmmExpr expr)) False
398 -- = panic "iselExpr64(???)"
400 iselExpr64 (CmmLoad addrTree I64) = do
401 (hi_addr, lo_addr, addr_code) <- getI64Amodes addrTree
402 (rlo, rhi) <- getNewRegPairNat I32
403 let mov_hi = LD I32 rhi hi_addr
404 mov_lo = LD I32 rlo lo_addr
405 return $ ChildCode64 (addr_code `snocOL` mov_lo `snocOL` mov_hi)
408 iselExpr64 (CmmReg (CmmLocal (LocalReg vu I64)))
409 = return (ChildCode64 nilOL (mkVReg vu I32))
411 iselExpr64 (CmmLit (CmmInt i _)) = do
412 (rlo,rhi) <- getNewRegPairNat I32
414 half0 = fromIntegral (fromIntegral i :: Word16)
415 half1 = fromIntegral ((fromIntegral i `shiftR` 16) :: Word16)
416 half2 = fromIntegral ((fromIntegral i `shiftR` 32) :: Word16)
417 half3 = fromIntegral ((fromIntegral i `shiftR` 48) :: Word16)
420 LIS rlo (ImmInt half1),
421 OR rlo rlo (RIImm $ ImmInt half0),
422 LIS rhi (ImmInt half3),
423 OR rlo rlo (RIImm $ ImmInt half2)
426 return (ChildCode64 code rlo)
428 iselExpr64 (CmmMachOp (MO_Add _) [e1,e2]) = do
429 ChildCode64 code1 r1lo <- iselExpr64 e1
430 ChildCode64 code2 r2lo <- iselExpr64 e2
431 (rlo,rhi) <- getNewRegPairNat I32
433 r1hi = getHiVRegFromLo r1lo
434 r2hi = getHiVRegFromLo r2lo
437 toOL [ ADDC rlo r1lo r2lo,
440 return (ChildCode64 code rlo)
443 = pprPanic "iselExpr64(powerpc)" (ppr expr)
445 #endif /* powerpc_TARGET_ARCH */
448 -- -----------------------------------------------------------------------------
449 -- The 'Register' type
451 -- 'Register's passed up the tree. If the stix code forces the register
452 -- to live in a pre-decided machine register, it comes out as @Fixed@;
453 -- otherwise, it comes out as @Any@, and the parent can decide which
454 -- register to put it in.
457 = Fixed MachRep Reg InstrBlock
458 | Any MachRep (Reg -> InstrBlock)
460 swizzleRegisterRep :: Register -> MachRep -> Register
461 swizzleRegisterRep (Fixed _ reg code) rep = Fixed rep reg code
462 swizzleRegisterRep (Any _ codefn) rep = Any rep codefn
465 -- -----------------------------------------------------------------------------
466 -- Grab the Reg for a CmmReg
468 getRegisterReg :: CmmReg -> Reg
470 getRegisterReg (CmmLocal (LocalReg u pk))
473 getRegisterReg (CmmGlobal mid)
474 = case get_GlobalReg_reg_or_addr mid of
475 Left (RealReg rrno) -> RealReg rrno
476 _other -> pprPanic "getRegisterReg-memory" (ppr $ CmmGlobal mid)
477 -- By this stage, the only MagicIds remaining should be the
478 -- ones which map to a real machine register on this
479 -- platform. Hence ...
482 -- -----------------------------------------------------------------------------
483 -- Generate code to get a subtree into a Register
485 -- Don't delete this -- it's very handy for debugging.
487 -- | trace ("getRegister: " ++ showSDoc (pprCmmExpr expr)) False
488 -- = panic "getRegister(???)"
490 getRegister :: CmmExpr -> NatM Register
492 getRegister (CmmReg reg)
493 = return (Fixed (cmmRegRep reg) (getRegisterReg reg) nilOL)
495 getRegister tree@(CmmRegOff _ _)
496 = getRegister (mangleIndexTree tree)
498 getRegister CmmPicBaseReg
500 reg <- getPicBaseNat wordRep
501 return (Fixed wordRep reg nilOL)
503 -- end of machine-"independent" bit; here we go on the rest...
505 #if alpha_TARGET_ARCH
507 getRegister (StDouble d)
508 = getBlockIdNat `thenNat` \ lbl ->
509 getNewRegNat PtrRep `thenNat` \ tmp ->
510 let code dst = mkSeqInstrs [
511 LDATA RoDataSegment lbl [
512 DATA TF [ImmLab (rational d)]
514 LDA tmp (AddrImm (ImmCLbl lbl)),
515 LD TF dst (AddrReg tmp)]
517 return (Any F64 code)
519 getRegister (StPrim primop [x]) -- unary PrimOps
521 IntNegOp -> trivialUCode (NEG Q False) x
523 NotOp -> trivialUCode NOT x
525 FloatNegOp -> trivialUFCode FloatRep (FNEG TF) x
526 DoubleNegOp -> trivialUFCode F64 (FNEG TF) x
528 OrdOp -> coerceIntCode IntRep x
531 Float2IntOp -> coerceFP2Int x
532 Int2FloatOp -> coerceInt2FP pr x
533 Double2IntOp -> coerceFP2Int x
534 Int2DoubleOp -> coerceInt2FP pr x
536 Double2FloatOp -> coerceFltCode x
537 Float2DoubleOp -> coerceFltCode x
539 other_op -> getRegister (StCall fn CCallConv F64 [x])
541 fn = case other_op of
542 FloatExpOp -> FSLIT("exp")
543 FloatLogOp -> FSLIT("log")
544 FloatSqrtOp -> FSLIT("sqrt")
545 FloatSinOp -> FSLIT("sin")
546 FloatCosOp -> FSLIT("cos")
547 FloatTanOp -> FSLIT("tan")
548 FloatAsinOp -> FSLIT("asin")
549 FloatAcosOp -> FSLIT("acos")
550 FloatAtanOp -> FSLIT("atan")
551 FloatSinhOp -> FSLIT("sinh")
552 FloatCoshOp -> FSLIT("cosh")
553 FloatTanhOp -> FSLIT("tanh")
554 DoubleExpOp -> FSLIT("exp")
555 DoubleLogOp -> FSLIT("log")
556 DoubleSqrtOp -> FSLIT("sqrt")
557 DoubleSinOp -> FSLIT("sin")
558 DoubleCosOp -> FSLIT("cos")
559 DoubleTanOp -> FSLIT("tan")
560 DoubleAsinOp -> FSLIT("asin")
561 DoubleAcosOp -> FSLIT("acos")
562 DoubleAtanOp -> FSLIT("atan")
563 DoubleSinhOp -> FSLIT("sinh")
564 DoubleCoshOp -> FSLIT("cosh")
565 DoubleTanhOp -> FSLIT("tanh")
567 pr = panic "MachCode.getRegister: no primrep needed for Alpha"
569 getRegister (StPrim primop [x, y]) -- dyadic PrimOps
571 CharGtOp -> trivialCode (CMP LTT) y x
572 CharGeOp -> trivialCode (CMP LE) y x
573 CharEqOp -> trivialCode (CMP EQQ) x y
574 CharNeOp -> int_NE_code x y
575 CharLtOp -> trivialCode (CMP LTT) x y
576 CharLeOp -> trivialCode (CMP LE) x y
578 IntGtOp -> trivialCode (CMP LTT) y x
579 IntGeOp -> trivialCode (CMP LE) y x
580 IntEqOp -> trivialCode (CMP EQQ) x y
581 IntNeOp -> int_NE_code x y
582 IntLtOp -> trivialCode (CMP LTT) x y
583 IntLeOp -> trivialCode (CMP LE) x y
585 WordGtOp -> trivialCode (CMP ULT) y x
586 WordGeOp -> trivialCode (CMP ULE) x y
587 WordEqOp -> trivialCode (CMP EQQ) x y
588 WordNeOp -> int_NE_code x y
589 WordLtOp -> trivialCode (CMP ULT) x y
590 WordLeOp -> trivialCode (CMP ULE) x y
592 AddrGtOp -> trivialCode (CMP ULT) y x
593 AddrGeOp -> trivialCode (CMP ULE) y x
594 AddrEqOp -> trivialCode (CMP EQQ) x y
595 AddrNeOp -> int_NE_code x y
596 AddrLtOp -> trivialCode (CMP ULT) x y
597 AddrLeOp -> trivialCode (CMP ULE) x y
599 FloatGtOp -> cmpF_code (FCMP TF LE) EQQ x y
600 FloatGeOp -> cmpF_code (FCMP TF LTT) EQQ x y
601 FloatEqOp -> cmpF_code (FCMP TF EQQ) NE x y
602 FloatNeOp -> cmpF_code (FCMP TF EQQ) EQQ x y
603 FloatLtOp -> cmpF_code (FCMP TF LTT) NE x y
604 FloatLeOp -> cmpF_code (FCMP TF LE) NE x y
606 DoubleGtOp -> cmpF_code (FCMP TF LE) EQQ x y
607 DoubleGeOp -> cmpF_code (FCMP TF LTT) EQQ x y
608 DoubleEqOp -> cmpF_code (FCMP TF EQQ) NE x y
609 DoubleNeOp -> cmpF_code (FCMP TF EQQ) EQQ x y
610 DoubleLtOp -> cmpF_code (FCMP TF LTT) NE x y
611 DoubleLeOp -> cmpF_code (FCMP TF LE) NE x y
613 IntAddOp -> trivialCode (ADD Q False) x y
614 IntSubOp -> trivialCode (SUB Q False) x y
615 IntMulOp -> trivialCode (MUL Q False) x y
616 IntQuotOp -> trivialCode (DIV Q False) x y
617 IntRemOp -> trivialCode (REM Q False) x y
619 WordAddOp -> trivialCode (ADD Q False) x y
620 WordSubOp -> trivialCode (SUB Q False) x y
621 WordMulOp -> trivialCode (MUL Q False) x y
622 WordQuotOp -> trivialCode (DIV Q True) x y
623 WordRemOp -> trivialCode (REM Q True) x y
625 FloatAddOp -> trivialFCode FloatRep (FADD TF) x y
626 FloatSubOp -> trivialFCode FloatRep (FSUB TF) x y
627 FloatMulOp -> trivialFCode FloatRep (FMUL TF) x y
628 FloatDivOp -> trivialFCode FloatRep (FDIV TF) x y
630 DoubleAddOp -> trivialFCode F64 (FADD TF) x y
631 DoubleSubOp -> trivialFCode F64 (FSUB TF) x y
632 DoubleMulOp -> trivialFCode F64 (FMUL TF) x y
633 DoubleDivOp -> trivialFCode F64 (FDIV TF) x y
635 AddrAddOp -> trivialCode (ADD Q False) x y
636 AddrSubOp -> trivialCode (SUB Q False) x y
637 AddrRemOp -> trivialCode (REM Q True) x y
639 AndOp -> trivialCode AND x y
640 OrOp -> trivialCode OR x y
641 XorOp -> trivialCode XOR x y
642 SllOp -> trivialCode SLL x y
643 SrlOp -> trivialCode SRL x y
645 ISllOp -> trivialCode SLL x y -- was: panic "AlphaGen:isll"
646 ISraOp -> trivialCode SRA x y -- was: panic "AlphaGen:isra"
647 ISrlOp -> trivialCode SRL x y -- was: panic "AlphaGen:isrl"
649 FloatPowerOp -> getRegister (StCall FSLIT("pow") CCallConv F64 [x,y])
650 DoublePowerOp -> getRegister (StCall FSLIT("pow") CCallConv F64 [x,y])
652 {- ------------------------------------------------------------
653 Some bizarre special code for getting condition codes into
654 registers. Integer non-equality is a test for equality
655 followed by an XOR with 1. (Integer comparisons always set
656 the result register to 0 or 1.) Floating point comparisons of
657 any kind leave the result in a floating point register, so we
658 need to wrangle an integer register out of things.
660 int_NE_code :: StixTree -> StixTree -> NatM Register
663 = trivialCode (CMP EQQ) x y `thenNat` \ register ->
664 getNewRegNat IntRep `thenNat` \ tmp ->
666 code = registerCode register tmp
667 src = registerName register tmp
668 code__2 dst = code . mkSeqInstr (XOR src (RIImm (ImmInt 1)) dst)
670 return (Any IntRep code__2)
672 {- ------------------------------------------------------------
673 Comments for int_NE_code also apply to cmpF_code
676 :: (Reg -> Reg -> Reg -> Instr)
678 -> StixTree -> StixTree
681 cmpF_code instr cond x y
682 = trivialFCode pr instr x y `thenNat` \ register ->
683 getNewRegNat F64 `thenNat` \ tmp ->
684 getBlockIdNat `thenNat` \ lbl ->
686 code = registerCode register tmp
687 result = registerName register tmp
689 code__2 dst = code . mkSeqInstrs [
690 OR zeroh (RIImm (ImmInt 1)) dst,
691 BF cond result (ImmCLbl lbl),
692 OR zeroh (RIReg zeroh) dst,
695 return (Any IntRep code__2)
697 pr = panic "trivialU?FCode: does not use PrimRep on Alpha"
698 ------------------------------------------------------------
700 getRegister (CmmLoad pk mem)
701 = getAmode mem `thenNat` \ amode ->
703 code = amodeCode amode
704 src = amodeAddr amode
705 size = primRepToSize pk
706 code__2 dst = code . mkSeqInstr (LD size dst src)
708 return (Any pk code__2)
710 getRegister (StInt i)
713 code dst = mkSeqInstr (OR zeroh (RIImm src) dst)
715 return (Any IntRep code)
718 code dst = mkSeqInstr (LDI Q dst src)
720 return (Any IntRep code)
722 src = ImmInt (fromInteger i)
727 code dst = mkSeqInstr (LDA dst (AddrImm imm__2))
729 return (Any PtrRep code)
732 imm__2 = case imm of Just x -> x
734 #endif /* alpha_TARGET_ARCH */
736 -- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
740 getRegister (CmmLit (CmmFloat f F32)) = do
741 lbl <- getNewLabelNat
742 let code dst = toOL [
745 CmmStaticLit (CmmFloat f F32)],
746 GLD F32 (ImmAddr (ImmCLbl lbl) 0) dst
749 return (Any F32 code)
752 getRegister (CmmLit (CmmFloat d F64))
754 = let code dst = unitOL (GLDZ dst)
755 in return (Any F64 code)
758 = let code dst = unitOL (GLD1 dst)
759 in return (Any F64 code)
762 lbl <- getNewLabelNat
763 let code dst = toOL [
766 CmmStaticLit (CmmFloat d F64)],
767 GLD F64 (ImmAddr (ImmCLbl lbl) 0) dst
770 return (Any F64 code)
773 -- catch simple cases of zero- or sign-extended load
774 getRegister (CmmMachOp (MO_U_Conv I8 I32) [CmmLoad addr _]) = do
775 code <- intLoadCode (MOVZxL I8) addr
776 return (Any I32 code)
778 getRegister (CmmMachOp (MO_S_Conv I8 I32) [CmmLoad addr _]) = do
779 code <- intLoadCode (MOVSxL I8) addr
780 return (Any I32 code)
782 getRegister (CmmMachOp (MO_U_Conv I16 I32) [CmmLoad addr _]) = do
783 code <- intLoadCode (MOVZxL I16) addr
784 return (Any I32 code)
786 getRegister (CmmMachOp (MO_S_Conv I16 I32) [CmmLoad addr _]) = do
787 code <- intLoadCode (MOVSxL I16) addr
788 return (Any I32 code)
791 getRegister (CmmMachOp mop [x]) -- unary MachOps
793 MO_S_Neg F32 -> trivialUFCode F32 (GNEG F32) x
794 MO_S_Neg F64 -> trivialUFCode F64 (GNEG F64) x
796 MO_S_Neg rep -> trivialUCode rep (NEGI rep) x
797 MO_Not rep -> trivialUCode rep (NOT rep) x
800 -- TODO: these are only nops if the arg is not a fixed register that
801 -- can't be byte-addressed.
802 MO_U_Conv I32 I8 -> conversionNop I32 x
803 MO_S_Conv I32 I8 -> conversionNop I32 x
804 MO_U_Conv I16 I8 -> conversionNop I16 x
805 MO_S_Conv I16 I8 -> conversionNop I16 x
806 MO_U_Conv I32 I16 -> conversionNop I32 x
807 MO_S_Conv I32 I16 -> conversionNop I32 x
808 MO_U_Conv rep1 rep2 | rep1 == rep2 -> conversionNop rep1 x
809 MO_S_Conv rep1 rep2 | rep1 == rep2 -> conversionNop rep1 x
812 MO_U_Conv I8 I32 -> integerExtend I8 I32 MOVZxL x
813 MO_U_Conv I16 I32 -> integerExtend I16 I32 MOVZxL x
814 MO_U_Conv I8 I16 -> integerExtend I8 I16 MOVZxL x
816 MO_S_Conv I8 I32 -> integerExtend I8 I32 MOVSxL x
817 MO_S_Conv I16 I32 -> integerExtend I16 I32 MOVSxL x
818 MO_S_Conv I8 I16 -> integerExtend I8 I16 MOVSxL x
820 MO_S_Conv F32 F64 -> conversionNop F64 x
821 MO_S_Conv F64 F32 -> conversionNop F32 x
823 | isFloatingRep from -> coerceFP2Int from to x
824 | isFloatingRep to -> coerceInt2FP from to x
827 -- signed or unsigned extension.
828 integerExtend from to instr expr = do
829 (reg,e_code) <- if from == I8 then getByteReg expr
834 instr from (OpReg reg) (OpReg dst)
837 conversionNop new_rep expr
838 = do e_code <- getRegister expr
839 return (swizzleRegisterRep e_code new_rep)
842 getRegister e@(CmmMachOp mop [x, y]) -- dyadic MachOps
843 = ASSERT2(cmmExprRep x /= I8, pprExpr e)
845 MO_Eq F32 -> condFltReg EQQ x y
846 MO_Ne F32 -> condFltReg NE x y
847 MO_S_Gt F32 -> condFltReg GTT x y
848 MO_S_Ge F32 -> condFltReg GE x y
849 MO_S_Lt F32 -> condFltReg LTT x y
850 MO_S_Le F32 -> condFltReg LE x y
852 MO_Eq F64 -> condFltReg EQQ x y
853 MO_Ne F64 -> condFltReg NE x y
854 MO_S_Gt F64 -> condFltReg GTT x y
855 MO_S_Ge F64 -> condFltReg GE x y
856 MO_S_Lt F64 -> condFltReg LTT x y
857 MO_S_Le F64 -> condFltReg LE x y
859 MO_Eq rep -> condIntReg EQQ x y
860 MO_Ne rep -> condIntReg NE x y
862 MO_S_Gt rep -> condIntReg GTT x y
863 MO_S_Ge rep -> condIntReg GE x y
864 MO_S_Lt rep -> condIntReg LTT x y
865 MO_S_Le rep -> condIntReg LE x y
867 MO_U_Gt rep -> condIntReg GU x y
868 MO_U_Ge rep -> condIntReg GEU x y
869 MO_U_Lt rep -> condIntReg LU x y
870 MO_U_Le rep -> condIntReg LEU x y
872 MO_Add F32 -> trivialFCode F32 GADD x y
873 MO_Sub F32 -> trivialFCode F32 GSUB x y
875 MO_Add F64 -> trivialFCode F64 GADD x y
876 MO_Sub F64 -> trivialFCode F64 GSUB x y
878 MO_S_Quot F32 -> trivialFCode F32 GDIV x y
879 MO_S_Quot F64 -> trivialFCode F64 GDIV x y
881 MO_Add rep -> add_code rep x y
882 MO_Sub rep -> sub_code rep x y
884 MO_S_Quot rep -> div_code rep True True x y
885 MO_S_Rem rep -> div_code rep True False x y
886 MO_U_Quot rep -> div_code rep False True x y
887 MO_U_Rem rep -> div_code rep False False x y
889 MO_Mul F32 -> trivialFCode F32 GMUL x y
890 MO_Mul F64 -> trivialFCode F64 GMUL x y
891 MO_Mul rep -> let op = IMUL rep in
892 trivialCode rep op (Just op) x y
894 MO_S_MulMayOflo rep -> imulMayOflo rep x y
896 MO_And rep -> let op = AND rep in
897 trivialCode rep op (Just op) x y
898 MO_Or rep -> let op = OR rep in
899 trivialCode rep op (Just op) x y
900 MO_Xor rep -> let op = XOR rep in
901 trivialCode rep op (Just op) x y
903 {- Shift ops on x86s have constraints on their source, it
904 either has to be Imm, CL or 1
905 => trivialCode is not restrictive enough (sigh.)
907 MO_Shl rep -> shift_code rep (SHL rep) x y {-False-}
908 MO_U_Shr rep -> shift_code rep (SHR rep) x y {-False-}
909 MO_S_Shr rep -> shift_code rep (SAR rep) x y {-False-}
911 other -> pprPanic "getRegister(x86) - binary CmmMachOp (1)" (pprMachOp mop)
914 imulMayOflo :: MachRep -> CmmExpr -> CmmExpr -> NatM Register
915 imulMayOflo I32 a b = do
916 res_lo <- getNewRegNat I32
917 res_hi <- getNewRegNat I32
918 (a_reg, a_code) <- getNonClobberedReg a
919 (b_reg, b_code) <- getSomeReg b
921 code dst = a_code `appOL` b_code `appOL`
923 MOV I32 (OpReg a_reg) (OpReg res_hi),
924 MOV I32 (OpReg b_reg) (OpReg res_lo),
925 IMUL64 res_hi res_lo, -- result in res_hi:res_lo
926 SAR I32 (OpImm (ImmInt 31)) (OpReg res_lo), -- sign extend lower part
927 SUB I32 (OpReg res_hi) (OpReg res_lo), -- compare against upper
928 MOV I32 (OpReg res_lo) (OpReg dst)
929 -- dst==0 if high part == sign extended low part
932 return (Any I32 code)
935 shift_code :: MachRep
936 -> (Operand -> Operand -> Instr)
941 {- Case1: shift length as immediate -}
942 shift_code rep instr x y@(CmmLit lit) = do
943 x_code <- getAnyReg x
946 = x_code dst `snocOL`
947 instr (OpImm (litToImm lit)) (OpReg dst)
949 return (Any rep code)
951 {- Case2: shift length is complex (non-immediate) -}
952 shift_code rep instr x y{-amount-} = do
953 (x_reg, x_code) <- getNonClobberedReg x
954 y_code <- getAnyReg y
956 code = x_code `appOL`
958 instr (OpReg ecx) (OpReg x_reg)
960 return (Fixed rep x_reg code)
963 add_code :: MachRep -> CmmExpr -> CmmExpr -> NatM Register
964 add_code rep x (CmmLit (CmmInt y _)) = add_int rep x y
965 add_code rep x y = trivialCode rep (ADD rep) (Just (ADD rep)) x y
968 sub_code :: MachRep -> CmmExpr -> CmmExpr -> NatM Register
969 sub_code rep x (CmmLit (CmmInt y _)) = add_int rep x (-y)
970 sub_code rep x y = trivialCode rep (SUB rep) Nothing x y
972 -- our three-operand add instruction:
974 (x_reg, x_code) <- getSomeReg x
976 imm = ImmInt (fromInteger y)
980 (OpAddr (AddrBaseIndex (Just x_reg) Nothing imm))
983 return (Any rep code)
985 ----------------------
986 div_code rep signed quotient x y = do
987 (y_op, y_code) <- getOperand y -- cannot be clobbered
988 x_code <- getAnyReg x
990 widen | signed = CLTD
991 | otherwise = XOR rep (OpReg edx) (OpReg edx)
993 instr | signed = IDIV
996 code = y_code `appOL`
998 toOL [widen, instr rep y_op]
1000 result | quotient = eax
1004 return (Fixed rep result code)
1008 getRegister (CmmLoad mem pk)
1011 Amode src mem_code <- getAmode mem
1013 code dst = mem_code `snocOL`
1016 return (Any pk code)
1018 getRegister (CmmLoad mem pk)
1021 code <- intLoadCode (instr pk) mem
1022 return (Any pk code)
1024 instr I8 = MOVZxL pk
1027 -- we always zero-extend 8-bit loads, if we
1028 -- can't think of anything better. This is because
1029 -- we can't guarantee access to an 8-bit variant of every register
1030 -- (esi and edi don't have 8-bit variants), so to make things
1031 -- simpler we do our 8-bit arithmetic with full 32-bit registers.
1033 getRegister (CmmLit (CmmInt 0 rep))
1036 = unitOL (XOR rep (OpReg dst) (OpReg dst))
1038 return (Any rep code)
1040 getRegister (CmmLit lit)
1044 code dst = unitOL (MOV rep (OpImm imm) (OpReg dst))
1046 return (Any rep code)
1048 getRegister other = panic "getRegister(x86)"
1051 intLoadCode :: (Operand -> Operand -> Instr) -> CmmExpr
1052 -> NatM (Reg -> InstrBlock)
1053 intLoadCode instr mem = do
1054 Amode src mem_code <- getAmode mem
1055 return (\dst -> mem_code `snocOL` instr (OpAddr src) (OpReg dst))
1057 -- Compute an expression into *any* register, adding the appropriate
1058 -- move instruction if necessary.
1059 getAnyReg :: CmmExpr -> NatM (Reg -> InstrBlock)
1061 r <- getRegister expr
1064 anyReg :: Register -> NatM (Reg -> InstrBlock)
1065 anyReg (Any _ code) = return code
1066 anyReg (Fixed rep reg fcode) = return (\dst -> fcode `snocOL` reg2reg rep reg dst)
1068 -- The dual to getAnyReg: compute an expression into a register, but
1069 -- we don't mind which one it is.
1070 getSomeReg :: CmmExpr -> NatM (Reg, InstrBlock)
1071 getSomeReg expr = do
1072 r <- getRegister expr
1075 tmp <- getNewRegNat rep
1076 return (tmp, code tmp)
1080 -- A bit like getSomeReg, but we want a reg that can be byte-addressed.
1081 -- Fixed registers might not be byte-addressable, so we make sure we've
1082 -- got a temporary, inserting an extra reg copy if necessary.
1083 getByteReg :: CmmExpr -> NatM (Reg, InstrBlock)
1084 getByteReg expr = do
1085 r <- getRegister expr
1088 tmp <- getNewRegNat rep
1089 return (tmp, code tmp)
1091 | isVirtualReg reg -> return (reg,code)
1093 tmp <- getNewRegNat rep
1094 return (tmp, code `snocOL` reg2reg rep reg tmp)
1095 -- ToDo: could optimise slightly by checking for byte-addressable
1096 -- real registers, but that will happen very rarely if at all.
1098 -- Another variant: this time we want the result in a register that cannot
1099 -- be modified by code to evaluate an arbitrary expression.
1100 getNonClobberedReg :: CmmExpr -> NatM (Reg, InstrBlock)
1101 getNonClobberedReg expr = do
1102 r <- getRegister expr
1105 tmp <- getNewRegNat rep
1106 return (tmp, code tmp)
1108 -- only free regs can be clobbered
1109 | RealReg rr <- reg, isFastTrue (freeReg rr) -> do
1110 tmp <- getNewRegNat rep
1111 return (tmp, code `snocOL` reg2reg rep reg tmp)
1115 reg2reg :: MachRep -> Reg -> Reg -> Instr
1117 | isFloatingRep rep = GMOV src dst
1118 | otherwise = MOV rep (OpReg src) (OpReg dst)
1120 #endif /* i386_TARGET_ARCH */
1122 -- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
1124 #if sparc_TARGET_ARCH
1126 getRegister (StFloat d)
1127 = getBlockIdNat `thenNat` \ lbl ->
1128 getNewRegNat PtrRep `thenNat` \ tmp ->
1129 let code dst = toOL [
1130 SEGMENT DataSegment,
1132 DATA F [ImmFloat d],
1133 SEGMENT TextSegment,
1134 SETHI (HI (ImmCLbl lbl)) tmp,
1135 LD F (AddrRegImm tmp (LO (ImmCLbl lbl))) dst]
1137 return (Any F32 code)
1139 getRegister (StDouble d)
1140 = getBlockIdNat `thenNat` \ lbl ->
1141 getNewRegNat PtrRep `thenNat` \ tmp ->
1142 let code dst = toOL [
1143 SEGMENT DataSegment,
1145 DATA DF [ImmDouble d],
1146 SEGMENT TextSegment,
1147 SETHI (HI (ImmCLbl lbl)) tmp,
1148 LD DF (AddrRegImm tmp (LO (ImmCLbl lbl))) dst]
1150 return (Any F64 code)
1153 getRegister (CmmMachOp mop [x]) -- unary PrimOps
1155 MO_NatS_Neg -> trivialUCode (SUB False False g0) x
1156 MO_Nat_Not -> trivialUCode (XNOR False g0) x
1157 MO_32U_to_8U -> trivialCode (AND False) x (StInt 255)
1159 MO_F32_Neg -> trivialUFCode F32 (FNEG F) x
1160 MO_F64_Neg -> trivialUFCode F64 (FNEG DF) x
1162 MO_F64_to_Flt -> coerceDbl2Flt x
1163 MO_F32_to_Dbl -> coerceFlt2Dbl x
1165 MO_F32_to_NatS -> coerceFP2Int F32 x
1166 MO_NatS_to_Flt -> coerceInt2FP F32 x
1167 MO_F64_to_NatS -> coerceFP2Int F64 x
1168 MO_NatS_to_Dbl -> coerceInt2FP F64 x
1170 -- Conversions which are a nop on sparc
1171 MO_32U_to_NatS -> conversionNop IntRep x
1172 MO_32S_to_NatS -> conversionNop IntRep x
1173 MO_NatS_to_32U -> conversionNop WordRep x
1174 MO_32U_to_NatU -> conversionNop WordRep x
1176 MO_NatU_to_NatS -> conversionNop IntRep x
1177 MO_NatS_to_NatU -> conversionNop WordRep x
1178 MO_NatP_to_NatU -> conversionNop WordRep x
1179 MO_NatU_to_NatP -> conversionNop PtrRep x
1180 MO_NatS_to_NatP -> conversionNop PtrRep x
1181 MO_NatP_to_NatS -> conversionNop IntRep x
1183 -- sign-extending widenings
1184 MO_8U_to_32U -> integerExtend False 24 x
1185 MO_8U_to_NatU -> integerExtend False 24 x
1186 MO_8S_to_NatS -> integerExtend True 24 x
1187 MO_16U_to_NatU -> integerExtend False 16 x
1188 MO_16S_to_NatS -> integerExtend True 16 x
1191 let fixed_x = if is_float_op -- promote to double
1192 then CmmMachOp MO_F32_to_Dbl [x]
1195 getRegister (StCall (Left fn) CCallConv F64 [fixed_x])
1197 integerExtend signed nBits x
1199 CmmMachOp (if signed then MO_Nat_Sar else MO_Nat_Shr)
1200 [CmmMachOp MO_Nat_Shl [x, StInt nBits], StInt nBits]
1202 conversionNop new_rep expr
1203 = getRegister expr `thenNat` \ e_code ->
1204 return (swizzleRegisterRep e_code new_rep)
1208 MO_F32_Exp -> (True, FSLIT("exp"))
1209 MO_F32_Log -> (True, FSLIT("log"))
1210 MO_F32_Sqrt -> (True, FSLIT("sqrt"))
1212 MO_F32_Sin -> (True, FSLIT("sin"))
1213 MO_F32_Cos -> (True, FSLIT("cos"))
1214 MO_F32_Tan -> (True, FSLIT("tan"))
1216 MO_F32_Asin -> (True, FSLIT("asin"))
1217 MO_F32_Acos -> (True, FSLIT("acos"))
1218 MO_F32_Atan -> (True, FSLIT("atan"))
1220 MO_F32_Sinh -> (True, FSLIT("sinh"))
1221 MO_F32_Cosh -> (True, FSLIT("cosh"))
1222 MO_F32_Tanh -> (True, FSLIT("tanh"))
1224 MO_F64_Exp -> (False, FSLIT("exp"))
1225 MO_F64_Log -> (False, FSLIT("log"))
1226 MO_F64_Sqrt -> (False, FSLIT("sqrt"))
1228 MO_F64_Sin -> (False, FSLIT("sin"))
1229 MO_F64_Cos -> (False, FSLIT("cos"))
1230 MO_F64_Tan -> (False, FSLIT("tan"))
1232 MO_F64_Asin -> (False, FSLIT("asin"))
1233 MO_F64_Acos -> (False, FSLIT("acos"))
1234 MO_F64_Atan -> (False, FSLIT("atan"))
1236 MO_F64_Sinh -> (False, FSLIT("sinh"))
1237 MO_F64_Cosh -> (False, FSLIT("cosh"))
1238 MO_F64_Tanh -> (False, FSLIT("tanh"))
1240 other -> pprPanic "getRegister(sparc) - binary CmmMachOp (2)"
1244 getRegister (CmmMachOp mop [x, y]) -- dyadic PrimOps
1246 MO_32U_Gt -> condIntReg GTT x y
1247 MO_32U_Ge -> condIntReg GE x y
1248 MO_32U_Eq -> condIntReg EQQ x y
1249 MO_32U_Ne -> condIntReg NE x y
1250 MO_32U_Lt -> condIntReg LTT x y
1251 MO_32U_Le -> condIntReg LE x y
1253 MO_Nat_Eq -> condIntReg EQQ x y
1254 MO_Nat_Ne -> condIntReg NE x y
1256 MO_NatS_Gt -> condIntReg GTT x y
1257 MO_NatS_Ge -> condIntReg GE x y
1258 MO_NatS_Lt -> condIntReg LTT x y
1259 MO_NatS_Le -> condIntReg LE x y
1261 MO_NatU_Gt -> condIntReg GU x y
1262 MO_NatU_Ge -> condIntReg GEU x y
1263 MO_NatU_Lt -> condIntReg LU x y
1264 MO_NatU_Le -> condIntReg LEU x y
1266 MO_F32_Gt -> condFltReg GTT x y
1267 MO_F32_Ge -> condFltReg GE x y
1268 MO_F32_Eq -> condFltReg EQQ x y
1269 MO_F32_Ne -> condFltReg NE x y
1270 MO_F32_Lt -> condFltReg LTT x y
1271 MO_F32_Le -> condFltReg LE x y
1273 MO_F64_Gt -> condFltReg GTT x y
1274 MO_F64_Ge -> condFltReg GE x y
1275 MO_F64_Eq -> condFltReg EQQ x y
1276 MO_F64_Ne -> condFltReg NE x y
1277 MO_F64_Lt -> condFltReg LTT x y
1278 MO_F64_Le -> condFltReg LE x y
1280 MO_Nat_Add -> trivialCode (ADD False False) x y
1281 MO_Nat_Sub -> trivialCode (SUB False False) x y
1283 MO_NatS_Mul -> trivialCode (SMUL False) x y
1284 MO_NatU_Mul -> trivialCode (UMUL False) x y
1285 MO_NatS_MulMayOflo -> imulMayOflo x y
1287 -- ToDo: teach about V8+ SPARC div instructions
1288 MO_NatS_Quot -> idiv FSLIT(".div") x y
1289 MO_NatS_Rem -> idiv FSLIT(".rem") x y
1290 MO_NatU_Quot -> idiv FSLIT(".udiv") x y
1291 MO_NatU_Rem -> idiv FSLIT(".urem") x y
1293 MO_F32_Add -> trivialFCode F32 FADD x y
1294 MO_F32_Sub -> trivialFCode F32 FSUB x y
1295 MO_F32_Mul -> trivialFCode F32 FMUL x y
1296 MO_F32_Div -> trivialFCode F32 FDIV x y
1298 MO_F64_Add -> trivialFCode F64 FADD x y
1299 MO_F64_Sub -> trivialFCode F64 FSUB x y
1300 MO_F64_Mul -> trivialFCode F64 FMUL x y
1301 MO_F64_Div -> trivialFCode F64 FDIV x y
1303 MO_Nat_And -> trivialCode (AND False) x y
1304 MO_Nat_Or -> trivialCode (OR False) x y
1305 MO_Nat_Xor -> trivialCode (XOR False) x y
1307 MO_Nat_Shl -> trivialCode SLL x y
1308 MO_Nat_Shr -> trivialCode SRL x y
1309 MO_Nat_Sar -> trivialCode SRA x y
1311 MO_F32_Pwr -> getRegister (StCall (Left FSLIT("pow")) CCallConv F64
1312 [promote x, promote y])
1313 where promote x = CmmMachOp MO_F32_to_Dbl [x]
1314 MO_F64_Pwr -> getRegister (StCall (Left FSLIT("pow")) CCallConv F64
1317 other -> pprPanic "getRegister(sparc) - binary CmmMachOp (1)" (pprMachOp mop)
1319 idiv fn x y = getRegister (StCall (Left fn) CCallConv IntRep [x, y])
1321 --------------------
1322 imulMayOflo :: CmmExpr -> CmmExpr -> NatM Register
1324 = getNewRegNat IntRep `thenNat` \ t1 ->
1325 getNewRegNat IntRep `thenNat` \ t2 ->
1326 getNewRegNat IntRep `thenNat` \ res_lo ->
1327 getNewRegNat IntRep `thenNat` \ res_hi ->
1328 getRegister a1 `thenNat` \ reg1 ->
1329 getRegister a2 `thenNat` \ reg2 ->
1330 let code1 = registerCode reg1 t1
1331 code2 = registerCode reg2 t2
1332 src1 = registerName reg1 t1
1333 src2 = registerName reg2 t2
1334 code dst = code1 `appOL` code2 `appOL`
1336 SMUL False src1 (RIReg src2) res_lo,
1338 SRA res_lo (RIImm (ImmInt 31)) res_lo,
1339 SUB False False res_lo (RIReg res_hi) dst
1342 return (Any IntRep code)
1344 getRegister (CmmLoad pk mem) = do
1345 Amode src code <- getAmode mem
1347 size = primRepToSize pk
1348 code__2 dst = code `snocOL` LD size src dst
1350 return (Any pk code__2)
1352 getRegister (StInt i)
1355 src = ImmInt (fromInteger i)
1356 code dst = unitOL (OR False g0 (RIImm src) dst)
1358 return (Any IntRep code)
1364 SETHI (HI imm__2) dst,
1365 OR False dst (RIImm (LO imm__2)) dst]
1367 return (Any PtrRep code)
1369 = ncgPrimopMoan "getRegister(sparc)" (pprCmmExpr leaf)
1372 imm__2 = case imm of Just x -> x
1374 #endif /* sparc_TARGET_ARCH */
1376 #if powerpc_TARGET_ARCH
1377 getRegister (CmmLoad mem pk)
1380 Amode addr addr_code <- getAmode mem
1381 let code dst = ASSERT((regClass dst == RcDouble) == isFloatingRep pk)
1382 addr_code `snocOL` LD pk dst addr
1383 return (Any pk code)
1385 -- catch simple cases of zero- or sign-extended load
1386 getRegister (CmmMachOp (MO_U_Conv I8 I32) [CmmLoad mem _]) = do
1387 Amode addr addr_code <- getAmode mem
1388 return (Any I32 (\dst -> addr_code `snocOL` LD I8 dst addr))
1390 -- Note: there is no Load Byte Arithmetic instruction, so no signed case here
1392 getRegister (CmmMachOp (MO_U_Conv I16 I32) [CmmLoad mem _]) = do
1393 Amode addr addr_code <- getAmode mem
1394 return (Any I32 (\dst -> addr_code `snocOL` LD I16 dst addr))
1396 getRegister (CmmMachOp (MO_S_Conv I16 I32) [CmmLoad mem _]) = do
1397 Amode addr addr_code <- getAmode mem
1398 return (Any I32 (\dst -> addr_code `snocOL` LA I16 dst addr))
1400 getRegister (CmmMachOp mop [x]) -- unary MachOps
1402 MO_Not rep -> trivialUCode rep NOT x
1404 MO_S_Conv F64 F32 -> trivialUCode F32 FRSP x
1405 MO_S_Conv F32 F64 -> conversionNop F64 x
1408 | from == to -> conversionNop to x
1409 | isFloatingRep from -> coerceFP2Int from to x
1410 | isFloatingRep to -> coerceInt2FP from to x
1412 -- narrowing is a nop: we treat the high bits as undefined
1413 MO_S_Conv I32 to -> conversionNop to x
1414 MO_S_Conv I16 I8 -> conversionNop I8 x
1415 MO_S_Conv I8 to -> trivialUCode to (EXTS I8) x
1416 MO_S_Conv I16 to -> trivialUCode to (EXTS I16) x
1419 | from == to -> conversionNop to x
1420 -- narrowing is a nop: we treat the high bits as undefined
1421 MO_U_Conv I32 to -> conversionNop to x
1422 MO_U_Conv I16 I8 -> conversionNop I8 x
1423 MO_U_Conv I8 to -> trivialCode to False AND x (CmmLit (CmmInt 255 I32))
1424 MO_U_Conv I16 to -> trivialCode to False AND x (CmmLit (CmmInt 65535 I32))
1426 MO_S_Neg F32 -> trivialUCode F32 FNEG x
1427 MO_S_Neg F64 -> trivialUCode F64 FNEG x
1428 MO_S_Neg rep -> trivialUCode rep NEG x
1431 conversionNop new_rep expr
1432 = do e_code <- getRegister expr
1433 return (swizzleRegisterRep e_code new_rep)
1435 getRegister (CmmMachOp mop [x, y]) -- dyadic PrimOps
1437 MO_Eq F32 -> condFltReg EQQ x y
1438 MO_Ne F32 -> condFltReg NE x y
1440 MO_S_Gt F32 -> condFltReg GTT x y
1441 MO_S_Ge F32 -> condFltReg GE x y
1442 MO_S_Lt F32 -> condFltReg LTT x y
1443 MO_S_Le F32 -> condFltReg LE x y
1445 MO_Eq F64 -> condFltReg EQQ x y
1446 MO_Ne F64 -> condFltReg NE x y
1448 MO_S_Gt F64 -> condFltReg GTT x y
1449 MO_S_Ge F64 -> condFltReg GE x y
1450 MO_S_Lt F64 -> condFltReg LTT x y
1451 MO_S_Le F64 -> condFltReg LE x y
1453 MO_Eq rep -> condIntReg EQQ (extendUExpr rep x) (extendUExpr rep y)
1454 MO_Ne rep -> condIntReg NE (extendUExpr rep x) (extendUExpr rep y)
1456 MO_S_Gt rep -> condIntReg GTT (extendSExpr rep x) (extendSExpr rep y)
1457 MO_S_Ge rep -> condIntReg GE (extendSExpr rep x) (extendSExpr rep y)
1458 MO_S_Lt rep -> condIntReg LTT (extendSExpr rep x) (extendSExpr rep y)
1459 MO_S_Le rep -> condIntReg LE (extendSExpr rep x) (extendSExpr rep y)
1461 MO_U_Gt rep -> condIntReg GU (extendUExpr rep x) (extendUExpr rep y)
1462 MO_U_Ge rep -> condIntReg GEU (extendUExpr rep x) (extendUExpr rep y)
1463 MO_U_Lt rep -> condIntReg LU (extendUExpr rep x) (extendUExpr rep y)
1464 MO_U_Le rep -> condIntReg LEU (extendUExpr rep x) (extendUExpr rep y)
1466 MO_Add F32 -> trivialCodeNoImm F32 (FADD F32) x y
1467 MO_Sub F32 -> trivialCodeNoImm F32 (FSUB F32) x y
1468 MO_Mul F32 -> trivialCodeNoImm F32 (FMUL F32) x y
1469 MO_S_Quot F32 -> trivialCodeNoImm F32 (FDIV F32) x y
1471 MO_Add F64 -> trivialCodeNoImm F64 (FADD F64) x y
1472 MO_Sub F64 -> trivialCodeNoImm F64 (FSUB F64) x y
1473 MO_Mul F64 -> trivialCodeNoImm F64 (FMUL F64) x y
1474 MO_S_Quot F64 -> trivialCodeNoImm F64 (FDIV F64) x y
1476 -- optimize addition with 32-bit immediate
1480 CmmLit (CmmInt imm immrep) | Just _ <- makeImmediate I32 True (-imm)
1481 -> trivialCode I32 True ADD x (CmmLit $ CmmInt imm immrep)
1484 (src, srcCode) <- getSomeReg x
1485 let imm = litToImm lit
1486 code dst = srcCode `appOL` toOL [
1487 ADDIS dst src (HA imm),
1488 ADD dst dst (RIImm (LO imm))
1490 return (Any I32 code)
1491 _ -> trivialCode I32 True ADD x y
1493 MO_Add rep -> trivialCode rep True ADD x y
1495 case y of -- subfi ('substract from' with immediate) doesn't exist
1496 CmmLit (CmmInt imm immrep) | Just _ <- makeImmediate rep True (-imm)
1497 -> trivialCode rep True ADD x (CmmLit $ CmmInt (-imm) immrep)
1498 _ -> trivialCodeNoImm rep SUBF y x
1500 MO_Mul rep -> trivialCode rep True MULLW x y
1502 MO_S_MulMayOflo I32 -> trivialCodeNoImm I32 MULLW_MayOflo x y
1504 MO_S_MulMayOflo rep -> panic "S_MulMayOflo (rep /= I32): not implemented"
1505 MO_U_MulMayOflo rep -> panic "U_MulMayOflo: not implemented"
1507 MO_S_Quot rep -> trivialCodeNoImm rep DIVW (extendSExpr rep x) (extendSExpr rep y)
1508 MO_U_Quot rep -> trivialCodeNoImm rep DIVWU (extendUExpr rep x) (extendUExpr rep y)
1510 MO_S_Rem rep -> remainderCode rep DIVW (extendSExpr rep x) (extendSExpr rep y)
1511 MO_U_Rem rep -> remainderCode rep DIVWU (extendUExpr rep x) (extendUExpr rep y)
1513 MO_And rep -> trivialCode rep False AND x y
1514 MO_Or rep -> trivialCode rep False OR x y
1515 MO_Xor rep -> trivialCode rep False XOR x y
1517 MO_Shl rep -> trivialCode rep False SLW x y
1518 MO_S_Shr rep -> trivialCode rep False SRAW (extendSExpr rep x) y
1519 MO_U_Shr rep -> trivialCode rep False SRW (extendUExpr rep x) y
1521 getRegister (CmmLit (CmmInt i rep))
1522 | Just imm <- makeImmediate rep True i
1524 code dst = unitOL (LI dst imm)
1526 return (Any rep code)
1528 getRegister (CmmLit (CmmFloat f frep)) = do
1529 lbl <- getNewLabelNat
1530 dynRef <- cmmMakeDynamicReference addImportNat False lbl
1531 Amode addr addr_code <- getAmode dynRef
1533 LDATA ReadOnlyData [CmmDataLabel lbl,
1534 CmmStaticLit (CmmFloat f frep)]
1535 `consOL` (addr_code `snocOL` LD frep dst addr)
1536 return (Any frep code)
1538 getRegister (CmmLit lit)
1539 = let rep = cmmLitRep lit
1543 OR dst dst (RIImm (LO imm))
1545 in return (Any rep code)
1547 getRegister other = pprPanic "getRegister(ppc)" (pprExpr other)
1549 -- extend?Rep: wrap integer expression of type rep
1550 -- in a conversion to I32
1551 extendSExpr I32 x = x
1552 extendSExpr rep x = CmmMachOp (MO_S_Conv rep I32) [x]
1553 extendUExpr I32 x = x
1554 extendUExpr rep x = CmmMachOp (MO_U_Conv rep I32) [x]
1556 -- ###FIXME: exact code duplication from x86 case
1557 -- The dual to getAnyReg: compute an expression into a register, but
1558 -- we don't mind which one it is.
1559 getSomeReg :: CmmExpr -> NatM (Reg, InstrBlock)
1560 getSomeReg expr = do
1561 r <- getRegister expr
1564 tmp <- getNewRegNat rep
1565 return (tmp, code tmp)
1569 #endif /* powerpc_TARGET_ARCH */
1572 -- -----------------------------------------------------------------------------
1573 -- The 'Amode' type: Memory addressing modes passed up the tree.
1575 data Amode = Amode AddrMode InstrBlock
1578 Now, given a tree (the argument to an CmmLoad) that references memory,
1579 produce a suitable addressing mode.
1581 A Rule of the Game (tm) for Amodes: use of the addr bit must
1582 immediately follow use of the code part, since the code part puts
1583 values in registers which the addr then refers to. So you can't put
1584 anything in between, lest it overwrite some of those registers. If
1585 you need to do some other computation between the code part and use of
1586 the addr bit, first store the effective address from the amode in a
1587 temporary, then do the other computation, and then use the temporary:
1591 ... other computation ...
1595 getAmode :: CmmExpr -> NatM Amode
1596 getAmode tree@(CmmRegOff _ _) = getAmode (mangleIndexTree tree)
1598 -- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
1600 #if alpha_TARGET_ARCH
1602 getAmode (StPrim IntSubOp [x, StInt i])
1603 = getNewRegNat PtrRep `thenNat` \ tmp ->
1604 getRegister x `thenNat` \ register ->
1606 code = registerCode register tmp
1607 reg = registerName register tmp
1608 off = ImmInt (-(fromInteger i))
1610 return (Amode (AddrRegImm reg off) code)
1612 getAmode (StPrim IntAddOp [x, StInt i])
1613 = getNewRegNat PtrRep `thenNat` \ tmp ->
1614 getRegister x `thenNat` \ register ->
1616 code = registerCode register tmp
1617 reg = registerName register tmp
1618 off = ImmInt (fromInteger i)
1620 return (Amode (AddrRegImm reg off) code)
1624 = return (Amode (AddrImm imm__2) id)
1627 imm__2 = case imm of Just x -> x
1630 = getNewRegNat PtrRep `thenNat` \ tmp ->
1631 getRegister other `thenNat` \ register ->
1633 code = registerCode register tmp
1634 reg = registerName register tmp
1636 return (Amode (AddrReg reg) code)
1638 #endif /* alpha_TARGET_ARCH */
1640 -- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
1642 #if i386_TARGET_ARCH
1644 -- This is all just ridiculous, since it carefully undoes
1645 -- what mangleIndexTree has just done.
1646 getAmode (CmmMachOp (MO_Sub rep) [x, CmmLit (CmmInt i _)])
1647 -- ASSERT(rep == I32)???
1648 = do (x_reg, x_code) <- getSomeReg x
1649 let off = ImmInt (-(fromInteger i))
1650 return (Amode (AddrBaseIndex (Just x_reg) Nothing off) x_code)
1652 getAmode (CmmMachOp (MO_Add rep) [x, CmmLit (CmmInt i _)])
1653 -- ASSERT(rep == I32)???
1654 = do (x_reg, x_code) <- getSomeReg x
1655 let off = ImmInt (fromInteger i)
1656 return (Amode (AddrBaseIndex (Just x_reg) Nothing off) x_code)
1658 -- Turn (lit1 << n + lit2) into (lit2 + lit1 << n) so it will be
1659 -- recognised by the next rule.
1660 getAmode (CmmMachOp (MO_Add rep) [a@(CmmMachOp (MO_Shl _) _),
1662 = getAmode (CmmMachOp (MO_Add rep) [b,a])
1664 getAmode (CmmMachOp (MO_Add rep) [x, CmmMachOp (MO_Shl _)
1665 [y, CmmLit (CmmInt shift _)]])
1666 | shift == 0 || shift == 1 || shift == 2 || shift == 3
1667 = do (x_reg, x_code) <- getNonClobberedReg x
1668 -- x must be in a temp, because it has to stay live over y_code
1669 -- we could compre x_reg and y_reg and do something better here...
1670 (y_reg, y_code) <- getSomeReg y
1672 code = x_code `appOL` y_code
1673 base = case shift of 0 -> 1; 1 -> 2; 2 -> 4; 3 -> 8
1674 return (Amode (AddrBaseIndex (Just x_reg) (Just (y_reg,base)) (ImmInt 0))
1677 getAmode (CmmLit lit)
1678 = return (Amode (ImmAddr (litToImm lit) 0) nilOL)
1681 (reg,code) <- getSomeReg expr
1682 return (Amode (AddrBaseIndex (Just reg) Nothing (ImmInt 0)) code)
1684 #endif /* i386_TARGET_ARCH */
1686 -- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
1688 #if sparc_TARGET_ARCH
1690 getAmode (CmmMachOp MO_Nat_Sub [x, StInt i])
1692 = getNewRegNat PtrRep `thenNat` \ tmp ->
1693 getRegister x `thenNat` \ register ->
1695 code = registerCode register tmp
1696 reg = registerName register tmp
1697 off = ImmInt (-(fromInteger i))
1699 return (Amode (AddrRegImm reg off) code)
1702 getAmode (CmmMachOp MO_Nat_Add [x, StInt i])
1704 = getNewRegNat PtrRep `thenNat` \ tmp ->
1705 getRegister x `thenNat` \ register ->
1707 code = registerCode register tmp
1708 reg = registerName register tmp
1709 off = ImmInt (fromInteger i)
1711 return (Amode (AddrRegImm reg off) code)
1713 getAmode (CmmMachOp MO_Nat_Add [x, y])
1714 = getNewRegNat PtrRep `thenNat` \ tmp1 ->
1715 getNewRegNat IntRep `thenNat` \ tmp2 ->
1716 getRegister x `thenNat` \ register1 ->
1717 getRegister y `thenNat` \ register2 ->
1719 code1 = registerCode register1 tmp1
1720 reg1 = registerName register1 tmp1
1721 code2 = registerCode register2 tmp2
1722 reg2 = registerName register2 tmp2
1723 code__2 = code1 `appOL` code2
1725 return (Amode (AddrRegReg reg1 reg2) code__2)
1729 = getNewRegNat PtrRep `thenNat` \ tmp ->
1731 code = unitOL (SETHI (HI imm__2) tmp)
1733 return (Amode (AddrRegImm tmp (LO imm__2)) code)
1736 imm__2 = case imm of Just x -> x
1739 = getNewRegNat PtrRep `thenNat` \ tmp ->
1740 getRegister other `thenNat` \ register ->
1742 code = registerCode register tmp
1743 reg = registerName register tmp
1746 return (Amode (AddrRegImm reg off) code)
1748 #endif /* sparc_TARGET_ARCH */
1750 #ifdef powerpc_TARGET_ARCH
1751 getAmode (CmmMachOp (MO_Sub I32) [x, CmmLit (CmmInt i _)])
1752 | Just off <- makeImmediate I32 True (-i)
1754 (reg, code) <- getSomeReg x
1755 return (Amode (AddrRegImm reg off) code)
1758 getAmode (CmmMachOp (MO_Add I32) [x, CmmLit (CmmInt i _)])
1759 | Just off <- makeImmediate I32 True i
1761 (reg, code) <- getSomeReg x
1762 return (Amode (AddrRegImm reg off) code)
1764 -- optimize addition with 32-bit immediate
1766 getAmode (CmmMachOp (MO_Add I32) [x, CmmLit lit])
1768 tmp <- getNewRegNat I32
1769 (src, srcCode) <- getSomeReg x
1770 let imm = litToImm lit
1771 code = srcCode `snocOL` ADDIS tmp src (HA imm)
1772 return (Amode (AddrRegImm tmp (LO imm)) code)
1774 getAmode (CmmLit lit)
1776 tmp <- getNewRegNat I32
1777 let imm = litToImm lit
1778 code = unitOL (LIS tmp (HA imm))
1779 return (Amode (AddrRegImm tmp (LO imm)) code)
1781 getAmode (CmmMachOp (MO_Add I32) [x, y])
1783 (regX, codeX) <- getSomeReg x
1784 (regY, codeY) <- getSomeReg y
1785 return (Amode (AddrRegReg regX regY) (codeX `appOL` codeY))
1789 (reg, code) <- getSomeReg other
1792 return (Amode (AddrRegImm reg off) code)
1793 #endif /* powerpc_TARGET_ARCH */
1795 -- -----------------------------------------------------------------------------
1796 -- getOperand: sometimes any operand will do.
1798 -- getOperand gets a *safe* operand; that is, the value of the operand
1799 -- will remain valid across the computation of an arbitrary expression,
1800 -- unless the expression is computed directly into a register which
1801 -- the operand refers to (see trivialCode where this function is used
1804 #ifdef i386_TARGET_ARCH
1806 getOperand :: CmmExpr -> NatM (Operand, InstrBlock)
1807 getOperand (CmmLoad mem pk)
1808 | not (isFloatingRep pk) && pk /= I64 = do
1809 Amode src mem_code <- getAmode mem
1811 if (amodeCouldBeClobbered src)
1813 tmp <- getNewRegNat wordRep
1814 return (AddrBaseIndex (Just tmp) Nothing (ImmInt 0),
1815 unitOL (LEA I32 (OpAddr src) (OpReg tmp)))
1818 return (OpAddr src', save_code `appOL` mem_code)
1821 (reg, code) <- getNonClobberedReg e
1822 return (OpReg reg, code)
1824 amodeCouldBeClobbered :: AddrMode -> Bool
1825 amodeCouldBeClobbered amode = any regClobbered (addrModeRegs amode)
1827 regClobbered (RealReg rr) = isFastTrue (freeReg rr)
1828 regClobbered _ = False
1832 -- -----------------------------------------------------------------------------
1833 -- The 'CondCode' type: Condition codes passed up the tree.
1835 data CondCode = CondCode Bool Cond InstrBlock
1837 -- Set up a condition code for a conditional branch.
1839 getCondCode :: CmmExpr -> NatM CondCode
1841 -- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
1843 #if alpha_TARGET_ARCH
1844 getCondCode = panic "MachCode.getCondCode: not on Alphas"
1845 #endif /* alpha_TARGET_ARCH */
1847 -- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
1849 #if i386_TARGET_ARCH || sparc_TARGET_ARCH
1850 -- yes, they really do seem to want exactly the same!
1852 getCondCode (CmmMachOp mop [x, y])
1853 = ASSERT (cmmExprRep x /= I8) -- tmp, not set up to handle 8-bit comparisons
1855 MO_Eq F32 -> condFltCode EQQ x y
1856 MO_Ne F32 -> condFltCode NE x y
1858 MO_S_Gt F32 -> condFltCode GTT x y
1859 MO_S_Ge F32 -> condFltCode GE x y
1860 MO_S_Lt F32 -> condFltCode LTT x y
1861 MO_S_Le F32 -> condFltCode LE x y
1863 MO_Eq F64 -> condFltCode EQQ x y
1864 MO_Ne F64 -> condFltCode NE x y
1866 MO_S_Gt F64 -> condFltCode GTT x y
1867 MO_S_Ge F64 -> condFltCode GE x y
1868 MO_S_Lt F64 -> condFltCode LTT x y
1869 MO_S_Le F64 -> condFltCode LE x y
1871 MO_Eq rep -> condIntCode EQQ x y
1872 MO_Ne rep -> condIntCode NE x y
1874 MO_S_Gt rep -> condIntCode GTT x y
1875 MO_S_Ge rep -> condIntCode GE x y
1876 MO_S_Lt rep -> condIntCode LTT x y
1877 MO_S_Le rep -> condIntCode LE x y
1879 MO_U_Gt rep -> condIntCode GU x y
1880 MO_U_Ge rep -> condIntCode GEU x y
1881 MO_U_Lt rep -> condIntCode LU x y
1882 MO_U_Le rep -> condIntCode LEU x y
1884 other -> pprPanic "getCondCode(x86,sparc)" (pprMachOp mop)
1886 getCondCode other = pprPanic "getCondCode(2)(x86,sparc)" (ppr other)
1888 #elif powerpc_TARGET_ARCH
1890 -- almost the same as everywhere else - but we need to
1891 -- extend small integers to 32 bit first
1893 getCondCode (CmmMachOp mop [x, y])
1895 MO_Eq F32 -> condFltCode EQQ x y
1896 MO_Ne F32 -> condFltCode NE x y
1898 MO_S_Gt F32 -> condFltCode GTT x y
1899 MO_S_Ge F32 -> condFltCode GE x y
1900 MO_S_Lt F32 -> condFltCode LTT x y
1901 MO_S_Le F32 -> condFltCode LE x y
1903 MO_Eq F64 -> condFltCode EQQ x y
1904 MO_Ne F64 -> condFltCode NE x y
1906 MO_S_Gt F64 -> condFltCode GTT x y
1907 MO_S_Ge F64 -> condFltCode GE x y
1908 MO_S_Lt F64 -> condFltCode LTT x y
1909 MO_S_Le F64 -> condFltCode LE x y
1911 MO_Eq rep -> condIntCode EQQ (extendUExpr rep x) (extendUExpr rep y)
1912 MO_Ne rep -> condIntCode NE (extendUExpr rep x) (extendUExpr rep y)
1914 MO_S_Gt rep -> condIntCode GTT (extendSExpr rep x) (extendSExpr rep y)
1915 MO_S_Ge rep -> condIntCode GE (extendSExpr rep x) (extendSExpr rep y)
1916 MO_S_Lt rep -> condIntCode LTT (extendSExpr rep x) (extendSExpr rep y)
1917 MO_S_Le rep -> condIntCode LE (extendSExpr rep x) (extendSExpr rep y)
1919 MO_U_Gt rep -> condIntCode GU (extendUExpr rep x) (extendUExpr rep y)
1920 MO_U_Ge rep -> condIntCode GEU (extendUExpr rep x) (extendUExpr rep y)
1921 MO_U_Lt rep -> condIntCode LU (extendUExpr rep x) (extendUExpr rep y)
1922 MO_U_Le rep -> condIntCode LEU (extendUExpr rep x) (extendUExpr rep y)
1924 other -> pprPanic "getCondCode(powerpc)" (pprMachOp mop)
1926 getCondCode other = panic "getCondCode(2)(powerpc)"
1932 -- @cond(Int|Flt)Code@: Turn a boolean expression into a condition, to be
1933 -- passed back up the tree.
1935 condIntCode, condFltCode :: Cond -> CmmExpr -> CmmExpr -> NatM CondCode
1937 #if alpha_TARGET_ARCH
1938 condIntCode = panic "MachCode.condIntCode: not on Alphas"
1939 condFltCode = panic "MachCode.condFltCode: not on Alphas"
1940 #endif /* alpha_TARGET_ARCH */
1942 -- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
1943 #if i386_TARGET_ARCH
1945 -- memory vs immediate
1946 condIntCode cond (CmmLoad x pk) (CmmLit lit) = do
1947 Amode x_addr x_code <- getAmode x
1950 code = x_code `snocOL`
1951 CMP pk (OpImm imm) (OpAddr x_addr)
1953 return (CondCode False cond code)
1956 condIntCode cond x (CmmLit (CmmInt 0 pk)) = do
1957 (x_reg, x_code) <- getSomeReg x
1959 code = x_code `snocOL`
1960 TEST pk (OpReg x_reg) (OpReg x_reg)
1962 return (CondCode False cond code)
1964 -- anything vs immediate
1965 condIntCode cond x (CmmLit lit) = do
1966 (x_reg, x_code) <- getSomeReg x
1969 code = x_code `snocOL`
1970 CMP (cmmLitRep lit) (OpImm imm) (OpReg x_reg)
1972 return (CondCode False cond code)
1974 -- memory vs anything
1975 condIntCode cond (CmmLoad x pk) y = do
1976 (y_reg, y_code) <- getNonClobberedReg y
1977 Amode x_addr x_code <- getAmode x
1979 code = y_code `appOL`
1981 CMP pk (OpReg y_reg) (OpAddr x_addr)
1983 return (CondCode False cond code)
1985 -- anything vs memory
1986 condIntCode cond y (CmmLoad x pk) = do
1987 (y_reg, y_code) <- getNonClobberedReg y
1988 Amode x_addr x_code <- getAmode x
1990 code = y_code `appOL`
1992 CMP pk (OpAddr x_addr) (OpReg y_reg)
1994 return (CondCode False cond code)
1996 -- anything vs anything
1997 condIntCode cond x y = do
1998 (x_op, x_code) <- getOperand x
1999 (y_reg, y_code) <- getSomeReg y
2001 code = x_code `appOL`
2003 CMP (cmmExprRep x) (OpReg y_reg) x_op
2005 return (CondCode False cond code)
2008 condFltCode cond x y
2009 = ASSERT(cond `elem` ([EQQ, NE, LE, LTT, GE, GTT])) do
2010 (x_reg, x_code) <- getNonClobberedReg x
2011 (y_reg, y_code) <- getSomeReg y
2013 code = x_code `appOL` y_code `snocOL`
2014 GCMP cond x_reg y_reg
2015 -- The GCMP insn does the test and sets the zero flag if comparable
2016 -- and true. Hence we always supply EQQ as the condition to test.
2017 return (CondCode True EQQ code)
2019 #endif /* i386_TARGET_ARCH */
2021 -- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
2023 #if sparc_TARGET_ARCH
2025 condIntCode cond x (StInt y)
2027 = getRegister x `thenNat` \ register ->
2028 getNewRegNat IntRep `thenNat` \ tmp ->
2030 code = registerCode register tmp
2031 src1 = registerName register tmp
2032 src2 = ImmInt (fromInteger y)
2033 code__2 = code `snocOL` SUB False True src1 (RIImm src2) g0
2035 return (CondCode False cond code__2)
2037 condIntCode cond x y
2038 = getRegister x `thenNat` \ register1 ->
2039 getRegister y `thenNat` \ register2 ->
2040 getNewRegNat IntRep `thenNat` \ tmp1 ->
2041 getNewRegNat IntRep `thenNat` \ tmp2 ->
2043 code1 = registerCode register1 tmp1
2044 src1 = registerName register1 tmp1
2045 code2 = registerCode register2 tmp2
2046 src2 = registerName register2 tmp2
2047 code__2 = code1 `appOL` code2 `snocOL`
2048 SUB False True src1 (RIReg src2) g0
2050 return (CondCode False cond code__2)
2053 condFltCode cond x y
2054 = getRegister x `thenNat` \ register1 ->
2055 getRegister y `thenNat` \ register2 ->
2056 getNewRegNat (registerRep register1)
2058 getNewRegNat (registerRep register2)
2060 getNewRegNat F64 `thenNat` \ tmp ->
2062 promote x = FxTOy F DF x tmp
2064 pk1 = registerRep register1
2065 code1 = registerCode register1 tmp1
2066 src1 = registerName register1 tmp1
2068 pk2 = registerRep register2
2069 code2 = registerCode register2 tmp2
2070 src2 = registerName register2 tmp2
2074 code1 `appOL` code2 `snocOL`
2075 FCMP True (primRepToSize pk1) src1 src2
2076 else if pk1 == F32 then
2077 code1 `snocOL` promote src1 `appOL` code2 `snocOL`
2078 FCMP True DF tmp src2
2080 code1 `appOL` code2 `snocOL` promote src2 `snocOL`
2081 FCMP True DF src1 tmp
2083 return (CondCode True cond code__2)
2085 #endif /* sparc_TARGET_ARCH */
2087 #if powerpc_TARGET_ARCH
2088 -- ###FIXME: I16 and I8!
2089 condIntCode cond x (CmmLit (CmmInt y rep))
2090 | Just src2 <- makeImmediate rep (not $ condUnsigned cond) y
2092 (src1, code) <- getSomeReg x
2094 code' = code `snocOL`
2095 (if condUnsigned cond then CMPL else CMP) I32 src1 (RIImm src2)
2096 return (CondCode False cond code')
2098 condIntCode cond x y = do
2099 (src1, code1) <- getSomeReg x
2100 (src2, code2) <- getSomeReg y
2102 code' = code1 `appOL` code2 `snocOL`
2103 (if condUnsigned cond then CMPL else CMP) I32 src1 (RIReg src2)
2104 return (CondCode False cond code')
2106 condFltCode cond x y = do
2107 (src1, code1) <- getSomeReg x
2108 (src2, code2) <- getSomeReg y
2110 code' = code1 `appOL` code2 `snocOL` FCMP src1 src2
2111 code'' = case cond of -- twiddle CR to handle unordered case
2112 GE -> code' `snocOL` CRNOR ltbit eqbit gtbit
2113 LE -> code' `snocOL` CRNOR gtbit eqbit ltbit
2116 ltbit = 0 ; eqbit = 2 ; gtbit = 1
2117 return (CondCode True cond code'')
2119 #endif /* powerpc_TARGET_ARCH */
2121 -- -----------------------------------------------------------------------------
2122 -- Generating assignments
2124 -- Assignments are really at the heart of the whole code generation
2125 -- business. Almost all top-level nodes of any real importance are
2126 -- assignments, which correspond to loads, stores, or register
2127 -- transfers. If we're really lucky, some of the register transfers
2128 -- will go away, because we can use the destination register to
2129 -- complete the code generation for the right hand side. This only
2130 -- fails when the right hand side is forced into a fixed register
2131 -- (e.g. the result of a call).
2133 assignMem_IntCode :: MachRep -> CmmExpr -> CmmExpr -> NatM InstrBlock
2134 assignReg_IntCode :: MachRep -> CmmReg -> CmmExpr -> NatM InstrBlock
2136 assignMem_FltCode :: MachRep -> CmmExpr -> CmmExpr -> NatM InstrBlock
2137 assignReg_FltCode :: MachRep -> CmmReg -> CmmExpr -> NatM InstrBlock
2139 -- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
2141 #if alpha_TARGET_ARCH
2143 assignIntCode pk (CmmLoad dst _) src
2144 = getNewRegNat IntRep `thenNat` \ tmp ->
2145 getAmode dst `thenNat` \ amode ->
2146 getRegister src `thenNat` \ register ->
2148 code1 = amodeCode amode []
2149 dst__2 = amodeAddr amode
2150 code2 = registerCode register tmp []
2151 src__2 = registerName register tmp
2152 sz = primRepToSize pk
2153 code__2 = asmSeqThen [code1, code2] . mkSeqInstr (ST sz src__2 dst__2)
2157 assignIntCode pk dst src
2158 = getRegister dst `thenNat` \ register1 ->
2159 getRegister src `thenNat` \ register2 ->
2161 dst__2 = registerName register1 zeroh
2162 code = registerCode register2 dst__2
2163 src__2 = registerName register2 dst__2
2164 code__2 = if isFixed register2
2165 then code . mkSeqInstr (OR src__2 (RIReg src__2) dst__2)
2170 #endif /* alpha_TARGET_ARCH */
2172 -- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
2174 #if i386_TARGET_ARCH
2176 -- integer assignment to memory
2177 assignMem_IntCode pk addr src = do
2178 Amode addr code_addr <- getAmode addr
2179 (code_src, op_src) <- get_op_RI src
2181 code = code_src `appOL`
2183 MOV pk op_src (OpAddr addr)
2184 -- NOTE: op_src is stable, so it will still be valid
2185 -- after code_addr. This may involve the introduction
2186 -- of an extra MOV to a temporary register, but we hope
2187 -- the register allocator will get rid of it.
2191 get_op_RI :: CmmExpr -> NatM (InstrBlock,Operand) -- code, operator
2192 get_op_RI (CmmLit lit)
2193 = return (nilOL, OpImm (litToImm lit))
2195 = do (reg,code) <- getNonClobberedReg op
2196 return (code, OpReg reg)
2199 -- Assign; dst is a reg, rhs is mem
2200 assignReg_IntCode pk reg (CmmLoad src _) = do
2201 load_code <- intLoadCode (MOV pk) src
2202 return (load_code (getRegisterReg reg))
2204 -- dst is a reg, but src could be anything
2205 assignReg_IntCode pk reg src = do
2206 code <- getAnyReg src
2207 return (code (getRegisterReg reg))
2209 #endif /* i386_TARGET_ARCH */
2211 -- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
2213 #if sparc_TARGET_ARCH
2215 assignMem_IntCode pk addr src
2216 = getNewRegNat IntRep `thenNat` \ tmp ->
2217 getAmode addr `thenNat` \ amode ->
2218 getRegister src `thenNat` \ register ->
2220 code1 = amodeCode amode
2221 dst__2 = amodeAddr amode
2222 code2 = registerCode register tmp
2223 src__2 = registerName register tmp
2224 sz = primRepToSize pk
2225 code__2 = code1 `appOL` code2 `snocOL` ST sz src__2 dst__2
2229 assignReg_IntCode pk reg src
2230 = getRegister src `thenNat` \ register2 ->
2231 getRegisterReg reg `thenNat` \ register1 ->
2232 getNewRegNat IntRep `thenNat` \ tmp ->
2234 dst__2 = registerName register1 tmp
2235 code = registerCode register2 dst__2
2236 src__2 = registerName register2 dst__2
2237 code__2 = if isFixed register2
2238 then code `snocOL` OR False g0 (RIReg src__2) dst__2
2243 #endif /* sparc_TARGET_ARCH */
2245 #if powerpc_TARGET_ARCH
2247 assignMem_IntCode pk addr src = do
2248 (srcReg, code) <- getSomeReg src
2249 Amode dstAddr addr_code <- getAmode addr
2250 return $ code `appOL` addr_code `snocOL` ST pk srcReg dstAddr
2252 -- dst is a reg, but src could be anything
2253 assignReg_IntCode pk reg src
2255 r <- getRegister src
2257 Any _ code -> code dst
2258 Fixed _ freg fcode -> fcode `snocOL` MR dst freg
2260 dst = getRegisterReg reg
2262 #endif /* powerpc_TARGET_ARCH */
2265 -- -----------------------------------------------------------------------------
2266 -- Floating-point assignments
2268 #if alpha_TARGET_ARCH
2270 assignFltCode pk (CmmLoad dst _) src
2271 = getNewRegNat pk `thenNat` \ tmp ->
2272 getAmode dst `thenNat` \ amode ->
2273 getRegister src `thenNat` \ register ->
2275 code1 = amodeCode amode []
2276 dst__2 = amodeAddr amode
2277 code2 = registerCode register tmp []
2278 src__2 = registerName register tmp
2279 sz = primRepToSize pk
2280 code__2 = asmSeqThen [code1, code2] . mkSeqInstr (ST sz src__2 dst__2)
2284 assignFltCode pk dst src
2285 = getRegister dst `thenNat` \ register1 ->
2286 getRegister src `thenNat` \ register2 ->
2288 dst__2 = registerName register1 zeroh
2289 code = registerCode register2 dst__2
2290 src__2 = registerName register2 dst__2
2291 code__2 = if isFixed register2
2292 then code . mkSeqInstr (FMOV src__2 dst__2)
2297 #endif /* alpha_TARGET_ARCH */
2299 -- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
2301 #if i386_TARGET_ARCH
2303 -- Floating point assignment to memory
2304 assignMem_FltCode pk addr src = do
2305 (src_reg, src_code) <- getNonClobberedReg src
2306 Amode addr addr_code <- getAmode addr
2308 code = src_code `appOL`
2313 -- Floating point assignment to a register/temporary
2314 assignReg_FltCode pk reg src = do
2315 src_code <- getAnyReg src
2316 return (src_code (getRegisterReg reg))
2318 #endif /* i386_TARGET_ARCH */
2320 -- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
2322 #if sparc_TARGET_ARCH
2324 -- Floating point assignment to memory
2325 assignMem_FltCode pk addr src
2326 = getNewRegNat pk `thenNat` \ tmp1 ->
2327 getAmode addr `thenNat` \ amode ->
2328 getRegister src `thenNat` \ register ->
2330 sz = primRepToSize pk
2331 dst__2 = amodeAddr amode
2333 code1 = amodeCode amode
2334 code2 = registerCode register tmp1
2336 src__2 = registerName register tmp1
2337 pk__2 = registerRep register
2338 sz__2 = primRepToSize pk__2
2340 code__2 = code1 `appOL` code2 `appOL`
2342 then unitOL (ST sz src__2 dst__2)
2343 else toOL [FxTOy sz__2 sz src__2 tmp1, ST sz tmp1 dst__2]
2347 -- Floating point assignment to a register/temporary
2348 -- Why is this so bizarrely ugly?
2349 assignReg_FltCode pk reg src
2350 = getRegisterReg reg `thenNat` \ register1 ->
2351 getRegister src `thenNat` \ register2 ->
2353 pk__2 = registerRep register2
2354 sz__2 = primRepToSize pk__2
2356 getNewRegNat pk__2 `thenNat` \ tmp ->
2358 sz = primRepToSize pk
2359 dst__2 = registerName register1 g0 -- must be Fixed
2360 reg__2 = if pk /= pk__2 then tmp else dst__2
2361 code = registerCode register2 reg__2
2362 src__2 = registerName register2 reg__2
2365 code `snocOL` FxTOy sz__2 sz src__2 dst__2
2366 else if isFixed register2 then
2367 code `snocOL` FMOV sz src__2 dst__2
2373 #endif /* sparc_TARGET_ARCH */
2375 #if powerpc_TARGET_ARCH
2378 assignMem_FltCode = assignMem_IntCode
2379 assignReg_FltCode = assignReg_IntCode
2381 #endif /* powerpc_TARGET_ARCH */
2384 -- -----------------------------------------------------------------------------
2385 -- Generating an non-local jump
2387 -- (If applicable) Do not fill the delay slots here; you will confuse the
2388 -- register allocator.
2390 genJump :: CmmExpr{-the branch target-} -> NatM InstrBlock
2392 -- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
2394 #if alpha_TARGET_ARCH
2396 genJump (CmmLabel lbl)
2397 | isAsmTemp lbl = returnInstr (BR target)
2398 | otherwise = returnInstrs [LDA pv (AddrImm target), JMP zeroh (AddrReg pv) 0]
2400 target = ImmCLbl lbl
2403 = getRegister tree `thenNat` \ register ->
2404 getNewRegNat PtrRep `thenNat` \ tmp ->
2406 dst = registerName register pv
2407 code = registerCode register pv
2408 target = registerName register pv
2410 if isFixed register then
2411 returnSeq code [OR dst (RIReg dst) pv, JMP zeroh (AddrReg pv) 0]
2413 return (code . mkSeqInstr (JMP zeroh (AddrReg pv) 0))
2415 #endif /* alpha_TARGET_ARCH */
2417 -- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
2419 #if i386_TARGET_ARCH
2421 genJump (CmmLoad mem pk) = do
2422 Amode target code <- getAmode mem
2423 return (code `snocOL` JMP (OpAddr target))
2425 genJump (CmmLit lit) = do
2426 return (unitOL (JMP (OpImm (litToImm lit))))
2429 (reg,code) <- getSomeReg expr
2430 return (code `snocOL` JMP (OpReg reg))
2432 #endif /* i386_TARGET_ARCH */
2434 -- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
2436 #if sparc_TARGET_ARCH
2438 genJump (CmmLabel lbl)
2439 = return (toOL [CALL (Left target) 0 True, NOP])
2441 target = ImmCLbl lbl
2444 = getRegister tree `thenNat` \ register ->
2445 getNewRegNat PtrRep `thenNat` \ tmp ->
2447 code = registerCode register tmp
2448 target = registerName register tmp
2450 return (code `snocOL` JMP dsts (AddrRegReg target g0) `snocOL` NOP)
2452 #endif /* sparc_TARGET_ARCH */
2454 #if powerpc_TARGET_ARCH
2455 genJump (CmmLit (CmmLabel lbl))
2456 = return (unitOL $ JMP lbl)
2460 (target,code) <- getSomeReg tree
2461 return (code `snocOL` MTCTR target `snocOL` BCTR [])
2462 #endif /* powerpc_TARGET_ARCH */
2465 -- -----------------------------------------------------------------------------
2466 -- Unconditional branches
2468 genBranch :: BlockId -> NatM InstrBlock
2470 #if alpha_TARGET_ARCH
2471 genBranch id = return (unitOL (BR id))
2474 #if i386_TARGET_ARCH
2475 genBranch id = return (unitOL (JXX ALWAYS id))
2478 #if sparc_TARGET_ARCH
2479 genBranch id = return (toOL [BI ALWAYS False id, NOP])
2482 #if powerpc_TARGET_ARCH
2483 genBranch id = return (unitOL (BCC ALWAYS id))
2487 -- -----------------------------------------------------------------------------
2488 -- Conditional jumps
2491 Conditional jumps are always to local labels, so we can use branch
2492 instructions. We peek at the arguments to decide what kind of
2495 ALPHA: For comparisons with 0, we're laughing, because we can just do
2496 the desired conditional branch.
2498 I386: First, we have to ensure that the condition
2499 codes are set according to the supplied comparison operation.
2501 SPARC: First, we have to ensure that the condition codes are set
2502 according to the supplied comparison operation. We generate slightly
2503 different code for floating point comparisons, because a floating
2504 point operation cannot directly precede a @BF@. We assume the worst
2505 and fill that slot with a @NOP@.
2507 SPARC: Do not fill the delay slots here; you will confuse the register
2513 :: BlockId -- the branch target
2514 -> CmmExpr -- the condition on which to branch
2517 -- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
2519 #if alpha_TARGET_ARCH
2521 genCondJump id (StPrim op [x, StInt 0])
2522 = getRegister x `thenNat` \ register ->
2523 getNewRegNat (registerRep register)
2526 code = registerCode register tmp
2527 value = registerName register tmp
2528 pk = registerRep register
2529 target = ImmCLbl lbl
2531 returnSeq code [BI (cmpOp op) value target]
2533 cmpOp CharGtOp = GTT
2535 cmpOp CharEqOp = EQQ
2537 cmpOp CharLtOp = LTT
2546 cmpOp WordGeOp = ALWAYS
2547 cmpOp WordEqOp = EQQ
2549 cmpOp WordLtOp = NEVER
2550 cmpOp WordLeOp = EQQ
2552 cmpOp AddrGeOp = ALWAYS
2553 cmpOp AddrEqOp = EQQ
2555 cmpOp AddrLtOp = NEVER
2556 cmpOp AddrLeOp = EQQ
2558 genCondJump lbl (StPrim op [x, StDouble 0.0])
2559 = getRegister x `thenNat` \ register ->
2560 getNewRegNat (registerRep register)
2563 code = registerCode register tmp
2564 value = registerName register tmp
2565 pk = registerRep register
2566 target = ImmCLbl lbl
2568 return (code . mkSeqInstr (BF (cmpOp op) value target))
2570 cmpOp FloatGtOp = GTT
2571 cmpOp FloatGeOp = GE
2572 cmpOp FloatEqOp = EQQ
2573 cmpOp FloatNeOp = NE
2574 cmpOp FloatLtOp = LTT
2575 cmpOp FloatLeOp = LE
2576 cmpOp DoubleGtOp = GTT
2577 cmpOp DoubleGeOp = GE
2578 cmpOp DoubleEqOp = EQQ
2579 cmpOp DoubleNeOp = NE
2580 cmpOp DoubleLtOp = LTT
2581 cmpOp DoubleLeOp = LE
2583 genCondJump lbl (StPrim op [x, y])
2585 = trivialFCode pr instr x y `thenNat` \ register ->
2586 getNewRegNat F64 `thenNat` \ tmp ->
2588 code = registerCode register tmp
2589 result = registerName register tmp
2590 target = ImmCLbl lbl
2592 return (code . mkSeqInstr (BF cond result target))
2594 pr = panic "trivialU?FCode: does not use PrimRep on Alpha"
2596 fltCmpOp op = case op of
2610 (instr, cond) = case op of
2611 FloatGtOp -> (FCMP TF LE, EQQ)
2612 FloatGeOp -> (FCMP TF LTT, EQQ)
2613 FloatEqOp -> (FCMP TF EQQ, NE)
2614 FloatNeOp -> (FCMP TF EQQ, EQQ)
2615 FloatLtOp -> (FCMP TF LTT, NE)
2616 FloatLeOp -> (FCMP TF LE, NE)
2617 DoubleGtOp -> (FCMP TF LE, EQQ)
2618 DoubleGeOp -> (FCMP TF LTT, EQQ)
2619 DoubleEqOp -> (FCMP TF EQQ, NE)
2620 DoubleNeOp -> (FCMP TF EQQ, EQQ)
2621 DoubleLtOp -> (FCMP TF LTT, NE)
2622 DoubleLeOp -> (FCMP TF LE, NE)
2624 genCondJump lbl (StPrim op [x, y])
2625 = trivialCode instr x y `thenNat` \ register ->
2626 getNewRegNat IntRep `thenNat` \ tmp ->
2628 code = registerCode register tmp
2629 result = registerName register tmp
2630 target = ImmCLbl lbl
2632 return (code . mkSeqInstr (BI cond result target))
2634 (instr, cond) = case op of
2635 CharGtOp -> (CMP LE, EQQ)
2636 CharGeOp -> (CMP LTT, EQQ)
2637 CharEqOp -> (CMP EQQ, NE)
2638 CharNeOp -> (CMP EQQ, EQQ)
2639 CharLtOp -> (CMP LTT, NE)
2640 CharLeOp -> (CMP LE, NE)
2641 IntGtOp -> (CMP LE, EQQ)
2642 IntGeOp -> (CMP LTT, EQQ)
2643 IntEqOp -> (CMP EQQ, NE)
2644 IntNeOp -> (CMP EQQ, EQQ)
2645 IntLtOp -> (CMP LTT, NE)
2646 IntLeOp -> (CMP LE, NE)
2647 WordGtOp -> (CMP ULE, EQQ)
2648 WordGeOp -> (CMP ULT, EQQ)
2649 WordEqOp -> (CMP EQQ, NE)
2650 WordNeOp -> (CMP EQQ, EQQ)
2651 WordLtOp -> (CMP ULT, NE)
2652 WordLeOp -> (CMP ULE, NE)
2653 AddrGtOp -> (CMP ULE, EQQ)
2654 AddrGeOp -> (CMP ULT, EQQ)
2655 AddrEqOp -> (CMP EQQ, NE)
2656 AddrNeOp -> (CMP EQQ, EQQ)
2657 AddrLtOp -> (CMP ULT, NE)
2658 AddrLeOp -> (CMP ULE, NE)
2660 #endif /* alpha_TARGET_ARCH */
2662 -- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
2664 #if i386_TARGET_ARCH
2666 genCondJump id bool = do
2667 CondCode _ cond code <- getCondCode bool
2668 return (code `snocOL` JXX cond id)
2670 #endif /* i386_TARGET_ARCH */
2673 #if sparc_TARGET_ARCH
2675 genCondJump id bool = do
2676 CondCode is_float cond code <- getCondCode bool
2681 then [NOP, BF cond False id, NOP]
2682 else [BI cond False id, NOP]
2686 #endif /* sparc_TARGET_ARCH */
2689 #if powerpc_TARGET_ARCH
2691 genCondJump id bool = do
2692 CondCode is_float cond code <- getCondCode bool
2693 return (code `snocOL` BCC cond id)
2695 #endif /* powerpc_TARGET_ARCH */
2698 -- -----------------------------------------------------------------------------
2699 -- Generating C calls
2701 -- Now the biggest nightmare---calls. Most of the nastiness is buried in
2702 -- @get_arg@, which moves the arguments to the correct registers/stack
2703 -- locations. Apart from that, the code is easy.
2705 -- (If applicable) Do not fill the delay slots here; you will confuse the
2706 -- register allocator.
2709 :: CmmCallTarget -- function to call
2710 -> [(CmmReg,MachHint)] -- where to put the result
2711 -> [(CmmExpr,MachHint)] -- arguments (of mixed type)
2712 -> Maybe [GlobalReg] -- volatile regs to save
2715 -- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
2717 #if alpha_TARGET_ARCH
2721 genCCall fn cconv result_regs args
2722 = mapAccumLNat get_arg (allArgRegs, eXTRA_STK_ARGS_HERE) args
2723 `thenNat` \ ((unused,_), argCode) ->
2725 nRegs = length allArgRegs - length unused
2726 code = asmSeqThen (map ($ []) argCode)
2729 LDA pv (AddrImm (ImmLab (ptext fn))),
2730 JSR ra (AddrReg pv) nRegs,
2731 LDGP gp (AddrReg ra)]
2733 ------------------------
2734 {- Try to get a value into a specific register (or registers) for
2735 a call. The first 6 arguments go into the appropriate
2736 argument register (separate registers for integer and floating
2737 point arguments, but used in lock-step), and the remaining
2738 arguments are dumped to the stack, beginning at 0(sp). Our
2739 first argument is a pair of the list of remaining argument
2740 registers to be assigned for this call and the next stack
2741 offset to use for overflowing arguments. This way,
2742 @get_Arg@ can be applied to all of a call's arguments using
2746 :: ([(Reg,Reg)], Int) -- Argument registers and stack offset (accumulator)
2747 -> StixTree -- Current argument
2748 -> NatM (([(Reg,Reg)],Int), InstrBlock) -- Updated accumulator and code
2750 -- We have to use up all of our argument registers first...
2752 get_arg ((iDst,fDst):dsts, offset) arg
2753 = getRegister arg `thenNat` \ register ->
2755 reg = if isFloatingRep pk then fDst else iDst
2756 code = registerCode register reg
2757 src = registerName register reg
2758 pk = registerRep register
2761 if isFloatingRep pk then
2762 ((dsts, offset), if isFixed register then
2763 code . mkSeqInstr (FMOV src fDst)
2766 ((dsts, offset), if isFixed register then
2767 code . mkSeqInstr (OR src (RIReg src) iDst)
2770 -- Once we have run out of argument registers, we move to the
2773 get_arg ([], offset) arg
2774 = getRegister arg `thenNat` \ register ->
2775 getNewRegNat (registerRep register)
2778 code = registerCode register tmp
2779 src = registerName register tmp
2780 pk = registerRep register
2781 sz = primRepToSize pk
2783 return (([], offset + 1), code . mkSeqInstr (ST sz src (spRel offset)))
2785 #endif /* alpha_TARGET_ARCH */
2787 -- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
2789 #if i386_TARGET_ARCH
2791 -- we only cope with a single result for foreign calls
2792 genCCall (CmmPrim op) [(r,_)] args vols = do
2794 MO_F32_Sqrt -> actuallyInlineFloatOp F32 (GSQRT F32) args
2795 MO_F64_Sqrt -> actuallyInlineFloatOp F64 (GSQRT F64) args
2797 MO_F32_Sin -> actuallyInlineFloatOp F32 (GSIN F32) args
2798 MO_F64_Sin -> actuallyInlineFloatOp F64 (GSIN F64) args
2800 MO_F32_Cos -> actuallyInlineFloatOp F32 (GCOS F32) args
2801 MO_F64_Cos -> actuallyInlineFloatOp F64 (GCOS F64) args
2803 MO_F32_Tan -> actuallyInlineFloatOp F32 (GTAN F32) args
2804 MO_F64_Tan -> actuallyInlineFloatOp F64 (GTAN F64) args
2806 other_op -> outOfLineFloatOp op r args vols
2808 actuallyInlineFloatOp rep instr [(x,_)]
2809 = do res <- trivialUFCode rep instr x
2811 return (any (getRegisterReg r))
2813 genCCall target dest_regs args vols = do
2814 sizes_n_codes <- mapM push_arg (reverse args)
2815 delta <- getDeltaNat
2817 (sizes, push_codes) = unzip sizes_n_codes
2818 tot_arg_size = sum sizes
2820 -- deal with static vs dynamic call targets
2821 (callinsns,cconv) <-
2824 CmmForeignCall (CmmLit (CmmLabel lbl)) conv
2825 -> -- ToDo: stdcall arg sizes
2826 return (unitOL (CALL (Left fn_imm)), conv)
2827 where fn_imm = ImmCLbl lbl
2828 CmmForeignCall expr conv
2829 -> do (dyn_c, dyn_r, dyn_rep) <- get_op expr
2830 ASSERT(dyn_rep == I32)
2831 return (dyn_c `snocOL` CALL (Right dyn_r), conv)
2833 let push_code = concatOL push_codes
2834 call = callinsns `appOL`
2836 -- Deallocate parameters after call for ccall;
2837 -- but not for stdcall (callee does it)
2838 (if cconv == StdCallConv then [] else
2839 [ADD I32 (OpImm (ImmInt tot_arg_size)) (OpReg esp)])
2841 [DELTA (delta + tot_arg_size)]
2844 setDeltaNat (delta + tot_arg_size)
2847 -- assign the results, if necessary
2848 assign_code [] = nilOL
2849 assign_code [(dest,_hint)] =
2851 I64 -> toOL [MOV I32 (OpReg eax) (OpReg r_dest),
2852 MOV I32 (OpReg edx) (OpReg r_dest_hi)]
2853 F32 -> unitOL (GMOV fake0 r_dest)
2854 F64 -> unitOL (GMOV fake0 r_dest)
2855 rep -> unitOL (MOV rep (OpReg eax) (OpReg r_dest))
2857 r_dest_hi = getHiVRegFromLo r_dest
2858 rep = cmmRegRep dest
2859 r_dest = getRegisterReg dest
2860 assign_code many = panic "genCCall.assign_code many"
2862 return (push_code `appOL`
2864 assign_code dest_regs)
2871 push_arg :: (CmmExpr,MachHint){-current argument-}
2872 -> NatM (Int, InstrBlock) -- argsz, code
2874 push_arg (arg,_hint) -- we don't need the hints on x86
2875 | arg_rep == I64 = do
2876 ChildCode64 code r_lo <- iselExpr64 arg
2877 delta <- getDeltaNat
2878 setDeltaNat (delta - 8)
2880 r_hi = getHiVRegFromLo r_lo
2882 return (8, code `appOL`
2883 toOL [PUSH I32 (OpReg r_hi), DELTA (delta - 4),
2884 PUSH I32 (OpReg r_lo), DELTA (delta - 8),
2889 (code, reg, sz) <- get_op arg
2890 delta <- getDeltaNat
2891 let size = arg_size sz
2892 setDeltaNat (delta-size)
2893 if (case sz of F64 -> True; F32 -> True; _ -> False)
2896 toOL [SUB I32 (OpImm (ImmInt size)) (OpReg esp),
2898 GST sz reg (AddrBaseIndex (Just esp)
2904 PUSH I32 (OpReg reg) `snocOL`
2908 arg_rep = cmmExprRep arg
2911 get_op :: CmmExpr -> NatM (InstrBlock, Reg, MachRep) -- code, reg, size
2913 (reg,code) <- getSomeReg op
2914 return (code, reg, cmmExprRep op)
2917 outOfLineFloatOp :: CallishMachOp -> CmmReg -> [(CmmExpr,MachHint)]
2918 -> Maybe [GlobalReg] -> NatM InstrBlock
2919 outOfLineFloatOp mop res args vols
2920 | cmmRegRep res == F64
2921 = stmtToInstrs (CmmCall target [(res,FloatHint)] args vols)
2924 = do uq <- getUniqueNat
2926 tmp = CmmLocal (LocalReg uq F64)
2928 code1 <- stmtToInstrs (CmmCall target [(tmp,FloatHint)] (map promote args) vols)
2929 code2 <- stmtToInstrs (CmmAssign res (demote (CmmReg tmp)))
2930 return (code1 `appOL` code2)
2932 promote (x,hint) = (CmmMachOp (MO_S_Conv F32 F64) [x], hint)
2933 demote x = CmmMachOp (MO_S_Conv F64 F32) [x]
2935 target = CmmForeignCall (CmmLit lbl) CCallConv
2936 lbl = CmmLabel (mkForeignLabel fn Nothing False)
2939 MO_F32_Exp -> FSLIT("exp")
2940 MO_F32_Log -> FSLIT("log")
2942 MO_F32_Asin -> FSLIT("asin")
2943 MO_F32_Acos -> FSLIT("acos")
2944 MO_F32_Atan -> FSLIT("atan")
2946 MO_F32_Sinh -> FSLIT("sinh")
2947 MO_F32_Cosh -> FSLIT("cosh")
2948 MO_F32_Tanh -> FSLIT("tanh")
2949 MO_F32_Pwr -> FSLIT("pow")
2951 MO_F64_Exp -> FSLIT("exp")
2952 MO_F64_Log -> FSLIT("log")
2954 MO_F64_Asin -> FSLIT("asin")
2955 MO_F64_Acos -> FSLIT("acos")
2956 MO_F64_Atan -> FSLIT("atan")
2958 MO_F64_Sinh -> FSLIT("sinh")
2959 MO_F64_Cosh -> FSLIT("cosh")
2960 MO_F64_Tanh -> FSLIT("tanh")
2961 MO_F64_Pwr -> FSLIT("pow")
2963 other -> pprPanic "outOfLineFloatOp" (pprCallishMachOp mop)
2965 #endif /* i386_TARGET_ARCH */
2967 -- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
2969 #if sparc_TARGET_ARCH
2971 The SPARC calling convention is an absolute
2972 nightmare. The first 6x32 bits of arguments are mapped into
2973 %o0 through %o5, and the remaining arguments are dumped to the
2974 stack, beginning at [%sp+92]. (Note that %o6 == %sp.)
2976 If we have to put args on the stack, move %o6==%sp down by
2977 the number of words to go on the stack, to ensure there's enough space.
2979 According to Fraser and Hanson's lcc book, page 478, fig 17.2,
2980 16 words above the stack pointer is a word for the address of
2981 a structure return value. I use this as a temporary location
2982 for moving values from float to int regs. Certainly it isn't
2983 safe to put anything in the 16 words starting at %sp, since
2984 this area can get trashed at any time due to window overflows
2985 caused by signal handlers.
2987 A final complication (if the above isn't enough) is that
2988 we can't blithely calculate the arguments one by one into
2989 %o0 .. %o5. Consider the following nested calls:
2993 Naive code moves a into %o0, and (fff b c) into %o1. Unfortunately
2994 the inner call will itself use %o0, which trashes the value put there
2995 in preparation for the outer call. Upshot: we need to calculate the
2996 args into temporary regs, and move those to arg regs or onto the
2997 stack only immediately prior to the call proper. Sigh.
3000 genCCall fn cconv kind args
3001 = mapNat arg_to_int_vregs args `thenNat` \ argcode_and_vregs ->
3003 (argcodes, vregss) = unzip argcode_and_vregs
3004 n_argRegs = length allArgRegs
3005 n_argRegs_used = min (length vregs) n_argRegs
3006 vregs = concat vregss
3008 -- deal with static vs dynamic call targets
3011 -> return (unitOL (CALL (Left fn__2) n_argRegs_used False))
3013 -> arg_to_int_vregs dyn `thenNat` \ (dyn_c, [dyn_r]) ->
3014 return (dyn_c `snocOL` CALL (Right dyn_r) n_argRegs_used False)
3016 `thenNat` \ callinsns ->
3018 argcode = concatOL argcodes
3019 (move_sp_down, move_sp_up)
3020 = let diff = length vregs - n_argRegs
3021 nn = if odd diff then diff + 1 else diff -- keep 8-byte alignment
3024 else (unitOL (moveSp (-1*nn)), unitOL (moveSp (1*nn)))
3026 = toOL (move_final vregs allArgRegs eXTRA_STK_ARGS_HERE)
3028 return (argcode `appOL`
3029 move_sp_down `appOL`
3030 transfer_code `appOL`
3035 -- function names that begin with '.' are assumed to be special
3036 -- internally generated names like '.mul,' which don't get an
3037 -- underscore prefix
3038 -- ToDo:needed (WDP 96/03) ???
3039 fn_static = unLeft fn
3040 fn__2 = case (headFS fn_static) of
3041 '.' -> ImmLit (ftext fn_static)
3042 _ -> ImmCLbl (mkForeignLabel fn_static False)
3044 -- move args from the integer vregs into which they have been
3045 -- marshalled, into %o0 .. %o5, and the rest onto the stack.
3046 move_final :: [Reg] -> [Reg] -> Int -> [Instr]
3048 move_final [] _ offset -- all args done
3051 move_final (v:vs) [] offset -- out of aregs; move to stack
3052 = ST W v (spRel offset)
3053 : move_final vs [] (offset+1)
3055 move_final (v:vs) (a:az) offset -- move into an arg (%o[0..5]) reg
3056 = OR False g0 (RIReg v) a
3057 : move_final vs az offset
3059 -- generate code to calculate an argument, and move it into one
3060 -- or two integer vregs.
3061 arg_to_int_vregs :: CmmExpr -> NatM (OrdList Instr, [Reg])
3062 arg_to_int_vregs arg
3063 | is64BitRep (repOfCmmExpr arg)
3064 = iselExpr64 arg `thenNat` \ (ChildCode64 code vr_lo) ->
3065 let r_lo = VirtualRegI vr_lo
3066 r_hi = getHiVRegFromLo r_lo
3067 in return (code, [r_hi, r_lo])
3069 = getRegister arg `thenNat` \ register ->
3070 getNewRegNat (registerRep register) `thenNat` \ tmp ->
3071 let code = registerCode register tmp
3072 src = registerName register tmp
3073 pk = registerRep register
3075 -- the value is in src. Get it into 1 or 2 int vregs.
3078 getNewRegNat WordRep `thenNat` \ v1 ->
3079 getNewRegNat WordRep `thenNat` \ v2 ->
3082 FMOV DF src f0 `snocOL`
3083 ST F f0 (spRel 16) `snocOL`
3084 LD W (spRel 16) v1 `snocOL`
3085 ST F (fPair f0) (spRel 16) `snocOL`
3091 getNewRegNat WordRep `thenNat` \ v1 ->
3094 ST F src (spRel 16) `snocOL`
3100 getNewRegNat WordRep `thenNat` \ v1 ->
3102 code `snocOL` OR False g0 (RIReg src) v1
3106 #endif /* sparc_TARGET_ARCH */
3108 #if powerpc_TARGET_ARCH
3110 #if darwin_TARGET_OS || linux_TARGET_OS
3112 The PowerPC calling convention for Darwin/Mac OS X
3113 is described in Apple's document
3114 "Inside Mac OS X - Mach-O Runtime Architecture".
3116 PowerPC Linux uses the System V Release 4 Calling Convention
3117 for PowerPC. It is described in the
3118 "System V Application Binary Interface PowerPC Processor Supplement".
3120 Both conventions are similar:
3121 Parameters may be passed in general-purpose registers starting at r3, in
3122 floating point registers starting at f1, or on the stack.
3124 But there are substantial differences:
3125 * The number of registers used for parameter passing and the exact set of
3126 nonvolatile registers differs (see MachRegs.lhs).
3127 * On Darwin, stack space is always reserved for parameters, even if they are
3128 passed in registers. The called routine may choose to save parameters from
3129 registers to the corresponding space on the stack.
3130 * On Darwin, a corresponding amount of GPRs is skipped when a floating point
3131 parameter is passed in an FPR.
3132 * SysV insists on either passing I64 arguments on the stack, or in two GPRs,
3133 starting with an odd-numbered GPR. It may skip a GPR to achieve this.
3134 Darwin just treats an I64 like two separate I32s (high word first).
3135 * I64 and F64 arguments are 8-byte aligned on the stack for SysV, but only
3136 4-byte aligned like everything else on Darwin.
3137 * The SysV spec claims that F32 is represented as F64 on the stack. GCC on
3138 PowerPC Linux does not agree, so neither do we.
3140 According to both conventions, The parameter area should be part of the
3141 caller's stack frame, allocated in the caller's prologue code (large enough
3142 to hold the parameter lists for all called routines). The NCG already
3143 uses the stack for register spilling, leaving 64 bytes free at the top.
3144 If we need a larger parameter area than that, we just allocate a new stack
3145 frame just before ccalling.
3148 genCCall target dest_regs argsAndHints vols
3149 = ASSERT (not $ any (`elem` [I8,I16]) argReps)
3150 -- we rely on argument promotion in the codeGen
3152 (finalStack,passArgumentsCode,usedRegs) <- passArguments
3154 allArgRegs allFPArgRegs
3158 (labelOrExpr, reduceToF32) <- case target of
3159 CmmForeignCall (CmmLit (CmmLabel lbl)) conv -> return (Left lbl, False)
3160 CmmForeignCall expr conv -> return (Right expr, False)
3161 CmmPrim mop -> outOfLineFloatOp mop
3163 let codeBefore = move_sp_down finalStack `appOL` passArgumentsCode
3164 codeAfter = move_sp_up finalStack `appOL` moveResult reduceToF32
3169 `snocOL` BL lbl usedRegs
3172 (dynReg, dynCode) <- getSomeReg dyn
3174 `snocOL` MTCTR dynReg
3176 `snocOL` BCTRL usedRegs
3179 #if darwin_TARGET_OS
3180 initialStackOffset = 24
3181 -- size of linkage area + size of arguments, in bytes
3182 stackDelta _finalStack = roundTo 16 $ (24 +) $ max 32 $ sum $
3183 map machRepByteWidth argReps
3184 #elif linux_TARGET_OS
3185 initialStackOffset = 8
3186 stackDelta finalStack = roundTo 16 finalStack
3188 args = map fst argsAndHints
3189 argReps = map cmmExprRep args
3191 roundTo a x | x `mod` a == 0 = x
3192 | otherwise = x + a - (x `mod` a)
3194 move_sp_down finalStack
3196 toOL [STU I32 sp (AddrRegImm sp (ImmInt (-delta))),
3199 where delta = stackDelta finalStack
3200 move_sp_up finalStack
3202 toOL [ADD sp sp (RIImm (ImmInt delta)),
3205 where delta = stackDelta finalStack
3208 passArguments [] _ _ stackOffset accumCode accumUsed = return (stackOffset, accumCode, accumUsed)
3209 passArguments ((arg,I64):args) gprs fprs stackOffset
3210 accumCode accumUsed =
3212 ChildCode64 code vr_lo <- iselExpr64 arg
3213 let vr_hi = getHiVRegFromLo vr_lo
3215 #if darwin_TARGET_OS
3220 (accumCode `appOL` code
3221 `snocOL` storeWord vr_hi gprs stackOffset
3222 `snocOL` storeWord vr_lo (drop 1 gprs) (stackOffset+4))
3223 ((take 2 gprs) ++ accumUsed)
3225 storeWord vr (gpr:_) offset = MR gpr vr
3226 storeWord vr [] offset = ST I32 vr (AddrRegImm sp (ImmInt offset))
3228 #elif linux_TARGET_OS
3229 let stackOffset' = roundTo 8 stackOffset
3230 stackCode = accumCode `appOL` code
3231 `snocOL` ST I32 vr_hi (AddrRegImm sp (ImmInt stackOffset'))
3232 `snocOL` ST I32 vr_lo (AddrRegImm sp (ImmInt (stackOffset'+4)))
3233 regCode hireg loreg =
3234 accumCode `appOL` code
3235 `snocOL` MR hireg vr_hi
3236 `snocOL` MR loreg vr_lo
3239 hireg : loreg : regs | even (length gprs) ->
3240 passArguments args regs fprs stackOffset
3241 (regCode hireg loreg) (hireg : loreg : accumUsed)
3242 _skipped : hireg : loreg : regs ->
3243 passArguments args regs fprs stackOffset
3244 (regCode hireg loreg) (hireg : loreg : accumUsed)
3245 _ -> -- only one or no regs left
3246 passArguments args [] fprs (stackOffset'+8)
3250 passArguments ((arg,rep):args) gprs fprs stackOffset accumCode accumUsed
3251 | reg : _ <- regs = do
3252 register <- getRegister arg
3253 let code = case register of
3254 Fixed _ freg fcode -> fcode `snocOL` MR reg freg
3255 Any _ acode -> acode reg
3259 #if darwin_TARGET_OS
3260 -- The Darwin ABI requires that we reserve stack slots for register parameters
3261 (stackOffset + stackBytes)
3262 #elif linux_TARGET_OS
3263 -- ... the SysV ABI doesn't.
3266 (accumCode `appOL` code)
3269 (vr, code) <- getSomeReg arg
3273 (stackOffset' + stackBytes)
3274 (accumCode `appOL` code `snocOL` ST rep vr stackSlot)
3277 #if darwin_TARGET_OS
3278 -- stackOffset is at least 4-byte aligned
3279 -- The Darwin ABI is happy with that.
3280 stackOffset' = stackOffset
3282 -- ... the SysV ABI requires 8-byte alignment for doubles.
3283 stackOffset' | rep == F64 = roundTo 8 stackOffset
3284 | otherwise = stackOffset
3286 stackSlot = AddrRegImm sp (ImmInt stackOffset')
3287 (nGprs, nFprs, stackBytes, regs) = case rep of
3288 I32 -> (1, 0, 4, gprs)
3289 #if darwin_TARGET_OS
3290 -- The Darwin ABI requires that we skip a corresponding number of GPRs when
3292 F32 -> (1, 1, 4, fprs)
3293 F64 -> (2, 1, 8, fprs)
3294 #elif linux_TARGET_OS
3295 -- ... the SysV ABI doesn't.
3296 F32 -> (0, 1, 4, fprs)
3297 F64 -> (0, 1, 8, fprs)
3300 moveResult reduceToF32 =
3304 | reduceToF32 && rep == F32 -> unitOL (FRSP r_dest f1)
3305 | rep == F32 || rep == F64 -> unitOL (MR r_dest f1)
3306 | rep == I64 -> toOL [MR (getHiVRegFromLo r_dest) r3,
3308 | otherwise -> unitOL (MR r_dest r3)
3309 where rep = cmmRegRep dest
3310 r_dest = getRegisterReg dest
3312 outOfLineFloatOp mop =
3314 mopExpr <- cmmMakeDynamicReference addImportNat True $
3315 mkForeignLabel functionName Nothing True
3316 let mopLabelOrExpr = case mopExpr of
3317 CmmLit (CmmLabel lbl) -> Left lbl
3319 return (mopLabelOrExpr, reduce)
3321 (functionName, reduce) = case mop of
3322 MO_F32_Exp -> (FSLIT("exp"), True)
3323 MO_F32_Log -> (FSLIT("log"), True)
3324 MO_F32_Sqrt -> (FSLIT("sqrt"), True)
3326 MO_F32_Sin -> (FSLIT("sin"), True)
3327 MO_F32_Cos -> (FSLIT("cos"), True)
3328 MO_F32_Tan -> (FSLIT("tan"), True)
3330 MO_F32_Asin -> (FSLIT("asin"), True)
3331 MO_F32_Acos -> (FSLIT("acos"), True)
3332 MO_F32_Atan -> (FSLIT("atan"), True)
3334 MO_F32_Sinh -> (FSLIT("sinh"), True)
3335 MO_F32_Cosh -> (FSLIT("cosh"), True)
3336 MO_F32_Tanh -> (FSLIT("tanh"), True)
3337 MO_F32_Pwr -> (FSLIT("pow"), True)
3339 MO_F64_Exp -> (FSLIT("exp"), False)
3340 MO_F64_Log -> (FSLIT("log"), False)
3341 MO_F64_Sqrt -> (FSLIT("sqrt"), False)
3343 MO_F64_Sin -> (FSLIT("sin"), False)
3344 MO_F64_Cos -> (FSLIT("cos"), False)
3345 MO_F64_Tan -> (FSLIT("tan"), False)
3347 MO_F64_Asin -> (FSLIT("asin"), False)
3348 MO_F64_Acos -> (FSLIT("acos"), False)
3349 MO_F64_Atan -> (FSLIT("atan"), False)
3351 MO_F64_Sinh -> (FSLIT("sinh"), False)
3352 MO_F64_Cosh -> (FSLIT("cosh"), False)
3353 MO_F64_Tanh -> (FSLIT("tanh"), False)
3354 MO_F64_Pwr -> (FSLIT("pow"), False)
3355 other -> pprPanic "genCCall(ppc): unknown callish op"
3356 (pprCallishMachOp other)
3358 #endif /* darwin_TARGET_OS || linux_TARGET_OS */
3360 #endif /* powerpc_TARGET_ARCH */
3363 -- -----------------------------------------------------------------------------
3364 -- Generating a table-branch
3366 genSwitch :: CmmExpr -> [Maybe BlockId] -> NatM InstrBlock
3368 #if i386_TARGET_ARCH
3369 genSwitch expr ids = do
3370 (reg,e_code) <- getSomeReg expr
3371 lbl <- getNewLabelNat
3373 jumpTable = map jumpTableEntry ids
3374 op = OpAddr (AddrBaseIndex Nothing (Just (reg,4)) (ImmCLbl lbl))
3375 code = e_code `appOL` toOL [
3376 LDATA ReadOnlyData (CmmDataLabel lbl : jumpTable),
3377 JMP_TBL op [ id | Just id <- ids ]
3381 #elif powerpc_TARGET_ARCH
3385 (reg,e_code) <- getSomeReg expr
3386 tmp <- getNewRegNat I32
3387 lbl <- getNewLabelNat
3388 dynRef <- cmmMakeDynamicReference addImportNat False lbl
3389 (tableReg,t_code) <- getSomeReg $ dynRef
3391 jumpTable = map jumpTableEntry ids
3393 code = e_code `appOL` t_code `appOL` toOL [
3394 LDATA ReadOnlyData (CmmDataLabel lbl : jumpTable),
3395 SLW tmp reg (RIImm (ImmInt 2)),
3396 LD I32 tmp (AddrRegReg tableReg tmp),
3398 BCTR [ id | Just id <- ids ]
3403 (reg,e_code) <- getSomeReg expr
3404 tmp <- getNewRegNat I32
3405 lbl <- getNewLabelNat
3407 jumpTable = map jumpTableEntry ids
3409 code = e_code `appOL` toOL [
3410 LDATA ReadOnlyData (CmmDataLabel lbl : jumpTable),
3411 SLW tmp reg (RIImm (ImmInt 2)),
3412 ADDIS tmp tmp (HA (ImmCLbl lbl)),
3413 LD I32 tmp (AddrRegImm tmp (LO (ImmCLbl lbl))),
3415 BCTR [ id | Just id <- ids ]
3419 genSwitch expr ids = panic "ToDo: genSwitch"
3422 jumpTableEntry Nothing = CmmStaticLit (CmmInt 0 wordRep)
3423 jumpTableEntry (Just (BlockId id)) = CmmStaticLit (CmmLabel blockLabel)
3424 where blockLabel = mkAsmTempLabel id
3426 -- -----------------------------------------------------------------------------
3428 -- -----------------------------------------------------------------------------
3431 -- -----------------------------------------------------------------------------
3432 -- 'condIntReg' and 'condFltReg': condition codes into registers
3434 -- Turn those condition codes into integers now (when they appear on
3435 -- the right hand side of an assignment).
3437 -- (If applicable) Do not fill the delay slots here; you will confuse the
3438 -- register allocator.
3440 condIntReg, condFltReg :: Cond -> CmmExpr -> CmmExpr -> NatM Register
3442 -- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
3444 #if alpha_TARGET_ARCH
3445 condIntReg = panic "MachCode.condIntReg (not on Alpha)"
3446 condFltReg = panic "MachCode.condFltReg (not on Alpha)"
3447 #endif /* alpha_TARGET_ARCH */
3449 -- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
3451 #if i386_TARGET_ARCH
3453 condIntReg cond x y = do
3454 CondCode _ cond cond_code <- condIntCode cond x y
3455 tmp <- getNewRegNat I8
3457 code dst = cond_code `appOL` toOL [
3458 SETCC cond (OpReg tmp),
3459 MOV I32 (OpReg tmp) (OpReg dst),
3460 AND I32 (OpImm (ImmInt 1)) (OpReg dst)
3462 -- NB. (1) Tha AND is needed here because the x86 only
3463 -- sets the low byte in the SETCC instruction.
3464 -- NB. (2) The extra temporary register is a hack to
3465 -- work around the fact that the setcc instructions only
3466 -- accept byte registers. dst might not be a byte-able reg,
3467 -- but currently all free registers are byte-able, so we're
3468 -- guaranteed that a new temporary is byte-able.
3470 return (Any I32 code)
3473 condFltReg cond x y = do
3474 lbl1 <- getBlockIdNat
3475 lbl2 <- getBlockIdNat
3476 CondCode _ cond cond_code <- condFltCode cond x y
3478 code dst = cond_code `appOL` toOL [
3480 MOV I32 (OpImm (ImmInt 0)) (OpReg dst),
3483 MOV I32 (OpImm (ImmInt 1)) (OpReg dst),
3486 -- SIGH, have to split up this block somehow...
3488 return (Any I32 code)
3490 #endif /* i386_TARGET_ARCH */
3492 -- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
3494 #if sparc_TARGET_ARCH
3496 condIntReg EQQ x (StInt 0)
3497 = getRegister x `thenNat` \ register ->
3498 getNewRegNat IntRep `thenNat` \ tmp ->
3500 code = registerCode register tmp
3501 src = registerName register tmp
3502 code__2 dst = code `appOL` toOL [
3503 SUB False True g0 (RIReg src) g0,
3504 SUB True False g0 (RIImm (ImmInt (-1))) dst]
3506 return (Any IntRep code__2)
3509 = getRegister x `thenNat` \ register1 ->
3510 getRegister y `thenNat` \ register2 ->
3511 getNewRegNat IntRep `thenNat` \ tmp1 ->
3512 getNewRegNat IntRep `thenNat` \ tmp2 ->
3514 code1 = registerCode register1 tmp1
3515 src1 = registerName register1 tmp1
3516 code2 = registerCode register2 tmp2
3517 src2 = registerName register2 tmp2
3518 code__2 dst = code1 `appOL` code2 `appOL` toOL [
3519 XOR False src1 (RIReg src2) dst,
3520 SUB False True g0 (RIReg dst) g0,
3521 SUB True False g0 (RIImm (ImmInt (-1))) dst]
3523 return (Any IntRep code__2)
3525 condIntReg NE x (StInt 0)
3526 = getRegister x `thenNat` \ register ->
3527 getNewRegNat IntRep `thenNat` \ tmp ->
3529 code = registerCode register tmp
3530 src = registerName register tmp
3531 code__2 dst = code `appOL` toOL [
3532 SUB False True g0 (RIReg src) g0,
3533 ADD True False g0 (RIImm (ImmInt 0)) dst]
3535 return (Any IntRep code__2)
3538 = getRegister x `thenNat` \ register1 ->
3539 getRegister y `thenNat` \ register2 ->
3540 getNewRegNat IntRep `thenNat` \ tmp1 ->
3541 getNewRegNat IntRep `thenNat` \ tmp2 ->
3543 code1 = registerCode register1 tmp1
3544 src1 = registerName register1 tmp1
3545 code2 = registerCode register2 tmp2
3546 src2 = registerName register2 tmp2
3547 code__2 dst = code1 `appOL` code2 `appOL` toOL [
3548 XOR False src1 (RIReg src2) dst,
3549 SUB False True g0 (RIReg dst) g0,
3550 ADD True False g0 (RIImm (ImmInt 0)) dst]
3552 return (Any IntRep code__2)
3555 = getBlockIdNat `thenNat` \ lbl1 ->
3556 getBlockIdNat `thenNat` \ lbl2 ->
3557 condIntCode cond x y `thenNat` \ condition ->
3559 code = condCode condition
3560 cond = condName condition
3561 code__2 dst = code `appOL` toOL [
3562 BI cond False (ImmCLbl lbl1), NOP,
3563 OR False g0 (RIImm (ImmInt 0)) dst,
3564 BI ALWAYS False (ImmCLbl lbl2), NOP,
3566 OR False g0 (RIImm (ImmInt 1)) dst,
3569 return (Any IntRep code__2)
3572 = getBlockIdNat `thenNat` \ lbl1 ->
3573 getBlockIdNat `thenNat` \ lbl2 ->
3574 condFltCode cond x y `thenNat` \ condition ->
3576 code = condCode condition
3577 cond = condName condition
3578 code__2 dst = code `appOL` toOL [
3580 BF cond False (ImmCLbl lbl1), NOP,
3581 OR False g0 (RIImm (ImmInt 0)) dst,
3582 BI ALWAYS False (ImmCLbl lbl2), NOP,
3584 OR False g0 (RIImm (ImmInt 1)) dst,
3587 return (Any IntRep code__2)
3589 #endif /* sparc_TARGET_ARCH */
3591 #if powerpc_TARGET_ARCH
3592 condReg getCond = do
3593 lbl1 <- getBlockIdNat
3594 lbl2 <- getBlockIdNat
3595 CondCode _ cond cond_code <- getCond
3597 {- code dst = cond_code `appOL` toOL [
3606 code dst = cond_code
3610 RLWINM dst dst (bit + 1) 31 31
3613 negate_code | do_negate = unitOL (CRNOR bit bit bit)
3616 (bit, do_negate) = case cond of
3630 return (Any I32 code)
3632 condIntReg cond x y = condReg (condIntCode cond x y)
3633 condFltReg cond x y = condReg (condFltCode cond x y)
3634 #endif /* powerpc_TARGET_ARCH */
3637 -- -----------------------------------------------------------------------------
3638 -- 'trivial*Code': deal with trivial instructions
3640 -- Trivial (dyadic: 'trivialCode', floating-point: 'trivialFCode',
3641 -- unary: 'trivialUCode', unary fl-pt:'trivialUFCode') instructions.
3642 -- Only look for constants on the right hand side, because that's
3643 -- where the generic optimizer will have put them.
3645 -- Similarly, for unary instructions, we don't have to worry about
3646 -- matching an StInt as the argument, because genericOpt will already
3647 -- have handled the constant-folding.
3651 -> IF_ARCH_alpha((Reg -> RI -> Reg -> Instr)
3652 ,IF_ARCH_i386 ((Operand -> Operand -> Instr)
3653 -> Maybe (Operand -> Operand -> Instr)
3654 ,IF_ARCH_sparc((Reg -> RI -> Reg -> Instr)
3655 ,IF_ARCH_powerpc(Bool -> (Reg -> Reg -> RI -> Instr)
3657 -> CmmExpr -> CmmExpr -- the two arguments
3660 #ifndef powerpc_TARGET_ARCH
3663 -> IF_ARCH_alpha((Reg -> Reg -> Reg -> Instr)
3664 ,IF_ARCH_sparc((Size -> Reg -> Reg -> Reg -> Instr)
3665 ,IF_ARCH_i386 ((MachRep -> Reg -> Reg -> Reg -> Instr)
3667 -> CmmExpr -> CmmExpr -- the two arguments
3673 -> IF_ARCH_alpha((RI -> Reg -> Instr)
3674 ,IF_ARCH_i386 ((Operand -> Instr)
3675 ,IF_ARCH_sparc((RI -> Reg -> Instr)
3676 ,IF_ARCH_powerpc((Reg -> Reg -> Instr)
3678 -> CmmExpr -- the one argument
3681 #ifndef powerpc_TARGET_ARCH
3684 -> IF_ARCH_alpha((Reg -> Reg -> Instr)
3685 ,IF_ARCH_i386 ((Reg -> Reg -> Instr)
3686 ,IF_ARCH_sparc((Reg -> Reg -> Instr)
3688 -> CmmExpr -- the one argument
3692 -- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
3694 #if alpha_TARGET_ARCH
3696 trivialCode instr x (StInt y)
3698 = getRegister x `thenNat` \ register ->
3699 getNewRegNat IntRep `thenNat` \ tmp ->
3701 code = registerCode register tmp
3702 src1 = registerName register tmp
3703 src2 = ImmInt (fromInteger y)
3704 code__2 dst = code . mkSeqInstr (instr src1 (RIImm src2) dst)
3706 return (Any IntRep code__2)
3708 trivialCode instr x y
3709 = getRegister x `thenNat` \ register1 ->
3710 getRegister y `thenNat` \ register2 ->
3711 getNewRegNat IntRep `thenNat` \ tmp1 ->
3712 getNewRegNat IntRep `thenNat` \ tmp2 ->
3714 code1 = registerCode register1 tmp1 []
3715 src1 = registerName register1 tmp1
3716 code2 = registerCode register2 tmp2 []
3717 src2 = registerName register2 tmp2
3718 code__2 dst = asmSeqThen [code1, code2] .
3719 mkSeqInstr (instr src1 (RIReg src2) dst)
3721 return (Any IntRep code__2)
3724 trivialUCode instr x
3725 = getRegister x `thenNat` \ register ->
3726 getNewRegNat IntRep `thenNat` \ tmp ->
3728 code = registerCode register tmp
3729 src = registerName register tmp
3730 code__2 dst = code . mkSeqInstr (instr (RIReg src) dst)
3732 return (Any IntRep code__2)
3735 trivialFCode _ instr x y
3736 = getRegister x `thenNat` \ register1 ->
3737 getRegister y `thenNat` \ register2 ->
3738 getNewRegNat F64 `thenNat` \ tmp1 ->
3739 getNewRegNat F64 `thenNat` \ tmp2 ->
3741 code1 = registerCode register1 tmp1
3742 src1 = registerName register1 tmp1
3744 code2 = registerCode register2 tmp2
3745 src2 = registerName register2 tmp2
3747 code__2 dst = asmSeqThen [code1 [], code2 []] .
3748 mkSeqInstr (instr src1 src2 dst)
3750 return (Any F64 code__2)
3752 trivialUFCode _ instr x
3753 = getRegister x `thenNat` \ register ->
3754 getNewRegNat F64 `thenNat` \ tmp ->
3756 code = registerCode register tmp
3757 src = registerName register tmp
3758 code__2 dst = code . mkSeqInstr (instr src dst)
3760 return (Any F64 code__2)
3762 #endif /* alpha_TARGET_ARCH */
3764 -- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
3766 #if i386_TARGET_ARCH
3769 The Rules of the Game are:
3771 * You cannot assume anything about the destination register dst;
3772 it may be anything, including a fixed reg.
3774 * You may compute an operand into a fixed reg, but you may not
3775 subsequently change the contents of that fixed reg. If you
3776 want to do so, first copy the value either to a temporary
3777 or into dst. You are free to modify dst even if it happens
3778 to be a fixed reg -- that's not your problem.
3780 * You cannot assume that a fixed reg will stay live over an
3781 arbitrary computation. The same applies to the dst reg.
3783 * Temporary regs obtained from getNewRegNat are distinct from
3784 each other and from all other regs, and stay live over
3785 arbitrary computations.
3787 --------------------
3789 SDM's version of The Rules:
3791 * If getRegister returns Any, that means it can generate correct
3792 code which places the result in any register, period. Even if that
3793 register happens to be read during the computation.
3795 Corollary #1: this means that if you are generating code for an
3796 operation with two arbitrary operands, you cannot assign the result
3797 of the first operand into the destination register before computing
3798 the second operand. The second operand might require the old value
3799 of the destination register.
3801 Corollary #2: A function might be able to generate more efficient
3802 code if it knows the destination register is a new temporary (and
3803 therefore not read by any of the sub-computations).
3805 * If getRegister returns Any, then the code it generates may modify only:
3806 (a) fresh temporaries
3807 (b) the destination register
3808 (c) known registers (eg. %ecx is used by shifts)
3809 In particular, it may *not* modify global registers, unless the global
3810 register happens to be the destination register.
3813 trivialCode rep instr maybe_revinstr a (CmmLit lit_b) = do
3814 a_code <- getAnyReg a
3817 = a_code dst `snocOL`
3818 instr (OpImm (litToImm lit_b)) (OpReg dst)
3820 return (Any rep code)
3822 trivialCode rep instr (Just revinstr) (CmmLit lit_a) b = do
3823 b_code <- getAnyReg b
3826 = b_code dst `snocOL`
3827 revinstr (OpImm (litToImm lit_a)) (OpReg dst)
3829 return (Any rep code)
3831 trivialCode rep instr maybe_revinstr a b = do
3832 (b_op, b_code) <- getOperand b
3833 a_code <- getAnyReg a
3834 tmp <- getNewRegNat rep
3836 -- We want the value of b to stay alive across the computation of a.
3837 -- But, we want to calculate a straight into the destination register,
3838 -- because the instruction only has two operands (dst := dst `op` src).
3839 -- The troublesome case is when the result of b is in the same register
3840 -- as the destination reg. In this case, we have to save b in a
3841 -- new temporary across the computation of a.
3843 | dst `clashesWith` b_op =
3845 unitOL (MOV rep b_op (OpReg tmp)) `appOL`
3847 instr (OpReg tmp) (OpReg dst)
3851 instr b_op (OpReg dst)
3853 return (Any rep code)
3855 reg `clashesWith` OpReg reg2 = reg == reg2
3856 reg `clashesWith` OpAddr amode = any (==reg) (addrModeRegs amode)
3860 trivialUCode rep instr x = do
3861 x_code <- getAnyReg x
3867 return (Any rep code)
3871 trivialFCode pk instr x y = do
3872 (x_reg, x_code) <- getNonClobberedReg x -- these work for float regs too
3873 (y_reg, y_code) <- getSomeReg y
3878 instr pk x_reg y_reg dst
3880 return (Any pk code)
3884 trivialUFCode rep instr x = do
3885 (x_reg, x_code) <- getSomeReg x
3891 return (Any rep code)
3893 #endif /* i386_TARGET_ARCH */
3895 -- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
3897 #if sparc_TARGET_ARCH
3899 trivialCode instr x (StInt y)
3901 = getRegister x `thenNat` \ register ->
3902 getNewRegNat IntRep `thenNat` \ tmp ->
3904 code = registerCode register tmp
3905 src1 = registerName register tmp
3906 src2 = ImmInt (fromInteger y)
3907 code__2 dst = code `snocOL` instr src1 (RIImm src2) dst
3909 return (Any IntRep code__2)
3911 trivialCode instr x y
3912 = getRegister x `thenNat` \ register1 ->
3913 getRegister y `thenNat` \ register2 ->
3914 getNewRegNat IntRep `thenNat` \ tmp1 ->
3915 getNewRegNat IntRep `thenNat` \ tmp2 ->
3917 code1 = registerCode register1 tmp1
3918 src1 = registerName register1 tmp1
3919 code2 = registerCode register2 tmp2
3920 src2 = registerName register2 tmp2
3921 code__2 dst = code1 `appOL` code2 `snocOL`
3922 instr src1 (RIReg src2) dst
3924 return (Any IntRep code__2)
3927 trivialFCode pk instr x y
3928 = getRegister x `thenNat` \ register1 ->
3929 getRegister y `thenNat` \ register2 ->
3930 getNewRegNat (registerRep register1)
3932 getNewRegNat (registerRep register2)
3934 getNewRegNat F64 `thenNat` \ tmp ->
3936 promote x = FxTOy F DF x tmp
3938 pk1 = registerRep register1
3939 code1 = registerCode register1 tmp1
3940 src1 = registerName register1 tmp1
3942 pk2 = registerRep register2
3943 code2 = registerCode register2 tmp2
3944 src2 = registerName register2 tmp2
3948 code1 `appOL` code2 `snocOL`
3949 instr (primRepToSize pk) src1 src2 dst
3950 else if pk1 == F32 then
3951 code1 `snocOL` promote src1 `appOL` code2 `snocOL`
3952 instr DF tmp src2 dst
3954 code1 `appOL` code2 `snocOL` promote src2 `snocOL`
3955 instr DF src1 tmp dst
3957 return (Any (if pk1 == pk2 then pk1 else F64) code__2)
3960 trivialUCode instr x
3961 = getRegister x `thenNat` \ register ->
3962 getNewRegNat IntRep `thenNat` \ tmp ->
3964 code = registerCode register tmp
3965 src = registerName register tmp
3966 code__2 dst = code `snocOL` instr (RIReg src) dst
3968 return (Any IntRep code__2)
3971 trivialUFCode pk instr x
3972 = getRegister x `thenNat` \ register ->
3973 getNewRegNat pk `thenNat` \ tmp ->
3975 code = registerCode register tmp
3976 src = registerName register tmp
3977 code__2 dst = code `snocOL` instr src dst
3979 return (Any pk code__2)
3981 #endif /* sparc_TARGET_ARCH */
3983 #if powerpc_TARGET_ARCH
3986 Wolfgang's PowerPC version of The Rules:
3988 A slightly modified version of The Rules to take advantage of the fact
3989 that PowerPC instructions work on all registers and don't implicitly
3990 clobber any fixed registers.
3992 * The only expression for which getRegister returns Fixed is (CmmReg reg).
3994 * If getRegister returns Any, then the code it generates may modify only:
3995 (a) fresh temporaries
3996 (b) the destination register
3997 It may *not* modify global registers, unless the global
3998 register happens to be the destination register.
3999 It may not clobber any other registers. In fact, only ccalls clobber any
4001 Also, it may not modify the counter register (used by genCCall).
4003 Corollary: If a getRegister for a subexpression returns Fixed, you need
4004 not move it to a fresh temporary before evaluating the next subexpression.
4005 The Fixed register won't be modified.
4006 Therefore, we don't need a counterpart for the x86's getStableReg on PPC.
4008 * SDM's First Rule is valid for PowerPC, too: subexpressions can depend on
4009 the value of the destination register.
4012 trivialCode rep signed instr x (CmmLit (CmmInt y _))
4013 | Just imm <- makeImmediate rep signed y
4015 (src1, code1) <- getSomeReg x
4016 let code dst = code1 `snocOL` instr dst src1 (RIImm imm)
4017 return (Any rep code)
4019 trivialCode rep signed instr x y = do
4020 (src1, code1) <- getSomeReg x
4021 (src2, code2) <- getSomeReg y
4022 let code dst = code1 `appOL` code2 `snocOL` instr dst src1 (RIReg src2)
4023 return (Any rep code)
4025 trivialCodeNoImm :: MachRep -> (Reg -> Reg -> Reg -> Instr)
4026 -> CmmExpr -> CmmExpr -> NatM Register
4027 trivialCodeNoImm rep instr x y = do
4028 (src1, code1) <- getSomeReg x
4029 (src2, code2) <- getSomeReg y
4030 let code dst = code1 `appOL` code2 `snocOL` instr dst src1 src2
4031 return (Any rep code)
4033 trivialUCode rep instr x = do
4034 (src, code) <- getSomeReg x
4035 let code' dst = code `snocOL` instr dst src
4036 return (Any rep code')
4038 -- There is no "remainder" instruction on the PPC, so we have to do
4040 -- The "div" parameter is the division instruction to use (DIVW or DIVWU)
4042 remainderCode :: MachRep -> (Reg -> Reg -> Reg -> Instr)
4043 -> CmmExpr -> CmmExpr -> NatM Register
4044 remainderCode rep div x y = do
4045 (src1, code1) <- getSomeReg x
4046 (src2, code2) <- getSomeReg y
4047 let code dst = code1 `appOL` code2 `appOL` toOL [
4049 MULLW dst dst (RIReg src2),
4052 return (Any rep code)
4054 #endif /* powerpc_TARGET_ARCH */
4057 -- -----------------------------------------------------------------------------
4058 -- Coercing to/from integer/floating-point...
4060 -- @coerce(Int2FP|FP2Int)@ are more complicated integer/float
4061 -- conversions. We have to store temporaries in memory to move
4062 -- between the integer and the floating point register sets.
4064 -- @coerceDbl2Flt@ and @coerceFlt2Dbl@ are done this way because we
4065 -- pretend, on sparc at least, that double and float regs are seperate
4066 -- kinds, so the value has to be computed into one kind before being
4067 -- explicitly "converted" to live in the other kind.
4069 coerceInt2FP :: MachRep -> MachRep -> CmmExpr -> NatM Register
4070 coerceFP2Int :: MachRep -> MachRep -> CmmExpr -> NatM Register
4072 #ifdef sparc_TARGET_ARCH
4073 coerceDbl2Flt :: CmmExpr -> NatM Register
4074 coerceFlt2Dbl :: CmmExpr -> NatM Register
4077 -- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
4079 #if alpha_TARGET_ARCH
4082 = getRegister x `thenNat` \ register ->
4083 getNewRegNat IntRep `thenNat` \ reg ->
4085 code = registerCode register reg
4086 src = registerName register reg
4088 code__2 dst = code . mkSeqInstrs [
4090 LD TF dst (spRel 0),
4093 return (Any F64 code__2)
4097 = getRegister x `thenNat` \ register ->
4098 getNewRegNat F64 `thenNat` \ tmp ->
4100 code = registerCode register tmp
4101 src = registerName register tmp
4103 code__2 dst = code . mkSeqInstrs [
4105 ST TF tmp (spRel 0),
4108 return (Any IntRep code__2)
4110 #endif /* alpha_TARGET_ARCH */
4112 -- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
4114 #if i386_TARGET_ARCH
4116 coerceInt2FP from to x = do
4117 (x_reg, x_code) <- getSomeReg x
4119 opc = case to of F32 -> GITOF; F64 -> GITOD
4120 code dst = x_code `snocOL` opc x_reg dst
4121 -- ToDo: works for non-I32 reps?
4123 return (Any to code)
4127 coerceFP2Int from to x = do
4128 (x_reg, x_code) <- getSomeReg x
4130 opc = case from of F32 -> GFTOI; F64 -> GDTOI
4131 code dst = x_code `snocOL` opc x_reg dst
4132 -- ToDo: works for non-I32 reps?
4134 return (Any to code)
4136 #endif /* i386_TARGET_ARCH */
4138 -- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
4140 #if sparc_TARGET_ARCH
4143 = getRegister x `thenNat` \ register ->
4144 getNewRegNat IntRep `thenNat` \ reg ->
4146 code = registerCode register reg
4147 src = registerName register reg
4149 code__2 dst = code `appOL` toOL [
4150 ST W src (spRel (-2)),
4151 LD W (spRel (-2)) dst,
4152 FxTOy W (primRepToSize pk) dst dst]
4154 return (Any pk code__2)
4157 coerceFP2Int fprep x
4158 = ASSERT(fprep == F64 || fprep == F32)
4159 getRegister x `thenNat` \ register ->
4160 getNewRegNat fprep `thenNat` \ reg ->
4161 getNewRegNat F32 `thenNat` \ tmp ->
4163 code = registerCode register reg
4164 src = registerName register reg
4165 code__2 dst = code `appOL` toOL [
4166 FxTOy (primRepToSize fprep) W src tmp,
4167 ST W tmp (spRel (-2)),
4168 LD W (spRel (-2)) dst]
4170 return (Any IntRep code__2)
4174 = getRegister x `thenNat` \ register ->
4175 getNewRegNat F64 `thenNat` \ tmp ->
4176 let code = registerCode register tmp
4177 src = registerName register tmp
4180 (\dst -> code `snocOL` FxTOy DF F src dst))
4184 = getRegister x `thenNat` \ register ->
4185 getNewRegNat F32 `thenNat` \ tmp ->
4186 let code = registerCode register tmp
4187 src = registerName register tmp
4190 (\dst -> code `snocOL` FxTOy F DF src dst))
4192 #endif /* sparc_TARGET_ARCH */
4194 #if powerpc_TARGET_ARCH
4195 coerceInt2FP fromRep toRep x = do
4196 (src, code) <- getSomeReg x
4197 lbl <- getNewLabelNat
4198 itmp <- getNewRegNat I32
4199 ftmp <- getNewRegNat F64
4200 dynRef <- cmmMakeDynamicReference addImportNat False lbl
4201 Amode addr addr_code <- getAmode dynRef
4203 code' dst = code `appOL` maybe_exts `appOL` toOL [
4206 CmmStaticLit (CmmInt 0x43300000 I32),
4207 CmmStaticLit (CmmInt 0x80000000 I32)],
4208 XORIS itmp src (ImmInt 0x8000),
4209 ST I32 itmp (spRel 3),
4210 LIS itmp (ImmInt 0x4330),
4211 ST I32 itmp (spRel 2),
4212 LD F64 ftmp (spRel 2)
4213 ] `appOL` addr_code `appOL` toOL [
4215 FSUB F64 dst ftmp dst
4216 ] `appOL` maybe_frsp dst
4218 maybe_exts = case fromRep of
4219 I8 -> unitOL $ EXTS I8 src src
4220 I16 -> unitOL $ EXTS I16 src src
4222 maybe_frsp dst = case toRep of
4223 F32 -> unitOL $ FRSP dst dst
4225 return (Any toRep code')
4227 coerceFP2Int fromRep toRep x = do
4228 -- the reps don't really matter: F*->F64 and I32->I* are no-ops
4229 (src, code) <- getSomeReg x
4230 tmp <- getNewRegNat F64
4232 code' dst = code `appOL` toOL [
4233 -- convert to int in FP reg
4235 -- store value (64bit) from FP to stack
4236 ST F64 tmp (spRel 2),
4237 -- read low word of value (high word is undefined)
4238 LD I32 dst (spRel 3)]
4239 return (Any toRep code')
4240 #endif /* powerpc_TARGET_ARCH */
4243 -- -----------------------------------------------------------------------------
4244 -- eXTRA_STK_ARGS_HERE
4246 -- We (allegedly) put the first six C-call arguments in registers;
4247 -- where do we start putting the rest of them?
4249 -- Moved from MachInstrs (SDM):
4251 #if alpha_TARGET_ARCH || sparc_TARGET_ARCH
4252 eXTRA_STK_ARGS_HERE :: Int
4254 = IF_ARCH_alpha(0, IF_ARCH_sparc(23, ???))