1 -----------------------------------------------------------------------------
3 -- Generating machine code (instruction selection)
5 -- (c) The University of Glasgow 1996-2004
7 -----------------------------------------------------------------------------
16 #include "HsVersions.h"
17 #include "nativeGen/NCG.h"
21 import SPARC.CodeGen.Sanity
22 import SPARC.CodeGen.Amode
23 import SPARC.CodeGen.CondCode
24 import SPARC.CodeGen.Gen64
25 import SPARC.CodeGen.Gen32
26 import SPARC.CodeGen.CCall
27 import SPARC.CodeGen.Base
37 -- Our intermediate code:
43 import StaticFlags ( opt_PIC )
45 import qualified Outputable as O
48 import Control.Monad ( mapAndUnzipM )
51 -- | Top level code generation
55 -> NatM [NatCmmTop Instr]
58 (CmmProc info lab params (ListGraph blocks))
60 (nat_blocks,statics) <- mapAndUnzipM basicBlockCodeGen blocks
62 let proc = CmmProc info lab params (ListGraph $ concat nat_blocks)
63 let tops = proc : concat statics
67 cmmTopCodeGen _ (CmmData sec dat) = do
68 return [CmmData sec dat] -- no translation, we just use CmmStatic
71 -- | Do code generation on a single block of CMM code.
72 -- code generation may introduce new basic block boundaries, which
73 -- are indicated by the NEWBLOCK instruction. We must split up the
74 -- instruction stream into basic blocks again. Also, we extract
78 -> NatM ( [NatBasicBlock Instr]
81 basicBlockCodeGen cmm@(BasicBlock id stmts) = do
82 instrs <- stmtsToInstrs stmts
84 (top,other_blocks,statics)
85 = foldrOL mkBlocks ([],[],[]) instrs
87 mkBlocks (NEWBLOCK id) (instrs,blocks,statics)
88 = ([], BasicBlock id instrs : blocks, statics)
90 mkBlocks (LDATA sec dat) (instrs,blocks,statics)
91 = (instrs, blocks, CmmData sec dat:statics)
93 mkBlocks instr (instrs,blocks,statics)
94 = (instr:instrs, blocks, statics)
96 -- do intra-block sanity checking
98 = map (checkBlock cmm)
99 $ BasicBlock id top : other_blocks
101 return (blocksChecked, statics)
104 -- | Convert some Cmm statements to SPARC instructions.
105 stmtsToInstrs :: [CmmStmt] -> NatM InstrBlock
107 = do instrss <- mapM stmtToInstrs stmts
108 return (concatOL instrss)
111 stmtToInstrs :: CmmStmt -> NatM InstrBlock
112 stmtToInstrs stmt = case stmt of
113 CmmNop -> return nilOL
114 CmmComment s -> return (unitOL (COMMENT s))
117 | isFloatType ty -> assignReg_FltCode size reg src
118 | isWord64 ty -> assignReg_I64Code reg src
119 | otherwise -> assignReg_IntCode size reg src
120 where ty = cmmRegType reg
121 size = cmmTypeSize ty
124 | isFloatType ty -> assignMem_FltCode size addr src
125 | isWord64 ty -> assignMem_I64Code addr src
126 | otherwise -> assignMem_IntCode size addr src
127 where ty = cmmExprType src
128 size = cmmTypeSize ty
130 CmmCall target result_regs args _ _
131 -> genCCall target result_regs args
133 CmmBranch id -> genBranch id
134 CmmCondBranch arg id -> genCondJump id arg
135 CmmSwitch arg ids -> genSwitch arg ids
136 CmmJump arg _ -> genJump arg
139 -> panic "stmtToInstrs: return statement should have been cps'd away"
143 Now, given a tree (the argument to an CmmLoad) that references memory,
144 produce a suitable addressing mode.
146 A Rule of the Game (tm) for Amodes: use of the addr bit must
147 immediately follow use of the code part, since the code part puts
148 values in registers which the addr then refers to. So you can't put
149 anything in between, lest it overwrite some of those registers. If
150 you need to do some other computation between the code part and use of
151 the addr bit, first store the effective address from the amode in a
152 temporary, then do the other computation, and then use the temporary:
156 ... other computation ...
162 -- | Convert a BlockId to some CmmStatic data
163 jumpTableEntry :: Maybe BlockId -> CmmStatic
164 jumpTableEntry Nothing = CmmStaticLit (CmmInt 0 wordWidth)
165 jumpTableEntry (Just (BlockId id)) = CmmStaticLit (CmmLabel blockLabel)
166 where blockLabel = mkAsmTempLabel id
170 -- -----------------------------------------------------------------------------
171 -- Generating assignments
173 -- Assignments are really at the heart of the whole code generation
174 -- business. Almost all top-level nodes of any real importance are
175 -- assignments, which correspond to loads, stores, or register
176 -- transfers. If we're really lucky, some of the register transfers
177 -- will go away, because we can use the destination register to
178 -- complete the code generation for the right hand side. This only
179 -- fails when the right hand side is forced into a fixed register
180 -- (e.g. the result of a call).
182 assignMem_IntCode :: Size -> CmmExpr -> CmmExpr -> NatM InstrBlock
183 assignMem_IntCode pk addr src = do
184 (srcReg, code) <- getSomeReg src
185 Amode dstAddr addr_code <- getAmode addr
186 return $ code `appOL` addr_code `snocOL` ST pk srcReg dstAddr
189 assignReg_IntCode :: Size -> CmmReg -> CmmExpr -> NatM InstrBlock
190 assignReg_IntCode _ reg src = do
193 Any _ code -> code dst
194 Fixed _ freg fcode -> fcode `snocOL` OR False g0 (RIReg freg) dst
196 dst = getRegisterReg reg
200 -- Floating point assignment to memory
201 assignMem_FltCode :: Size -> CmmExpr -> CmmExpr -> NatM InstrBlock
202 assignMem_FltCode pk addr src = do
203 Amode dst__2 code1 <- getAmode addr
204 (src__2, code2) <- getSomeReg src
205 tmp1 <- getNewRegNat pk
207 pk__2 = cmmExprType src
208 code__2 = code1 `appOL` code2 `appOL`
209 if sizeToWidth pk == typeWidth pk__2
210 then unitOL (ST pk src__2 dst__2)
211 else toOL [ FxTOy (cmmTypeSize pk__2) pk src__2 tmp1
215 -- Floating point assignment to a register/temporary
216 assignReg_FltCode :: Size -> CmmReg -> CmmExpr -> NatM InstrBlock
217 assignReg_FltCode pk dstCmmReg srcCmmExpr = do
218 srcRegister <- getRegister srcCmmExpr
219 let dstReg = getRegisterReg dstCmmReg
221 return $ case srcRegister of
222 Any _ code -> code dstReg
223 Fixed _ srcFixedReg srcCode -> srcCode `snocOL` FMOV pk srcFixedReg dstReg
228 genJump :: CmmExpr{-the branch target-} -> NatM InstrBlock
230 genJump (CmmLit (CmmLabel lbl))
231 = return (toOL [CALL (Left target) 0 True, NOP])
237 (target, code) <- getSomeReg tree
238 return (code `snocOL` JMP (AddrRegReg target g0) `snocOL` NOP)
240 -- -----------------------------------------------------------------------------
241 -- Unconditional branches
243 genBranch :: BlockId -> NatM InstrBlock
244 genBranch = return . toOL . mkJumpInstr
247 -- -----------------------------------------------------------------------------
251 Conditional jumps are always to local labels, so we can use branch
252 instructions. We peek at the arguments to decide what kind of
255 SPARC: First, we have to ensure that the condition codes are set
256 according to the supplied comparison operation. We generate slightly
257 different code for floating point comparisons, because a floating
258 point operation cannot directly precede a @BF@. We assume the worst
259 and fill that slot with a @NOP@.
261 SPARC: Do not fill the delay slots here; you will confuse the register
267 :: BlockId -- the branch target
268 -> CmmExpr -- the condition on which to branch
273 genCondJump bid bool = do
274 CondCode is_float cond code <- getCondCode bool
279 then [NOP, BF cond False bid, NOP]
280 else [BI cond False bid, NOP]
286 -- -----------------------------------------------------------------------------
287 -- Generating a table-branch
289 genSwitch :: CmmExpr -> [Maybe BlockId] -> NatM InstrBlock
292 = error "MachCodeGen: sparc genSwitch PIC not finished\n"
295 = do (e_reg, e_code) <- getSomeReg expr
297 base_reg <- getNewRegNat II32
298 offset_reg <- getNewRegNat II32
299 dst <- getNewRegNat II32
301 label <- getNewLabelNat
302 let jumpTable = map jumpTableEntry ids
304 return $ e_code `appOL`
307 [ LDATA ReadOnlyData (CmmDataLabel label : jumpTable)
309 -- load base of jump table
310 , SETHI (HI (ImmCLbl label)) base_reg
311 , OR False base_reg (RIImm $ LO $ ImmCLbl label) base_reg
313 -- the addrs in the table are 32 bits wide..
314 , SLL e_reg (RIImm $ ImmInt 2) offset_reg
316 -- load and jump to the destination
317 , LD II32 (AddrRegReg base_reg offset_reg) dst
318 , JMP_TBL (AddrRegImm dst (ImmInt 0)) [i | Just i <- ids]