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"
18 #include "../includes/MachDeps.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 )
47 import Control.Monad ( mapAndUnzipM )
50 -- | Top level code generation
54 -> NatM [NatCmmTop Instr]
57 (CmmProc info lab params (ListGraph blocks))
59 (nat_blocks,statics) <- mapAndUnzipM basicBlockCodeGen blocks
61 let proc = CmmProc info lab params (ListGraph $ concat nat_blocks)
62 let tops = proc : concat statics
66 cmmTopCodeGen _ (CmmData sec dat) = do
67 return [CmmData sec dat] -- no translation, we just use CmmStatic
70 -- | Do code generation on a single block of CMM code.
71 -- code generation may introduce new basic block boundaries, which
72 -- are indicated by the NEWBLOCK instruction. We must split up the
73 -- instruction stream into basic blocks again. Also, we extract
77 -> NatM ( [NatBasicBlock Instr]
80 basicBlockCodeGen cmm@(BasicBlock id stmts) = do
81 instrs <- stmtsToInstrs stmts
83 (top,other_blocks,statics)
84 = foldrOL mkBlocks ([],[],[]) instrs
86 mkBlocks (NEWBLOCK id) (instrs,blocks,statics)
87 = ([], BasicBlock id instrs : blocks, statics)
89 mkBlocks (LDATA sec dat) (instrs,blocks,statics)
90 = (instrs, blocks, CmmData sec dat:statics)
92 mkBlocks instr (instrs,blocks,statics)
93 = (instr:instrs, blocks, statics)
95 -- do intra-block sanity checking
97 = map (checkBlock cmm)
98 $ BasicBlock id top : other_blocks
100 return (blocksChecked, statics)
103 -- | Convert some Cmm statements to SPARC instructions.
104 stmtsToInstrs :: [CmmStmt] -> NatM InstrBlock
106 = do instrss <- mapM stmtToInstrs stmts
107 return (concatOL instrss)
110 stmtToInstrs :: CmmStmt -> NatM InstrBlock
111 stmtToInstrs stmt = case stmt of
112 CmmNop -> return nilOL
113 CmmComment s -> return (unitOL (COMMENT s))
116 | isFloatType ty -> assignReg_FltCode size reg src
117 | isWord64 ty -> assignReg_I64Code reg src
118 | otherwise -> assignReg_IntCode size reg src
119 where ty = cmmRegType reg
120 size = cmmTypeSize ty
123 | isFloatType ty -> assignMem_FltCode size addr src
124 | isWord64 ty -> assignMem_I64Code addr src
125 | otherwise -> assignMem_IntCode size addr src
126 where ty = cmmExprType src
127 size = cmmTypeSize ty
129 CmmCall target result_regs args _ _
130 -> genCCall target result_regs args
132 CmmBranch id -> genBranch id
133 CmmCondBranch arg id -> genCondJump id arg
134 CmmSwitch arg ids -> genSwitch arg ids
135 CmmJump arg _ -> genJump arg
138 -> panic "stmtToInstrs: return statement should have been cps'd away"
142 Now, given a tree (the argument to an CmmLoad) that references memory,
143 produce a suitable addressing mode.
145 A Rule of the Game (tm) for Amodes: use of the addr bit must
146 immediately follow use of the code part, since the code part puts
147 values in registers which the addr then refers to. So you can't put
148 anything in between, lest it overwrite some of those registers. If
149 you need to do some other computation between the code part and use of
150 the addr bit, first store the effective address from the amode in a
151 temporary, then do the other computation, and then use the temporary:
155 ... other computation ...
161 -- | Convert a BlockId to some CmmStatic data
162 jumpTableEntry :: Maybe BlockId -> CmmStatic
163 jumpTableEntry Nothing = CmmStaticLit (CmmInt 0 wordWidth)
164 jumpTableEntry (Just (BlockId id)) = CmmStaticLit (CmmLabel blockLabel)
165 where blockLabel = mkAsmTempLabel id
169 -- -----------------------------------------------------------------------------
170 -- Generating assignments
172 -- Assignments are really at the heart of the whole code generation
173 -- business. Almost all top-level nodes of any real importance are
174 -- assignments, which correspond to loads, stores, or register
175 -- transfers. If we're really lucky, some of the register transfers
176 -- will go away, because we can use the destination register to
177 -- complete the code generation for the right hand side. This only
178 -- fails when the right hand side is forced into a fixed register
179 -- (e.g. the result of a call).
181 assignMem_IntCode :: Size -> CmmExpr -> CmmExpr -> NatM InstrBlock
182 assignMem_IntCode pk addr src = do
183 (srcReg, code) <- getSomeReg src
184 Amode dstAddr addr_code <- getAmode addr
185 return $ code `appOL` addr_code `snocOL` ST pk srcReg dstAddr
188 assignReg_IntCode :: Size -> CmmReg -> CmmExpr -> NatM InstrBlock
189 assignReg_IntCode _ reg src = do
192 Any _ code -> code dst
193 Fixed _ freg fcode -> fcode `snocOL` OR False g0 (RIReg freg) dst
195 dst = getRegisterReg reg
199 -- Floating point assignment to memory
200 assignMem_FltCode :: Size -> CmmExpr -> CmmExpr -> NatM InstrBlock
201 assignMem_FltCode pk addr src = do
202 Amode dst__2 code1 <- getAmode addr
203 (src__2, code2) <- getSomeReg src
204 tmp1 <- getNewRegNat pk
206 pk__2 = cmmExprType src
207 code__2 = code1 `appOL` code2 `appOL`
208 if sizeToWidth pk == typeWidth pk__2
209 then unitOL (ST pk src__2 dst__2)
210 else toOL [ FxTOy (cmmTypeSize pk__2) pk src__2 tmp1
214 -- Floating point assignment to a register/temporary
215 assignReg_FltCode :: Size -> CmmReg -> CmmExpr -> NatM InstrBlock
216 assignReg_FltCode pk dstCmmReg srcCmmExpr = do
217 srcRegister <- getRegister srcCmmExpr
218 let dstReg = getRegisterReg dstCmmReg
220 return $ case srcRegister of
221 Any _ code -> code dstReg
222 Fixed _ srcFixedReg srcCode -> srcCode `snocOL` FMOV pk srcFixedReg dstReg
227 genJump :: CmmExpr{-the branch target-} -> NatM InstrBlock
229 genJump (CmmLit (CmmLabel lbl))
230 = return (toOL [CALL (Left target) 0 True, NOP])
236 (target, code) <- getSomeReg tree
237 return (code `snocOL` JMP (AddrRegReg target g0) `snocOL` NOP)
239 -- -----------------------------------------------------------------------------
240 -- Unconditional branches
242 genBranch :: BlockId -> NatM InstrBlock
243 genBranch = return . toOL . mkJumpInstr
246 -- -----------------------------------------------------------------------------
250 Conditional jumps are always to local labels, so we can use branch
251 instructions. We peek at the arguments to decide what kind of
254 SPARC: First, we have to ensure that the condition codes are set
255 according to the supplied comparison operation. We generate slightly
256 different code for floating point comparisons, because a floating
257 point operation cannot directly precede a @BF@. We assume the worst
258 and fill that slot with a @NOP@.
260 SPARC: Do not fill the delay slots here; you will confuse the register
266 :: BlockId -- the branch target
267 -> CmmExpr -- the condition on which to branch
272 genCondJump bid bool = do
273 CondCode is_float cond code <- getCondCode bool
278 then [NOP, BF cond False bid, NOP]
279 else [BI cond False bid, NOP]
285 -- -----------------------------------------------------------------------------
286 -- Generating a table-branch
288 genSwitch :: CmmExpr -> [Maybe BlockId] -> NatM InstrBlock
291 = error "MachCodeGen: sparc genSwitch PIC not finished\n"
294 = do (e_reg, e_code) <- getSomeReg expr
296 base_reg <- getNewRegNat II32
297 offset_reg <- getNewRegNat II32
298 dst <- getNewRegNat II32
300 label <- getNewLabelNat
301 let jumpTable = map jumpTableEntry ids
303 return $ e_code `appOL`
306 [ LDATA ReadOnlyData (CmmDataLabel label : jumpTable)
308 -- load base of jump table
309 , SETHI (HI (ImmCLbl label)) base_reg
310 , OR False base_reg (RIImm $ LO $ ImmCLbl label) base_reg
312 -- the addrs in the table are 32 bits wide..
313 , SLL e_reg (RIImm $ ImmInt 2) offset_reg
315 -- load and jump to the destination
316 , LD II32 (AddrRegReg base_reg offset_reg) dst
317 , JMP_TBL (AddrRegImm dst (ImmInt 0)) [i | Just i <- ids]