Delete FastBool
[ghc.git] / compiler / nativeGen / SPARC / Instr.hs
1 {-# LANGUAGE CPP #-}
2
3 -----------------------------------------------------------------------------
4 --
5 -- Machine-dependent assembly language
6 --
7 -- (c) The University of Glasgow 1993-2004
8 --
9 -----------------------------------------------------------------------------
10 #include "HsVersions.h"
11 #include "nativeGen/NCG.h"
12
13 module SPARC.Instr (
14 RI(..),
15 riZero,
16
17 fpRelEA,
18 moveSp,
19
20 isUnconditionalJump,
21
22 Instr(..),
23 maxSpillSlots
24 )
25
26 where
27
28 import SPARC.Stack
29 import SPARC.Imm
30 import SPARC.AddrMode
31 import SPARC.Cond
32 import SPARC.Regs
33 import SPARC.Base
34 import TargetReg
35 import Instruction
36 import RegClass
37 import Reg
38 import Format
39
40 import CLabel
41 import CodeGen.Platform
42 import BlockId
43 import DynFlags
44 import Cmm
45 import FastString
46 import Outputable
47 import Platform
48
49
50 -- | Register or immediate
51 data RI
52 = RIReg Reg
53 | RIImm Imm
54
55 -- | Check if a RI represents a zero value.
56 -- - a literal zero
57 -- - register %g0, which is always zero.
58 --
59 riZero :: RI -> Bool
60 riZero (RIImm (ImmInt 0)) = True
61 riZero (RIImm (ImmInteger 0)) = True
62 riZero (RIReg (RegReal (RealRegSingle 0))) = True
63 riZero _ = False
64
65
66 -- | Calculate the effective address which would be used by the
67 -- corresponding fpRel sequence.
68 fpRelEA :: Int -> Reg -> Instr
69 fpRelEA n dst
70 = ADD False False fp (RIImm (ImmInt (n * wordLength))) dst
71
72
73 -- | Code to shift the stack pointer by n words.
74 moveSp :: Int -> Instr
75 moveSp n
76 = ADD False False sp (RIImm (ImmInt (n * wordLength))) sp
77
78 -- | An instruction that will cause the one after it never to be exectuted
79 isUnconditionalJump :: Instr -> Bool
80 isUnconditionalJump ii
81 = case ii of
82 CALL{} -> True
83 JMP{} -> True
84 JMP_TBL{} -> True
85 BI ALWAYS _ _ -> True
86 BF ALWAYS _ _ -> True
87 _ -> False
88
89
90 -- | instance for sparc instruction set
91 instance Instruction Instr where
92 regUsageOfInstr = sparc_regUsageOfInstr
93 patchRegsOfInstr = sparc_patchRegsOfInstr
94 isJumpishInstr = sparc_isJumpishInstr
95 jumpDestsOfInstr = sparc_jumpDestsOfInstr
96 patchJumpInstr = sparc_patchJumpInstr
97 mkSpillInstr = sparc_mkSpillInstr
98 mkLoadInstr = sparc_mkLoadInstr
99 takeDeltaInstr = sparc_takeDeltaInstr
100 isMetaInstr = sparc_isMetaInstr
101 mkRegRegMoveInstr = sparc_mkRegRegMoveInstr
102 takeRegRegMoveInstr = sparc_takeRegRegMoveInstr
103 mkJumpInstr = sparc_mkJumpInstr
104 mkStackAllocInstr = panic "no sparc_mkStackAllocInstr"
105 mkStackDeallocInstr = panic "no sparc_mkStackDeallocInstr"
106
107
108 -- | SPARC instruction set.
109 -- Not complete. This is only the ones we need.
110 --
111 data Instr
112
113 -- meta ops --------------------------------------------------
114 -- comment pseudo-op
115 = COMMENT FastString
116
117 -- some static data spat out during code generation.
118 -- Will be extracted before pretty-printing.
119 | LDATA Section CmmStatics
120
121 -- Start a new basic block. Useful during codegen, removed later.
122 -- Preceding instruction should be a jump, as per the invariants
123 -- for a BasicBlock (see Cmm).
124 | NEWBLOCK BlockId
125
126 -- specify current stack offset for benefit of subsequent passes.
127 | DELTA Int
128
129 -- real instrs -----------------------------------------------
130 -- Loads and stores.
131 | LD Format AddrMode Reg -- format, src, dst
132 | ST Format Reg AddrMode -- format, src, dst
133
134 -- Int Arithmetic.
135 -- x: add/sub with carry bit.
136 -- In SPARC V9 addx and friends were renamed addc.
137 --
138 -- cc: modify condition codes
139 --
140 | ADD Bool Bool Reg RI Reg -- x?, cc?, src1, src2, dst
141 | SUB Bool Bool Reg RI Reg -- x?, cc?, src1, src2, dst
142
143 | UMUL Bool Reg RI Reg -- cc?, src1, src2, dst
144 | SMUL Bool Reg RI Reg -- cc?, src1, src2, dst
145
146
147 -- The SPARC divide instructions perform 64bit by 32bit division
148 -- The Y register is xored into the first operand.
149
150 -- On _some implementations_ the Y register is overwritten by
151 -- the remainder, so we have to make sure it is 0 each time.
152
153 -- dst <- ((Y `shiftL` 32) `or` src1) `div` src2
154 | UDIV Bool Reg RI Reg -- cc?, src1, src2, dst
155 | SDIV Bool Reg RI Reg -- cc?, src1, src2, dst
156
157 | RDY Reg -- move contents of Y register to reg
158 | WRY Reg Reg -- Y <- src1 `xor` src2
159
160 -- Logic operations.
161 | AND Bool Reg RI Reg -- cc?, src1, src2, dst
162 | ANDN Bool Reg RI Reg -- cc?, src1, src2, dst
163 | OR Bool Reg RI Reg -- cc?, src1, src2, dst
164 | ORN Bool Reg RI Reg -- cc?, src1, src2, dst
165 | XOR Bool Reg RI Reg -- cc?, src1, src2, dst
166 | XNOR Bool Reg RI Reg -- cc?, src1, src2, dst
167 | SLL Reg RI Reg -- src1, src2, dst
168 | SRL Reg RI Reg -- src1, src2, dst
169 | SRA Reg RI Reg -- src1, src2, dst
170
171 -- Load immediates.
172 | SETHI Imm Reg -- src, dst
173
174 -- Do nothing.
175 -- Implemented by the assembler as SETHI 0, %g0, but worth an alias
176 | NOP
177
178 -- Float Arithmetic.
179 -- Note that we cheat by treating F{ABS,MOV,NEG} of doubles as single
180 -- instructions right up until we spit them out.
181 --
182 | FABS Format Reg Reg -- src dst
183 | FADD Format Reg Reg Reg -- src1, src2, dst
184 | FCMP Bool Format Reg Reg -- exception?, src1, src2, dst
185 | FDIV Format Reg Reg Reg -- src1, src2, dst
186 | FMOV Format Reg Reg -- src, dst
187 | FMUL Format Reg Reg Reg -- src1, src2, dst
188 | FNEG Format Reg Reg -- src, dst
189 | FSQRT Format Reg Reg -- src, dst
190 | FSUB Format Reg Reg Reg -- src1, src2, dst
191 | FxTOy Format Format Reg Reg -- src, dst
192
193 -- Jumping around.
194 | BI Cond Bool BlockId -- cond, annul?, target
195 | BF Cond Bool BlockId -- cond, annul?, target
196
197 | JMP AddrMode -- target
198
199 -- With a tabled jump we know all the possible destinations.
200 -- We also need this info so we can work out what regs are live across the jump.
201 --
202 | JMP_TBL AddrMode [Maybe BlockId] CLabel
203
204 | CALL (Either Imm Reg) Int Bool -- target, args, terminal
205
206
207 -- | regUsage returns the sets of src and destination registers used
208 -- by a particular instruction. Machine registers that are
209 -- pre-allocated to stgRegs are filtered out, because they are
210 -- uninteresting from a register allocation standpoint. (We wouldn't
211 -- want them to end up on the free list!) As far as we are concerned,
212 -- the fixed registers simply don't exist (for allocation purposes,
213 -- anyway).
214
215 -- regUsage doesn't need to do any trickery for jumps and such. Just
216 -- state precisely the regs read and written by that insn. The
217 -- consequences of control flow transfers, as far as register
218 -- allocation goes, are taken care of by the register allocator.
219 --
220 sparc_regUsageOfInstr :: Platform -> Instr -> RegUsage
221 sparc_regUsageOfInstr platform instr
222 = case instr of
223 LD _ addr reg -> usage (regAddr addr, [reg])
224 ST _ reg addr -> usage (reg : regAddr addr, [])
225 ADD _ _ r1 ar r2 -> usage (r1 : regRI ar, [r2])
226 SUB _ _ r1 ar r2 -> usage (r1 : regRI ar, [r2])
227 UMUL _ r1 ar r2 -> usage (r1 : regRI ar, [r2])
228 SMUL _ r1 ar r2 -> usage (r1 : regRI ar, [r2])
229 UDIV _ r1 ar r2 -> usage (r1 : regRI ar, [r2])
230 SDIV _ r1 ar r2 -> usage (r1 : regRI ar, [r2])
231 RDY rd -> usage ([], [rd])
232 WRY r1 r2 -> usage ([r1, r2], [])
233 AND _ r1 ar r2 -> usage (r1 : regRI ar, [r2])
234 ANDN _ r1 ar r2 -> usage (r1 : regRI ar, [r2])
235 OR _ r1 ar r2 -> usage (r1 : regRI ar, [r2])
236 ORN _ r1 ar r2 -> usage (r1 : regRI ar, [r2])
237 XOR _ r1 ar r2 -> usage (r1 : regRI ar, [r2])
238 XNOR _ r1 ar r2 -> usage (r1 : regRI ar, [r2])
239 SLL r1 ar r2 -> usage (r1 : regRI ar, [r2])
240 SRL r1 ar r2 -> usage (r1 : regRI ar, [r2])
241 SRA r1 ar r2 -> usage (r1 : regRI ar, [r2])
242 SETHI _ reg -> usage ([], [reg])
243 FABS _ r1 r2 -> usage ([r1], [r2])
244 FADD _ r1 r2 r3 -> usage ([r1, r2], [r3])
245 FCMP _ _ r1 r2 -> usage ([r1, r2], [])
246 FDIV _ r1 r2 r3 -> usage ([r1, r2], [r3])
247 FMOV _ r1 r2 -> usage ([r1], [r2])
248 FMUL _ r1 r2 r3 -> usage ([r1, r2], [r3])
249 FNEG _ r1 r2 -> usage ([r1], [r2])
250 FSQRT _ r1 r2 -> usage ([r1], [r2])
251 FSUB _ r1 r2 r3 -> usage ([r1, r2], [r3])
252 FxTOy _ _ r1 r2 -> usage ([r1], [r2])
253
254 JMP addr -> usage (regAddr addr, [])
255 JMP_TBL addr _ _ -> usage (regAddr addr, [])
256
257 CALL (Left _ ) _ True -> noUsage
258 CALL (Left _ ) n False -> usage (argRegs n, callClobberedRegs)
259 CALL (Right reg) _ True -> usage ([reg], [])
260 CALL (Right reg) n False -> usage (reg : (argRegs n), callClobberedRegs)
261 _ -> noUsage
262
263 where
264 usage (src, dst)
265 = RU (filter (interesting platform) src)
266 (filter (interesting platform) dst)
267
268 regAddr (AddrRegReg r1 r2) = [r1, r2]
269 regAddr (AddrRegImm r1 _) = [r1]
270
271 regRI (RIReg r) = [r]
272 regRI _ = []
273
274
275 -- | Interesting regs are virtuals, or ones that are allocatable
276 -- by the register allocator.
277 interesting :: Platform -> Reg -> Bool
278 interesting platform reg
279 = case reg of
280 RegVirtual _ -> True
281 RegReal (RealRegSingle r1) -> freeReg platform r1
282 RegReal (RealRegPair r1 _) -> freeReg platform r1
283
284
285
286 -- | Apply a given mapping to tall the register references in this instruction.
287 sparc_patchRegsOfInstr :: Instr -> (Reg -> Reg) -> Instr
288 sparc_patchRegsOfInstr instr env = case instr of
289 LD fmt addr reg -> LD fmt (fixAddr addr) (env reg)
290 ST fmt reg addr -> ST fmt (env reg) (fixAddr addr)
291
292 ADD x cc r1 ar r2 -> ADD x cc (env r1) (fixRI ar) (env r2)
293 SUB x cc r1 ar r2 -> SUB x cc (env r1) (fixRI ar) (env r2)
294 UMUL cc r1 ar r2 -> UMUL cc (env r1) (fixRI ar) (env r2)
295 SMUL cc r1 ar r2 -> SMUL cc (env r1) (fixRI ar) (env r2)
296 UDIV cc r1 ar r2 -> UDIV cc (env r1) (fixRI ar) (env r2)
297 SDIV cc r1 ar r2 -> SDIV cc (env r1) (fixRI ar) (env r2)
298 RDY rd -> RDY (env rd)
299 WRY r1 r2 -> WRY (env r1) (env r2)
300 AND b r1 ar r2 -> AND b (env r1) (fixRI ar) (env r2)
301 ANDN b r1 ar r2 -> ANDN b (env r1) (fixRI ar) (env r2)
302 OR b r1 ar r2 -> OR b (env r1) (fixRI ar) (env r2)
303 ORN b r1 ar r2 -> ORN b (env r1) (fixRI ar) (env r2)
304 XOR b r1 ar r2 -> XOR b (env r1) (fixRI ar) (env r2)
305 XNOR b r1 ar r2 -> XNOR b (env r1) (fixRI ar) (env r2)
306 SLL r1 ar r2 -> SLL (env r1) (fixRI ar) (env r2)
307 SRL r1 ar r2 -> SRL (env r1) (fixRI ar) (env r2)
308 SRA r1 ar r2 -> SRA (env r1) (fixRI ar) (env r2)
309
310 SETHI imm reg -> SETHI imm (env reg)
311
312 FABS s r1 r2 -> FABS s (env r1) (env r2)
313 FADD s r1 r2 r3 -> FADD s (env r1) (env r2) (env r3)
314 FCMP e s r1 r2 -> FCMP e s (env r1) (env r2)
315 FDIV s r1 r2 r3 -> FDIV s (env r1) (env r2) (env r3)
316 FMOV s r1 r2 -> FMOV s (env r1) (env r2)
317 FMUL s r1 r2 r3 -> FMUL s (env r1) (env r2) (env r3)
318 FNEG s r1 r2 -> FNEG s (env r1) (env r2)
319 FSQRT s r1 r2 -> FSQRT s (env r1) (env r2)
320 FSUB s r1 r2 r3 -> FSUB s (env r1) (env r2) (env r3)
321 FxTOy s1 s2 r1 r2 -> FxTOy s1 s2 (env r1) (env r2)
322
323 JMP addr -> JMP (fixAddr addr)
324 JMP_TBL addr ids l -> JMP_TBL (fixAddr addr) ids l
325
326 CALL (Left i) n t -> CALL (Left i) n t
327 CALL (Right r) n t -> CALL (Right (env r)) n t
328 _ -> instr
329
330 where
331 fixAddr (AddrRegReg r1 r2) = AddrRegReg (env r1) (env r2)
332 fixAddr (AddrRegImm r1 i) = AddrRegImm (env r1) i
333
334 fixRI (RIReg r) = RIReg (env r)
335 fixRI other = other
336
337
338 --------------------------------------------------------------------------------
339 sparc_isJumpishInstr :: Instr -> Bool
340 sparc_isJumpishInstr instr
341 = case instr of
342 BI{} -> True
343 BF{} -> True
344 JMP{} -> True
345 JMP_TBL{} -> True
346 CALL{} -> True
347 _ -> False
348
349 sparc_jumpDestsOfInstr :: Instr -> [BlockId]
350 sparc_jumpDestsOfInstr insn
351 = case insn of
352 BI _ _ id -> [id]
353 BF _ _ id -> [id]
354 JMP_TBL _ ids _ -> [id | Just id <- ids]
355 _ -> []
356
357
358 sparc_patchJumpInstr :: Instr -> (BlockId -> BlockId) -> Instr
359 sparc_patchJumpInstr insn patchF
360 = case insn of
361 BI cc annul id -> BI cc annul (patchF id)
362 BF cc annul id -> BF cc annul (patchF id)
363 JMP_TBL n ids l -> JMP_TBL n (map (fmap patchF) ids) l
364 _ -> insn
365
366
367 --------------------------------------------------------------------------------
368 -- | Make a spill instruction.
369 -- On SPARC we spill below frame pointer leaving 2 words/spill
370 sparc_mkSpillInstr
371 :: DynFlags
372 -> Reg -- ^ register to spill
373 -> Int -- ^ current stack delta
374 -> Int -- ^ spill slot to use
375 -> Instr
376
377 sparc_mkSpillInstr dflags reg _ slot
378 = let platform = targetPlatform dflags
379 off = spillSlotToOffset dflags slot
380 off_w = 1 + (off `div` 4)
381 fmt = case targetClassOfReg platform reg of
382 RcInteger -> II32
383 RcFloat -> FF32
384 RcDouble -> FF64
385 _ -> panic "sparc_mkSpillInstr"
386
387 in ST fmt reg (fpRel (negate off_w))
388
389
390 -- | Make a spill reload instruction.
391 sparc_mkLoadInstr
392 :: DynFlags
393 -> Reg -- ^ register to load into
394 -> Int -- ^ current stack delta
395 -> Int -- ^ spill slot to use
396 -> Instr
397
398 sparc_mkLoadInstr dflags reg _ slot
399 = let platform = targetPlatform dflags
400 off = spillSlotToOffset dflags slot
401 off_w = 1 + (off `div` 4)
402 fmt = case targetClassOfReg platform reg of
403 RcInteger -> II32
404 RcFloat -> FF32
405 RcDouble -> FF64
406 _ -> panic "sparc_mkLoadInstr"
407
408 in LD fmt (fpRel (- off_w)) reg
409
410
411 --------------------------------------------------------------------------------
412 -- | See if this instruction is telling us the current C stack delta
413 sparc_takeDeltaInstr
414 :: Instr
415 -> Maybe Int
416
417 sparc_takeDeltaInstr instr
418 = case instr of
419 DELTA i -> Just i
420 _ -> Nothing
421
422
423 sparc_isMetaInstr
424 :: Instr
425 -> Bool
426
427 sparc_isMetaInstr instr
428 = case instr of
429 COMMENT{} -> True
430 LDATA{} -> True
431 NEWBLOCK{} -> True
432 DELTA{} -> True
433 _ -> False
434
435
436 -- | Make a reg-reg move instruction.
437 -- On SPARC v8 there are no instructions to move directly between
438 -- floating point and integer regs. If we need to do that then we
439 -- have to go via memory.
440 --
441 sparc_mkRegRegMoveInstr
442 :: Platform
443 -> Reg
444 -> Reg
445 -> Instr
446
447 sparc_mkRegRegMoveInstr platform src dst
448 | srcClass <- targetClassOfReg platform src
449 , dstClass <- targetClassOfReg platform dst
450 , srcClass == dstClass
451 = case srcClass of
452 RcInteger -> ADD False False src (RIReg g0) dst
453 RcDouble -> FMOV FF64 src dst
454 RcFloat -> FMOV FF32 src dst
455 _ -> panic "sparc_mkRegRegMoveInstr"
456
457 | otherwise
458 = panic "SPARC.Instr.mkRegRegMoveInstr: classes of src and dest not the same"
459
460
461 -- | Check whether an instruction represents a reg-reg move.
462 -- The register allocator attempts to eliminate reg->reg moves whenever it can,
463 -- by assigning the src and dest temporaries to the same real register.
464 --
465 sparc_takeRegRegMoveInstr :: Instr -> Maybe (Reg,Reg)
466 sparc_takeRegRegMoveInstr instr
467 = case instr of
468 ADD False False src (RIReg src2) dst
469 | g0 == src2 -> Just (src, dst)
470
471 FMOV FF64 src dst -> Just (src, dst)
472 FMOV FF32 src dst -> Just (src, dst)
473 _ -> Nothing
474
475
476 -- | Make an unconditional branch instruction.
477 sparc_mkJumpInstr
478 :: BlockId
479 -> [Instr]
480
481 sparc_mkJumpInstr id
482 = [BI ALWAYS False id
483 , NOP] -- fill the branch delay slot.