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