4cb688aaa9fb58ed1f0e53c1631b293a41e02a90
[ghc-hetmet.git] / compiler / nativeGen / RegAllocInfo.hs
1 -----------------------------------------------------------------------------
2 --
3 -- Machine-specific parts of the register allocator
4 --
5 -- (c) The University of Glasgow 1996-2004
6 --
7 -----------------------------------------------------------------------------
8
9 #include "nativeGen/NCG.h"
10
11 module RegAllocInfo (
12         RegUsage(..),
13         noUsage,
14         regUsage,
15         patchRegs,
16         jumpDests,
17         patchJump,
18         isRegRegMove,
19
20         JumpDest, canShortcut, shortcutJump, shortcutStatic,
21
22         maxSpillSlots,
23         mkSpillInstr,
24         mkLoadInstr,
25         mkRegRegMoveInstr,
26         mkBranchInstr
27     ) where
28
29 #include "HsVersions.h"
30
31 import Cmm
32 import CLabel
33 import MachOp           ( MachRep(..), wordRep )
34 import MachInstrs
35 import MachRegs
36 import Outputable
37 import Constants        ( rESERVED_C_STACK_BYTES )
38 import FastTypes
39
40 -- -----------------------------------------------------------------------------
41 -- RegUsage type
42
43 -- @regUsage@ returns the sets of src and destination registers used
44 -- by a particular instruction.  Machine registers that are
45 -- pre-allocated to stgRegs are filtered out, because they are
46 -- uninteresting from a register allocation standpoint.  (We wouldn't
47 -- want them to end up on the free list!)  As far as we are concerned,
48 -- the fixed registers simply don't exist (for allocation purposes,
49 -- anyway).
50
51 -- regUsage doesn't need to do any trickery for jumps and such.  Just
52 -- state precisely the regs read and written by that insn.  The
53 -- consequences of control flow transfers, as far as register
54 -- allocation goes, are taken care of by the register allocator.
55
56 data RegUsage = RU [Reg] [Reg]
57
58 noUsage :: RegUsage
59 noUsage  = RU [] []
60
61 regUsage :: Instr -> RegUsage
62
63 interesting (VirtualRegI  _)  = True
64 interesting (VirtualRegHi _)  = True
65 interesting (VirtualRegF  _)  = True
66 interesting (VirtualRegD  _)  = True
67 interesting (RealReg i)       = isFastTrue (freeReg i)
68
69
70 #if alpha_TARGET_ARCH
71 regUsage instr = case instr of
72     LD B reg addr       -> usage (regAddr addr, [reg, t9])
73     LD Bu reg addr      -> usage (regAddr addr, [reg, t9])
74 --  LD W reg addr       -> usage (regAddr addr, [reg, t9]) : UNUSED
75 --  LD Wu reg addr      -> usage (regAddr addr, [reg, t9]) : UNUSED
76     LD sz reg addr      -> usage (regAddr addr, [reg])
77     LDA reg addr        -> usage (regAddr addr, [reg])
78     LDAH reg addr       -> usage (regAddr addr, [reg])
79     LDGP reg addr       -> usage (regAddr addr, [reg])
80     LDI sz reg imm      -> usage ([], [reg])
81     ST B reg addr       -> usage (reg : regAddr addr, [t9, t10])
82 --  ST W reg addr       -> usage (reg : regAddr addr, [t9, t10]) : UNUSED
83     ST sz reg addr      -> usage (reg : regAddr addr, [])
84     CLR reg             -> usage ([], [reg])
85     ABS sz ri reg       -> usage (regRI ri, [reg])
86     NEG sz ov ri reg    -> usage (regRI ri, [reg])
87     ADD sz ov r1 ar r2  -> usage (r1 : regRI ar, [r2])
88     SADD sz sc r1 ar r2 -> usage (r1 : regRI ar, [r2])
89     SUB sz ov r1 ar r2  -> usage (r1 : regRI ar, [r2])
90     SSUB sz sc r1 ar r2 -> usage (r1 : regRI ar, [r2])
91     MUL sz ov r1 ar r2  -> usage (r1 : regRI ar, [r2])
92     DIV sz un r1 ar r2  -> usage (r1 : regRI ar, [r2, t9, t10, t11, t12])
93     REM sz un r1 ar r2  -> usage (r1 : regRI ar, [r2, t9, t10, t11, t12])
94     NOT ri reg          -> usage (regRI ri, [reg])
95     AND r1 ar r2        -> usage (r1 : regRI ar, [r2])
96     ANDNOT r1 ar r2     -> usage (r1 : regRI ar, [r2])
97     OR r1 ar r2         -> usage (r1 : regRI ar, [r2])
98     ORNOT r1 ar r2      -> usage (r1 : regRI ar, [r2])
99     XOR r1 ar r2        -> usage (r1 : regRI ar, [r2])
100     XORNOT r1 ar r2     -> usage (r1 : regRI ar, [r2])
101     SLL r1 ar r2        -> usage (r1 : regRI ar, [r2])
102     SRL r1 ar r2        -> usage (r1 : regRI ar, [r2])
103     SRA r1 ar r2        -> usage (r1 : regRI ar, [r2])
104     ZAP r1 ar r2        -> usage (r1 : regRI ar, [r2])
105     ZAPNOT r1 ar r2     -> usage (r1 : regRI ar, [r2])
106     CMP co r1 ar r2     -> usage (r1 : regRI ar, [r2])
107     FCLR reg            -> usage ([], [reg])
108     FABS r1 r2          -> usage ([r1], [r2])
109     FNEG sz r1 r2       -> usage ([r1], [r2])
110     FADD sz r1 r2 r3    -> usage ([r1, r2], [r3])
111     FDIV sz r1 r2 r3    -> usage ([r1, r2], [r3])
112     FMUL sz r1 r2 r3    -> usage ([r1, r2], [r3])
113     FSUB sz r1 r2 r3    -> usage ([r1, r2], [r3])
114     CVTxy sz1 sz2 r1 r2 -> usage ([r1], [r2])
115     FCMP sz co r1 r2 r3 -> usage ([r1, r2], [r3])
116     FMOV r1 r2          -> usage ([r1], [r2])
117
118
119     -- We assume that all local jumps will be BI/BF/BR.  JMP must be out-of-line.
120     BI cond reg lbl     -> usage ([reg], [])
121     BF cond reg lbl     -> usage ([reg], [])
122     JMP reg addr hint   -> RU (mkRegSet (filter interesting (regAddr addr))) freeRegSet
123
124     BSR _ n             -> RU (argRegSet n) callClobberedRegSet
125     JSR reg addr n      -> RU (argRegSet n) callClobberedRegSet
126
127     _                   -> noUsage
128
129   where
130     usage (src, dst) = RU (mkRegSet (filter interesting src))
131                           (mkRegSet (filter interesting dst))
132
133     interesting (FixedReg _) = False
134     interesting _ = True
135
136     regAddr (AddrReg r1)      = [r1]
137     regAddr (AddrRegImm r1 _) = [r1]
138     regAddr (AddrImm _)       = []
139
140     regRI (RIReg r) = [r]
141     regRI  _    = []
142
143 #endif /* alpha_TARGET_ARCH */
144 -- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
145 #if i386_TARGET_ARCH || x86_64_TARGET_ARCH
146
147 regUsage instr = case instr of
148     MOV    sz src dst   -> usageRW src dst
149     MOVZxL sz src dst   -> usageRW src dst
150     MOVSxL sz src dst   -> usageRW src dst
151     LEA    sz src dst   -> usageRW src dst
152     ADD    sz src dst   -> usageRM src dst
153     ADC    sz src dst   -> usageRM src dst
154     SUB    sz src dst   -> usageRM src dst
155     IMUL   sz src dst   -> usageRM src dst
156     IMUL2  sz src       -> mkRU (eax:use_R src) [eax,edx]
157     MUL    sz src dst   -> usageRM src dst
158     DIV    sz op        -> mkRU (eax:edx:use_R op) [eax,edx]
159     IDIV   sz op        -> mkRU (eax:edx:use_R op) [eax,edx]
160     AND    sz src dst   -> usageRM src dst
161     OR     sz src dst   -> usageRM src dst
162     XOR    sz (OpReg src) (OpReg dst)
163         | src == dst    -> mkRU [] [dst]
164     XOR    sz src dst   -> usageRM src dst
165     NOT    sz op        -> usageM op
166     NEGI   sz op        -> usageM op
167     SHL    sz imm dst   -> usageRM imm dst
168     SAR    sz imm dst   -> usageRM imm dst
169     SHR    sz imm dst   -> usageRM imm dst
170     BT     sz imm src   -> mkRUR (use_R src)
171
172     PUSH   sz op        -> mkRUR (use_R op)
173     POP    sz op        -> mkRU [] (def_W op)
174     TEST   sz src dst   -> mkRUR (use_R src ++ use_R dst)
175     CMP    sz src dst   -> mkRUR (use_R src ++ use_R dst)
176     SETCC  cond op      -> mkRU [] (def_W op)
177     JXX    cond lbl     -> mkRU [] []
178     JXX_GBL cond lbl    -> mkRU [] []
179     JMP    op           -> mkRUR (use_R op)
180     JMP_TBL op ids      -> mkRUR (use_R op)
181     CALL (Left imm)  params -> mkRU params callClobberedRegs
182     CALL (Right reg) params -> mkRU (reg:params) callClobberedRegs
183     CLTD   sz           -> mkRU [eax] [edx]
184     NOP                 -> mkRU [] []
185
186 #if i386_TARGET_ARCH
187     GMOV   src dst      -> mkRU [src] [dst]
188     GLD    sz src dst   -> mkRU (use_EA src) [dst]
189     GST    sz src dst   -> mkRUR (src : use_EA dst)
190
191     GLDZ   dst          -> mkRU [] [dst]
192     GLD1   dst          -> mkRU [] [dst]
193
194     GFTOI  src dst      -> mkRU [src] [dst]
195     GDTOI  src dst      -> mkRU [src] [dst]
196
197     GITOF  src dst      -> mkRU [src] [dst]
198     GITOD  src dst      -> mkRU [src] [dst]
199
200     GADD   sz s1 s2 dst -> mkRU [s1,s2] [dst]
201     GSUB   sz s1 s2 dst -> mkRU [s1,s2] [dst]
202     GMUL   sz s1 s2 dst -> mkRU [s1,s2] [dst]
203     GDIV   sz s1 s2 dst -> mkRU [s1,s2] [dst]
204
205     GCMP   sz src1 src2 -> mkRUR [src1,src2]
206     GABS   sz src dst   -> mkRU [src] [dst]
207     GNEG   sz src dst   -> mkRU [src] [dst]
208     GSQRT  sz src dst   -> mkRU [src] [dst]
209     GSIN   sz src dst   -> mkRU [src] [dst]
210     GCOS   sz src dst   -> mkRU [src] [dst]
211     GTAN   sz src dst   -> mkRU [src] [dst]
212 #endif
213
214 #if x86_64_TARGET_ARCH
215     CVTSS2SD src dst    -> mkRU [src] [dst]
216     CVTSD2SS src dst    -> mkRU [src] [dst]
217     CVTTSS2SIQ src dst  -> mkRU (use_R src) [dst]
218     CVTTSD2SIQ src dst  -> mkRU (use_R src) [dst]
219     CVTSI2SS src dst    -> mkRU (use_R src) [dst]
220     CVTSI2SD src dst    -> mkRU (use_R src) [dst]
221     FDIV sz src dst     -> usageRM src dst
222 #endif    
223
224     FETCHGOT reg        -> mkRU [] [reg]
225     FETCHPC  reg        -> mkRU [] [reg]
226
227     COMMENT _           -> noUsage
228     DELTA   _           -> noUsage
229
230     _other              -> panic "regUsage: unrecognised instr"
231
232  where
233     -- 2 operand form; first operand Read; second Written
234     usageRW :: Operand -> Operand -> RegUsage
235     usageRW op (OpReg reg) = mkRU (use_R op) [reg]
236     usageRW op (OpAddr ea) = mkRUR (use_R op ++ use_EA ea)
237
238     -- 2 operand form; first operand Read; second Modified
239     usageRM :: Operand -> Operand -> RegUsage
240     usageRM op (OpReg reg) = mkRU (use_R op ++ [reg]) [reg]
241     usageRM op (OpAddr ea) = mkRUR (use_R op ++ use_EA ea)
242
243     -- 1 operand form; operand Modified
244     usageM :: Operand -> RegUsage
245     usageM (OpReg reg)    = mkRU [reg] [reg]
246     usageM (OpAddr ea)    = mkRUR (use_EA ea)
247
248     -- Registers defd when an operand is written.
249     def_W (OpReg reg)  = [reg]
250     def_W (OpAddr ea)  = []
251
252     -- Registers used when an operand is read.
253     use_R (OpReg reg)  = [reg]
254     use_R (OpImm imm)  = []
255     use_R (OpAddr ea)  = use_EA ea
256
257     -- Registers used to compute an effective address.
258     use_EA (ImmAddr _ _) = []
259     use_EA (AddrBaseIndex base index _) = 
260         use_base base $! use_index index
261         where use_base (EABaseReg r) x = r : x
262               use_base _ x             = x
263               use_index EAIndexNone   = []
264               use_index (EAIndex i _) = [i]
265
266     mkRUR src = src' `seq` RU src' []
267         where src' = filter interesting src
268
269     mkRU src dst = src' `seq` dst' `seq` RU src' dst'
270         where src' = filter interesting src
271               dst' = filter interesting dst
272
273 #endif /* i386_TARGET_ARCH || x86_64_TARGET_ARCH */
274 -- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
275 #if sparc_TARGET_ARCH
276
277 regUsage instr = case instr of
278     LD    sz addr reg   -> usage (regAddr addr, [reg])
279     ST    sz reg addr   -> usage (reg : regAddr addr, [])
280     ADD   x cc r1 ar r2 -> usage (r1 : regRI ar, [r2])
281     SUB   x cc r1 ar r2 -> usage (r1 : regRI ar, [r2])
282     UMUL    cc r1 ar r2 -> usage (r1 : regRI ar, [r2])
283     SMUL    cc r1 ar r2 -> usage (r1 : regRI ar, [r2])
284     RDY   rd            -> usage ([], [rd])
285     AND   b r1 ar r2    -> usage (r1 : regRI ar, [r2])
286     ANDN  b r1 ar r2    -> usage (r1 : regRI ar, [r2])
287     OR    b r1 ar r2    -> usage (r1 : regRI ar, [r2])
288     ORN   b r1 ar r2    -> usage (r1 : regRI ar, [r2])
289     XOR   b r1 ar r2    -> usage (r1 : regRI ar, [r2])
290     XNOR  b r1 ar r2    -> usage (r1 : regRI ar, [r2])
291     SLL   r1 ar r2      -> usage (r1 : regRI ar, [r2])
292     SRL   r1 ar r2      -> usage (r1 : regRI ar, [r2])
293     SRA   r1 ar r2      -> usage (r1 : regRI ar, [r2])
294     SETHI imm reg       -> usage ([], [reg])
295     FABS  s r1 r2       -> usage ([r1], [r2])
296     FADD  s r1 r2 r3    -> usage ([r1, r2], [r3])
297     FCMP  e s r1 r2     -> usage ([r1, r2], [])
298     FDIV  s r1 r2 r3    -> usage ([r1, r2], [r3])
299     FMOV  s r1 r2       -> usage ([r1], [r2])
300     FMUL  s r1 r2 r3    -> usage ([r1, r2], [r3])
301     FNEG  s r1 r2       -> usage ([r1], [r2])
302     FSQRT s r1 r2       -> usage ([r1], [r2])
303     FSUB  s r1 r2 r3    -> usage ([r1, r2], [r3])
304     FxTOy s1 s2 r1 r2   -> usage ([r1], [r2])
305
306     -- We assume that all local jumps will be BI/BF.  JMP must be out-of-line.
307     JMP   addr          -> usage (regAddr addr, [])
308
309     CALL  (Left imm)  n True  -> noUsage
310     CALL  (Left imm)  n False -> usage (argRegs n, callClobberedRegs)
311     CALL  (Right reg) n True  -> usage ([reg], [])
312     CALL  (Right reg) n False -> usage (reg : (argRegs n), callClobberedRegs)
313
314     _                   -> noUsage
315   where
316     usage (src, dst) = RU (filter interesting src)
317                          (filter interesting dst)
318
319     regAddr (AddrRegReg r1 r2) = [r1, r2]
320     regAddr (AddrRegImm r1 _)  = [r1]
321
322     regRI (RIReg r) = [r]
323     regRI  _    = []
324
325 #endif /* sparc_TARGET_ARCH */
326 -- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
327 #if powerpc_TARGET_ARCH
328
329 regUsage instr = case instr of
330     LD    sz reg addr   -> usage (regAddr addr, [reg])
331     LA    sz reg addr   -> usage (regAddr addr, [reg])
332     ST    sz reg addr   -> usage (reg : regAddr addr, [])
333     STU    sz reg addr  -> usage (reg : regAddr addr, [])
334     LIS   reg imm       -> usage ([], [reg])
335     LI    reg imm       -> usage ([], [reg])
336     MR    reg1 reg2     -> usage ([reg2], [reg1])
337     CMP   sz reg ri     -> usage (reg : regRI ri,[])
338     CMPL  sz reg ri     -> usage (reg : regRI ri,[])
339     BCC   cond lbl      -> noUsage
340     BCCFAR cond lbl     -> noUsage
341     MTCTR reg           -> usage ([reg],[])
342     BCTR  targets       -> noUsage
343     BL    imm params    -> usage (params, callClobberedRegs)
344     BCTRL params        -> usage (params, callClobberedRegs)
345     ADD   reg1 reg2 ri  -> usage (reg2 : regRI ri, [reg1])
346     ADDC  reg1 reg2 reg3-> usage ([reg2,reg3], [reg1])
347     ADDE  reg1 reg2 reg3-> usage ([reg2,reg3], [reg1])
348     ADDIS reg1 reg2 imm -> usage ([reg2], [reg1])
349     SUBF  reg1 reg2 reg3-> usage ([reg2,reg3], [reg1])
350     MULLW reg1 reg2 ri  -> usage (reg2 : regRI ri, [reg1])
351     DIVW  reg1 reg2 reg3-> usage ([reg2,reg3], [reg1])
352     DIVWU reg1 reg2 reg3-> usage ([reg2,reg3], [reg1])
353     MULLW_MayOflo reg1 reg2 reg3        
354                         -> usage ([reg2,reg3], [reg1])
355     AND   reg1 reg2 ri  -> usage (reg2 : regRI ri, [reg1])
356     OR    reg1 reg2 ri  -> usage (reg2 : regRI ri, [reg1])
357     XOR   reg1 reg2 ri  -> usage (reg2 : regRI ri, [reg1])
358     XORIS reg1 reg2 imm -> usage ([reg2], [reg1])
359     EXTS  siz reg1 reg2 -> usage ([reg2], [reg1])
360     NEG   reg1 reg2     -> usage ([reg2], [reg1])
361     NOT   reg1 reg2     -> usage ([reg2], [reg1])
362     SLW   reg1 reg2 ri  -> usage (reg2 : regRI ri, [reg1])
363     SRW   reg1 reg2 ri  -> usage (reg2 : regRI ri, [reg1])
364     SRAW  reg1 reg2 ri  -> usage (reg2 : regRI ri, [reg1])
365     RLWINM reg1 reg2 sh mb me
366                         -> usage ([reg2], [reg1])
367     FADD  sz r1 r2 r3   -> usage ([r2,r3], [r1])
368     FSUB  sz r1 r2 r3   -> usage ([r2,r3], [r1])
369     FMUL  sz r1 r2 r3   -> usage ([r2,r3], [r1])
370     FDIV  sz r1 r2 r3   -> usage ([r2,r3], [r1])
371     FNEG  r1 r2         -> usage ([r2], [r1])
372     FCMP  r1 r2         -> usage ([r1,r2], [])
373     FCTIWZ r1 r2        -> usage ([r2], [r1])
374     FRSP r1 r2          -> usage ([r2], [r1])
375     MFCR reg            -> usage ([], [reg])
376     MFLR reg            -> usage ([], [reg])
377     FETCHPC reg         -> usage ([], [reg])
378     _                   -> noUsage
379   where
380     usage (src, dst) = RU (filter interesting src)
381                           (filter interesting dst)
382     regAddr (AddrRegReg r1 r2) = [r1, r2]
383     regAddr (AddrRegImm r1 _)  = [r1]
384
385     regRI (RIReg r) = [r]
386     regRI  _    = []
387 #endif /* powerpc_TARGET_ARCH */
388
389
390 -- -----------------------------------------------------------------------------
391 -- Determine the possible destinations from the current instruction.
392
393 -- (we always assume that the next instruction is also a valid destination;
394 -- if this isn't the case then the jump should be at the end of the basic
395 -- block).
396
397 jumpDests :: Instr -> [BlockId] -> [BlockId]
398 jumpDests insn acc
399   = case insn of
400 #if i386_TARGET_ARCH || x86_64_TARGET_ARCH
401         JXX _ id        -> id : acc
402         JMP_TBL _ ids   -> ids ++ acc
403 #elif powerpc_TARGET_ARCH
404         BCC _ id        -> id : acc
405         BCCFAR _ id     -> id : acc
406         BCTR targets    -> targets ++ acc
407 #endif
408         _other          -> acc
409
410 patchJump :: Instr -> BlockId -> BlockId -> Instr
411
412 patchJump insn old new
413   = case insn of
414 #if i386_TARGET_ARCH || x86_64_TARGET_ARCH
415         JXX cc id | id == old -> JXX cc new
416         JMP_TBL op ids -> error "Cannot patch JMP_TBL"
417 #elif powerpc_TARGET_ARCH
418         BCC cc id | id == old -> BCC cc new
419         BCCFAR cc id | id == old -> BCCFAR cc new
420         BCTR targets -> error "Cannot patch BCTR"
421 #endif
422         _other          -> insn
423
424 data JumpDest = DestBlockId BlockId | DestImm Imm
425
426 canShortcut :: Instr -> Maybe JumpDest
427 #if i386_TARGET_ARCH || x86_64_TARGET_ARCH
428 canShortcut (JXX ALWAYS id) = Just (DestBlockId id)
429 canShortcut (JMP (OpImm imm)) = Just (DestImm imm)
430 #endif
431 canShortcut _ = Nothing
432
433 shortcutJump :: (BlockId -> Maybe JumpDest) -> Instr -> Instr
434 #if i386_TARGET_ARCH || x86_64_TARGET_ARCH
435 shortcutJump fn insn@(JXX cc id) = 
436   case fn id of
437     Nothing                -> insn
438     Just (DestBlockId id') -> shortcutJump fn (JXX cc id')
439     Just (DestImm imm)     -> shortcutJump fn (JXX_GBL cc imm)
440 #endif
441 shortcutJump fn other = other
442
443 -- Here because it knows about JumpDest
444 shortcutStatic :: (BlockId -> Maybe JumpDest) -> CmmStatic -> CmmStatic
445 shortcutStatic fn (CmmStaticLit (CmmLabel lab))
446   | Just uq <- maybeAsmTemp lab 
447   = CmmStaticLit (CmmLabel (shortBlockId fn (BlockId uq)))
448 shortcutStatic fn (CmmStaticLit (CmmLabelDiffOff lbl1 lbl2 off))
449   | Just uq <- maybeAsmTemp lbl1
450   = CmmStaticLit (CmmLabelDiffOff (shortBlockId fn (BlockId uq)) lbl2 off)
451         -- slightly dodgy, we're ignoring the second label, but this
452         -- works with the way we use CmmLabelDiffOff for jump tables now.
453 shortcutStatic fn other_static
454         = other_static
455
456 shortBlockId fn blockid@(BlockId uq) =
457    case fn blockid of
458       Nothing -> mkAsmTempLabel uq
459       Just (DestBlockId blockid')  -> shortBlockId fn blockid'
460       Just (DestImm (ImmCLbl lbl)) -> lbl
461       _other -> panic "shortBlockId"
462
463 -- -----------------------------------------------------------------------------
464 -- 'patchRegs' function
465
466 -- 'patchRegs' takes an instruction and applies the given mapping to
467 -- all the register references.
468
469 patchRegs :: Instr -> (Reg -> Reg) -> Instr
470
471 #if alpha_TARGET_ARCH
472
473 patchRegs instr env = case instr of
474     LD sz reg addr -> LD sz (env reg) (fixAddr addr)
475     LDA reg addr -> LDA (env reg) (fixAddr addr)
476     LDAH reg addr -> LDAH (env reg) (fixAddr addr)
477     LDGP reg addr -> LDGP (env reg) (fixAddr addr)
478     LDI sz reg imm -> LDI sz (env reg) imm
479     ST sz reg addr -> ST sz (env reg) (fixAddr addr)
480     CLR reg -> CLR (env reg)
481     ABS sz ar reg -> ABS sz (fixRI ar) (env reg)
482     NEG sz ov ar reg -> NEG sz ov (fixRI ar) (env reg)
483     ADD sz ov r1 ar r2 -> ADD sz ov (env r1) (fixRI ar) (env r2)
484     SADD sz sc r1 ar r2 -> SADD sz sc (env r1) (fixRI ar) (env r2)
485     SUB sz ov r1 ar r2 -> SUB sz ov (env r1) (fixRI ar) (env r2)
486     SSUB sz sc r1 ar r2 -> SSUB sz sc (env r1) (fixRI ar) (env r2)
487     MUL sz ov r1 ar r2 -> MUL sz ov (env r1) (fixRI ar) (env r2)
488     DIV sz un r1 ar r2 -> DIV sz un (env r1) (fixRI ar) (env r2)
489     REM sz un r1 ar r2 -> REM sz un (env r1) (fixRI ar) (env r2)
490     NOT ar reg -> NOT (fixRI ar) (env reg)
491     AND r1 ar r2 -> AND (env r1) (fixRI ar) (env r2)
492     ANDNOT r1 ar r2 -> ANDNOT (env r1) (fixRI ar) (env r2)
493     OR r1 ar r2 -> OR (env r1) (fixRI ar) (env r2)
494     ORNOT r1 ar r2 -> ORNOT (env r1) (fixRI ar) (env r2)
495     XOR r1 ar r2 -> XOR (env r1) (fixRI ar) (env r2)
496     XORNOT r1 ar r2 -> XORNOT (env r1) (fixRI ar) (env r2)
497     SLL r1 ar r2 -> SLL (env r1) (fixRI ar) (env r2)
498     SRL r1 ar r2 -> SRL (env r1) (fixRI ar) (env r2)
499     SRA r1 ar r2 -> SRA (env r1) (fixRI ar) (env r2)
500     ZAP r1 ar r2 -> ZAP (env r1) (fixRI ar) (env r2)
501     ZAPNOT r1 ar r2 -> ZAPNOT (env r1) (fixRI ar) (env r2)
502     CMP co r1 ar r2 -> CMP co (env r1) (fixRI ar) (env r2)
503     FCLR reg -> FCLR (env reg)
504     FABS r1 r2 -> FABS (env r1) (env r2)
505     FNEG s r1 r2 -> FNEG s (env r1) (env r2)
506     FADD s r1 r2 r3 -> FADD s (env r1) (env r2) (env r3)
507     FDIV s r1 r2 r3 -> FDIV s (env r1) (env r2) (env r3)
508     FMUL s r1 r2 r3 -> FMUL s (env r1) (env r2) (env r3)
509     FSUB s r1 r2 r3 -> FSUB s (env r1) (env r2) (env r3)
510     CVTxy s1 s2 r1 r2 -> CVTxy s1 s2 (env r1) (env r2)
511     FCMP s co r1 r2 r3 -> FCMP s co (env r1) (env r2) (env r3)
512     FMOV r1 r2 -> FMOV (env r1) (env r2)
513     BI cond reg lbl -> BI cond (env reg) lbl
514     BF cond reg lbl -> BF cond (env reg) lbl
515     JMP reg addr hint -> JMP (env reg) (fixAddr addr) hint
516     JSR reg addr i -> JSR (env reg) (fixAddr addr) i
517     _ -> instr
518   where
519     fixAddr (AddrReg r1)       = AddrReg (env r1)
520     fixAddr (AddrRegImm r1 i)  = AddrRegImm (env r1) i
521     fixAddr other              = other
522
523     fixRI (RIReg r) = RIReg (env r)
524     fixRI other = other
525
526 #endif /* alpha_TARGET_ARCH */
527 -- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
528 #if i386_TARGET_ARCH || x86_64_TARGET_ARCH
529
530 patchRegs instr env = case instr of
531     MOV  sz src dst     -> patch2 (MOV  sz) src dst
532     MOVZxL sz src dst   -> patch2 (MOVZxL sz) src dst
533     MOVSxL sz src dst   -> patch2 (MOVSxL sz) src dst
534     LEA  sz src dst     -> patch2 (LEA  sz) src dst
535     ADD  sz src dst     -> patch2 (ADD  sz) src dst
536     ADC  sz src dst     -> patch2 (ADC  sz) src dst
537     SUB  sz src dst     -> patch2 (SUB  sz) src dst
538     IMUL sz src dst     -> patch2 (IMUL sz) src dst
539     IMUL2 sz src        -> patch1 (IMUL2 sz) src
540     MUL sz src dst      -> patch2 (MUL sz) src dst
541     IDIV sz op          -> patch1 (IDIV sz) op
542     DIV sz op           -> patch1 (DIV sz) op
543     AND  sz src dst     -> patch2 (AND  sz) src dst
544     OR   sz src dst     -> patch2 (OR   sz) src dst
545     XOR  sz src dst     -> patch2 (XOR  sz) src dst
546     NOT  sz op          -> patch1 (NOT  sz) op
547     NEGI sz op          -> patch1 (NEGI sz) op
548     SHL  sz imm dst     -> patch1 (SHL sz imm) dst
549     SAR  sz imm dst     -> patch1 (SAR sz imm) dst
550     SHR  sz imm dst     -> patch1 (SHR sz imm) dst
551     BT   sz imm src     -> patch1 (BT  sz imm) src
552     TEST sz src dst     -> patch2 (TEST sz) src dst
553     CMP  sz src dst     -> patch2 (CMP  sz) src dst
554     PUSH sz op          -> patch1 (PUSH sz) op
555     POP  sz op          -> patch1 (POP  sz) op
556     SETCC cond op       -> patch1 (SETCC cond) op
557     JMP op              -> patch1 JMP op
558     JMP_TBL op ids      -> patch1 JMP_TBL op $ ids
559
560 #if i386_TARGET_ARCH
561     GMOV src dst        -> GMOV (env src) (env dst)
562     GLD sz src dst      -> GLD sz (lookupAddr src) (env dst)
563     GST sz src dst      -> GST sz (env src) (lookupAddr dst)
564
565     GLDZ dst            -> GLDZ (env dst)
566     GLD1 dst            -> GLD1 (env dst)
567
568     GFTOI src dst       -> GFTOI (env src) (env dst)
569     GDTOI src dst       -> GDTOI (env src) (env dst)
570
571     GITOF src dst       -> GITOF (env src) (env dst)
572     GITOD src dst       -> GITOD (env src) (env dst)
573
574     GADD sz s1 s2 dst   -> GADD sz (env s1) (env s2) (env dst)
575     GSUB sz s1 s2 dst   -> GSUB sz (env s1) (env s2) (env dst)
576     GMUL sz s1 s2 dst   -> GMUL sz (env s1) (env s2) (env dst)
577     GDIV sz s1 s2 dst   -> GDIV sz (env s1) (env s2) (env dst)
578
579     GCMP sz src1 src2   -> GCMP sz (env src1) (env src2)
580     GABS sz src dst     -> GABS sz (env src) (env dst)
581     GNEG sz src dst     -> GNEG sz (env src) (env dst)
582     GSQRT sz src dst    -> GSQRT sz (env src) (env dst)
583     GSIN sz src dst     -> GSIN sz (env src) (env dst)
584     GCOS sz src dst     -> GCOS sz (env src) (env dst)
585     GTAN sz src dst     -> GTAN sz (env src) (env dst)
586 #endif
587
588 #if x86_64_TARGET_ARCH
589     CVTSS2SD src dst    -> CVTSS2SD (env src) (env dst)
590     CVTSD2SS src dst    -> CVTSD2SS (env src) (env dst)
591     CVTTSS2SIQ src dst  -> CVTTSS2SIQ (patchOp src) (env dst)
592     CVTTSD2SIQ src dst  -> CVTTSD2SIQ (patchOp src) (env dst)
593     CVTSI2SS src dst    -> CVTSI2SS (patchOp src) (env dst)
594     CVTSI2SD src dst    -> CVTSI2SD (patchOp src) (env dst)
595     FDIV sz src dst     -> FDIV sz (patchOp src) (patchOp dst)
596 #endif    
597
598     CALL (Left imm)  _  -> instr
599     CALL (Right reg) p  -> CALL (Right (env reg)) p
600     
601     FETCHGOT reg        -> FETCHGOT (env reg)
602     FETCHPC  reg        -> FETCHPC  (env reg)
603    
604     NOP                 -> instr
605     COMMENT _           -> instr
606     DELTA _             -> instr
607     JXX _ _             -> instr
608     JXX_GBL _ _         -> instr
609     CLTD _              -> instr
610
611     _other              -> panic "patchRegs: unrecognised instr"
612
613   where
614     patch1 insn op      = insn $! patchOp op
615     patch2 insn src dst = (insn $! patchOp src) $! patchOp dst
616
617     patchOp (OpReg  reg) = OpReg $! env reg
618     patchOp (OpImm  imm) = OpImm imm
619     patchOp (OpAddr ea)  = OpAddr $! lookupAddr ea
620
621     lookupAddr (ImmAddr imm off) = ImmAddr imm off
622     lookupAddr (AddrBaseIndex base index disp)
623       = ((AddrBaseIndex $! lookupBase base) $! lookupIndex index) disp
624       where
625         lookupBase EABaseNone       = EABaseNone
626         lookupBase EABaseRip        = EABaseRip
627         lookupBase (EABaseReg r)    = EABaseReg (env r)
628                                  
629         lookupIndex EAIndexNone     = EAIndexNone
630         lookupIndex (EAIndex r i)   = EAIndex (env r) i
631
632 #endif /* i386_TARGET_ARCH || x86_64_TARGET_ARCH*/
633 -- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
634 #if sparc_TARGET_ARCH
635
636 patchRegs instr env = case instr of
637     LD    sz addr reg   -> LD sz (fixAddr addr) (env reg)
638     ST    sz reg addr   -> ST sz (env reg) (fixAddr addr)
639     ADD   x cc r1 ar r2 -> ADD x cc (env r1) (fixRI ar) (env r2)
640     SUB   x cc r1 ar r2 -> SUB x cc (env r1) (fixRI ar) (env r2)
641     UMUL    cc r1 ar r2 -> UMUL cc (env r1) (fixRI ar) (env r2)
642     SMUL    cc r1 ar r2 -> SMUL cc (env r1) (fixRI ar) (env r2)
643     RDY   rd            -> RDY (env rd)
644     AND   b r1 ar r2    -> AND b (env r1) (fixRI ar) (env r2)
645     ANDN  b r1 ar r2    -> ANDN b (env r1) (fixRI ar) (env r2)
646     OR    b r1 ar r2    -> OR b (env r1) (fixRI ar) (env r2)
647     ORN   b r1 ar r2    -> ORN b (env r1) (fixRI ar) (env r2)
648     XOR   b r1 ar r2    -> XOR b (env r1) (fixRI ar) (env r2)
649     XNOR  b r1 ar r2    -> XNOR b (env r1) (fixRI ar) (env r2)
650     SLL   r1 ar r2      -> SLL (env r1) (fixRI ar) (env r2)
651     SRL   r1 ar r2      -> SRL (env r1) (fixRI ar) (env r2)
652     SRA   r1 ar r2      -> SRA (env r1) (fixRI ar) (env r2)
653     SETHI imm reg       -> SETHI imm (env reg)
654     FABS  s r1 r2       -> FABS s (env r1) (env r2)
655     FADD  s r1 r2 r3    -> FADD s (env r1) (env r2) (env r3)
656     FCMP  e s r1 r2     -> FCMP e s (env r1) (env r2)
657     FDIV  s r1 r2 r3    -> FDIV s (env r1) (env r2) (env r3)
658     FMOV  s r1 r2       -> FMOV s (env r1) (env r2)
659     FMUL  s r1 r2 r3    -> FMUL s (env r1) (env r2) (env r3)
660     FNEG  s r1 r2       -> FNEG s (env r1) (env r2)
661     FSQRT s r1 r2       -> FSQRT s (env r1) (env r2)
662     FSUB  s r1 r2 r3    -> FSUB s (env r1) (env r2) (env r3)
663     FxTOy s1 s2 r1 r2   -> FxTOy s1 s2 (env r1) (env r2)
664     JMP   addr          -> JMP (fixAddr addr)
665     CALL  (Left i) n t  -> CALL (Left i) n t
666     CALL  (Right r) n t -> CALL (Right (env r)) n t
667     _ -> instr
668   where
669     fixAddr (AddrRegReg r1 r2) = AddrRegReg (env r1) (env r2)
670     fixAddr (AddrRegImm r1 i)  = AddrRegImm (env r1) i
671
672     fixRI (RIReg r) = RIReg (env r)
673     fixRI other = other
674
675 #endif /* sparc_TARGET_ARCH */
676 -- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
677 #if powerpc_TARGET_ARCH
678
679 patchRegs instr env = case instr of
680     LD    sz reg addr   -> LD sz (env reg) (fixAddr addr)
681     LA    sz reg addr   -> LA sz (env reg) (fixAddr addr)
682     ST    sz reg addr   -> ST sz (env reg) (fixAddr addr)
683     STU    sz reg addr  -> STU sz (env reg) (fixAddr addr)
684     LIS   reg imm       -> LIS (env reg) imm
685     LI    reg imm       -> LI (env reg) imm
686     MR    reg1 reg2     -> MR (env reg1) (env reg2)
687     CMP   sz reg ri     -> CMP sz (env reg) (fixRI ri)
688     CMPL  sz reg ri     -> CMPL sz (env reg) (fixRI ri)
689     BCC   cond lbl      -> BCC cond lbl
690     BCCFAR cond lbl     -> BCCFAR cond lbl
691     MTCTR reg           -> MTCTR (env reg)
692     BCTR  targets       -> BCTR targets
693     BL    imm argRegs   -> BL imm argRegs       -- argument regs
694     BCTRL argRegs       -> BCTRL argRegs        -- cannot be remapped
695     ADD   reg1 reg2 ri  -> ADD (env reg1) (env reg2) (fixRI ri)
696     ADDC  reg1 reg2 reg3-> ADDC (env reg1) (env reg2) (env reg3)
697     ADDE  reg1 reg2 reg3-> ADDE (env reg1) (env reg2) (env reg3)
698     ADDIS reg1 reg2 imm -> ADDIS (env reg1) (env reg2) imm
699     SUBF  reg1 reg2 reg3-> SUBF (env reg1) (env reg2) (env reg3)
700     MULLW reg1 reg2 ri  -> MULLW (env reg1) (env reg2) (fixRI ri)
701     DIVW  reg1 reg2 reg3-> DIVW (env reg1) (env reg2) (env reg3)
702     DIVWU reg1 reg2 reg3-> DIVWU (env reg1) (env reg2) (env reg3)
703     MULLW_MayOflo reg1 reg2 reg3
704                         -> MULLW_MayOflo (env reg1) (env reg2) (env reg3)
705     AND   reg1 reg2 ri  -> AND (env reg1) (env reg2) (fixRI ri)
706     OR    reg1 reg2 ri  -> OR  (env reg1) (env reg2) (fixRI ri)
707     XOR   reg1 reg2 ri  -> XOR (env reg1) (env reg2) (fixRI ri)
708     XORIS reg1 reg2 imm -> XORIS (env reg1) (env reg2) imm
709     EXTS  sz reg1 reg2 -> EXTS sz (env reg1) (env reg2)
710     NEG   reg1 reg2     -> NEG (env reg1) (env reg2)
711     NOT   reg1 reg2     -> NOT (env reg1) (env reg2)
712     SLW   reg1 reg2 ri  -> SLW (env reg1) (env reg2) (fixRI ri)
713     SRW   reg1 reg2 ri  -> SRW (env reg1) (env reg2) (fixRI ri)
714     SRAW  reg1 reg2 ri  -> SRAW (env reg1) (env reg2) (fixRI ri)
715     RLWINM reg1 reg2 sh mb me
716                         -> RLWINM (env reg1) (env reg2) sh mb me
717     FADD  sz r1 r2 r3   -> FADD sz (env r1) (env r2) (env r3)
718     FSUB  sz r1 r2 r3   -> FSUB sz (env r1) (env r2) (env r3)
719     FMUL  sz r1 r2 r3   -> FMUL sz (env r1) (env r2) (env r3)
720     FDIV  sz r1 r2 r3   -> FDIV sz (env r1) (env r2) (env r3)
721     FNEG  r1 r2         -> FNEG (env r1) (env r2)
722     FCMP  r1 r2         -> FCMP (env r1) (env r2)
723     FCTIWZ r1 r2        -> FCTIWZ (env r1) (env r2)
724     FRSP r1 r2          -> FRSP (env r1) (env r2)
725     MFCR reg            -> MFCR (env reg)
726     MFLR reg            -> MFLR (env reg)
727     FETCHPC reg         -> FETCHPC (env reg)
728     _ -> instr
729   where
730     fixAddr (AddrRegReg r1 r2) = AddrRegReg (env r1) (env r2)
731     fixAddr (AddrRegImm r1 i)  = AddrRegImm (env r1) i
732
733     fixRI (RIReg r) = RIReg (env r)
734     fixRI other = other
735 #endif /* powerpc_TARGET_ARCH */
736
737 -- -----------------------------------------------------------------------------
738 -- Detecting reg->reg moves
739
740 -- The register allocator attempts to eliminate reg->reg moves whenever it can,
741 -- by assigning the src and dest temporaries to the same real register.
742
743 isRegRegMove :: Instr -> Maybe (Reg,Reg)
744 #if i386_TARGET_ARCH || x86_64_TARGET_ARCH
745 -- TMP:
746 isRegRegMove (MOV _ (OpReg r1) (OpReg r2)) = Just (r1,r2)
747 #elif powerpc_TARGET_ARCH
748 isRegRegMove (MR dst src) = Just (src,dst)
749 #else
750 #warning ToDo: isRegRegMove
751 #endif
752 isRegRegMove _ = Nothing
753
754 -- -----------------------------------------------------------------------------
755 -- Generating spill instructions
756
757 mkSpillInstr
758    :: Reg               -- register to spill (should be a real)
759    -> Int               -- current stack delta
760    -> Int               -- spill slot to use
761    -> Instr
762 mkSpillInstr reg delta slot
763  -- = ASSERT(isRealReg reg)                     -- BUGS: used for graph coloring: is this ok?
764   = let 
765         off     = spillSlotToOffset slot
766     in
767 #ifdef alpha_TARGET_ARCH
768     {-Alpha: spill below the stack pointer (?)-}
769     ST sz dyn (spRel (- (off `div` 8)))
770 #endif
771 #ifdef i386_TARGET_ARCH
772     let off_w = (off-delta) `div` 4
773     in case regClass reg of
774            RcInteger -> MOV I32 (OpReg reg) (OpAddr (spRel off_w))
775            _         -> GST F80 reg (spRel off_w) {- RcFloat/RcDouble -}
776 #endif
777 #ifdef x86_64_TARGET_ARCH
778     let off_w = (off-delta) `div` 8
779     in case regClass reg of
780            RcInteger -> MOV I64 (OpReg reg) (OpAddr (spRel off_w))
781            RcDouble  -> MOV F64 (OpReg reg) (OpAddr (spRel off_w))
782                 -- ToDo: will it work to always spill as a double?
783                 -- does that cause a stall if the data was a float?
784 #endif
785 #ifdef sparc_TARGET_ARCH
786         {-SPARC: spill below frame pointer leaving 2 words/spill-}
787                         let{off_w = 1 + (off `div` 4);
788                             sz = case regClass reg of {
789                                     RcInteger -> I32;
790                                     RcFloat   -> F32;
791                                     RcDouble  -> F64}}
792                         in ST sz reg (fpRel (- off_w))
793 #endif
794 #ifdef powerpc_TARGET_ARCH
795     let sz = case regClass reg of
796                 RcInteger -> I32
797                 RcDouble -> F64
798     in ST sz reg (AddrRegImm sp (ImmInt (off-delta)))
799 #endif
800
801
802 mkLoadInstr
803    :: Reg               -- register to load (should be a real)
804    -> Int               -- current stack delta
805    -> Int               -- spill slot to use
806    -> Instr
807 mkLoadInstr reg delta slot
808  -- = ASSERT(isRealReg reg)                     -- BUGS: used for graph coloring: is this ok?
809   = let
810         off     = spillSlotToOffset slot
811     in
812 #if alpha_TARGET_ARCH
813          LD  sz dyn (spRel (- (off `div` 8)))
814 #endif
815 #if i386_TARGET_ARCH
816         let off_w = (off-delta) `div` 4
817         in case regClass reg of {
818               RcInteger -> MOV I32 (OpAddr (spRel off_w)) (OpReg reg);
819               _         -> GLD F80 (spRel off_w) reg} {- RcFloat/RcDouble -}
820 #endif
821 #if x86_64_TARGET_ARCH
822         let off_w = (off-delta) `div` 8
823         in case regClass reg of
824               RcInteger -> MOV I64 (OpAddr (spRel off_w)) (OpReg reg)
825               _         -> MOV F64 (OpAddr (spRel off_w)) (OpReg reg)
826 #endif
827 #if sparc_TARGET_ARCH
828         let{off_w = 1 + (off `div` 4);
829             sz = case regClass reg of {
830                    RcInteger -> I32;
831                    RcFloat   -> F32;
832                    RcDouble  -> F64}}
833         in LD sz (fpRel (- off_w)) reg
834 #endif
835 #if powerpc_TARGET_ARCH
836     let sz = case regClass reg of
837                 RcInteger -> I32
838                 RcDouble -> F64
839     in LD sz reg (AddrRegImm sp (ImmInt (off-delta)))
840 #endif
841
842 mkRegRegMoveInstr
843     :: Reg
844     -> Reg
845     -> Instr
846 mkRegRegMoveInstr src dst
847 #if i386_TARGET_ARCH || x86_64_TARGET_ARCH
848     = case regClass src of
849         RcInteger -> MOV wordRep (OpReg src) (OpReg dst)
850 #if i386_TARGET_ARCH
851         RcDouble  -> GMOV src dst
852 #else
853         RcDouble  -> MOV F64 (OpReg src) (OpReg dst)
854 #endif
855 #elif powerpc_TARGET_ARCH
856     = MR dst src
857 #endif
858
859 mkBranchInstr
860     :: BlockId
861     -> [Instr]
862 #if alpha_TARGET_ARCH
863 mkBranchInstr id = [BR id]
864 #endif
865
866 #if i386_TARGET_ARCH || x86_64_TARGET_ARCH
867 mkBranchInstr id = [JXX ALWAYS id]
868 #endif
869
870 #if sparc_TARGET_ARCH
871 mkBranchInstr (BlockId id) = [BI ALWAYS False (ImmCLbl (mkAsmTempLabel id)), NOP]
872 #endif
873
874 #if powerpc_TARGET_ARCH
875 mkBranchInstr id = [BCC ALWAYS id]
876 #endif
877
878
879 spillSlotSize :: Int
880 spillSlotSize = IF_ARCH_i386(12, 8)
881
882 maxSpillSlots :: Int
883 maxSpillSlots = ((rESERVED_C_STACK_BYTES - 64) `div` spillSlotSize) - 1
884
885 -- convert a spill slot number to a *byte* offset, with no sign:
886 -- decide on a per arch basis whether you are spilling above or below
887 -- the C stack pointer.
888 spillSlotToOffset :: Int -> Int
889 spillSlotToOffset slot
890    | slot >= 0 && slot < maxSpillSlots
891    = 64 + spillSlotSize * slot
892    | otherwise
893    = pprPanic "spillSlotToOffset:" 
894               (   text "invalid spill location: " <> int slot
895               $$  text "maxSpillSlots:          " <> int maxSpillSlots)