2 % (c) The AQUA Project, Glasgow University, 1996
4 \section[RegAllocInfo]{Machine-specific info used for register allocation}
6 The (machine-independent) allocator itself is in @AsmRegAlloc@.
9 #include "HsVersions.h"
10 #include "nativeGen/NCG.h"
27 SYN_IE(RegAssignment),
54 #if __GLASGOW_HASKELL__ >= 202
55 import qualified GlaExts (Addr(..))
56 import GlaExts hiding (Addr(..))
62 IMPORT_1_3(List(partition))
66 import MachCode ( SYN_IE(InstrList) )
68 import AbsCSyn ( MagicId )
69 import BitSet ( unitBS, mkBS, minusBS, unionBS, listBS, BitSet )
70 import CLabel ( pprCLabel_asm, CLabel{-instance Ord-} )
71 import FiniteMap ( addToFM, lookupFM, FiniteMap )
72 import OrdList ( mkUnitList, OrdList )
73 import PrimRep ( PrimRep(..) )
74 import Stix ( StixTree, CodeSegment )
75 import UniqSet -- quite a bit of it
78 %************************************************************************
80 \subsection{Register allocation information}
82 %************************************************************************
85 type RegSet = UniqSet Reg
87 mkRegSet :: [Reg] -> RegSet
89 unionRegSets, minusRegSet :: RegSet -> RegSet -> RegSet
90 elementOfRegSet :: Reg -> RegSet -> Bool
91 isEmptyRegSet :: RegSet -> Bool
92 regSetToList :: RegSet -> [Reg]
95 emptyRegSet = emptyUniqSet
96 unionRegSets = unionUniqSets
97 minusRegSet = minusUniqSet
98 elementOfRegSet = elementOfUniqSet
99 isEmptyRegSet = isEmptyUniqSet
100 regSetToList = uniqSetToList
102 freeRegSet, callClobberedRegSet :: RegSet
103 argRegSet :: Int -> RegSet
105 freeRegSet = mkRegSet freeRegs
106 callClobberedRegSet = mkRegSet callClobberedRegs
107 argRegSet n = mkRegSet (argRegs n)
109 type RegAssignment = FiniteMap Reg Reg
110 type RegConflicts = FiniteMap Int RegSet
112 data FutureLive = FL RegSet (FiniteMap CLabel RegSet)
122 = RF RegSet -- in use
127 = RI RegSet -- in use
129 RegSet -- destinations
134 %************************************************************************
136 \subsection{Register allocation information}
138 %************************************************************************
140 COMMENT ON THE EXTRA BitSet FOR SPARC MRegsState: Getting the conflicts
141 right is a bit tedious for doubles. We'd have to add a conflict
142 function to the MachineRegisters class, and we'd have to put a PrimRep
143 in the MappedReg datatype, or use some kludge (e.g. register 64 + n is
144 really the same as 32 + n, except that it's used for a double, so it
145 also conflicts with 33 + n) to deal with it. It's just not worth the
146 bother, so we just partition the free floating point registers into
147 two sets: one for single precision and one for double precision. We
148 never seem to run out of floating point registers anyway.
152 = MRs BitSet -- integer registers
153 BitSet -- floating-point registers
154 IF_ARCH_sparc(BitSet,) -- double registers handled separately
158 #if alpha_TARGET_ARCH
159 # define INT_FLPT_CUTOFF 32
162 # define INT_FLPT_CUTOFF 8
164 #if sparc_TARGET_ARCH
165 # define INT_FLPT_CUTOFF 32
166 # define SNGL_DBL_CUTOFF 48
169 mkMRegsState :: [RegNo] -> MRegsState
170 possibleMRegs :: PrimRep -> MRegsState -> [RegNo]
171 useMReg :: MRegsState -> FAST_REG_NO -> MRegsState
172 useMRegs :: MRegsState -> [RegNo] -> MRegsState
173 freeMReg :: MRegsState -> FAST_REG_NO -> MRegsState
174 freeMRegs :: MRegsState -> [RegNo] -> MRegsState
177 = MRs (mkBS is) (mkBS fs2) IF_ARCH_sparc((mkBS ds2),)
179 (is, fs) = partition (< INT_FLPT_CUTOFF) xs
180 #if sparc_TARGET_ARCH
181 (ss, ds) = partition (< SNGL_DBL_CUTOFF) fs
182 fs2 = map (subtract INT_FLPT_CUTOFF) ss
183 ds2 = map (subtract INT_FLPT_CUTOFF) (filter even ds)
185 fs2 = map (subtract INT_FLPT_CUTOFF) fs
188 ------------------------------------------------
189 #if sparc_TARGET_ARCH
190 possibleMRegs FloatRep (MRs _ ss _) = [ x + INT_FLPT_CUTOFF | x <- listBS ss]
191 possibleMRegs DoubleRep (MRs _ _ ds) = [ x + INT_FLPT_CUTOFF | x <- listBS ds]
192 possibleMRegs _ (MRs is _ _) = listBS is
194 possibleMRegs FloatRep (MRs _ fs) = [ x + INT_FLPT_CUTOFF | x <- listBS fs]
195 possibleMRegs DoubleRep (MRs _ fs) = [ x + INT_FLPT_CUTOFF | x <- listBS fs]
196 possibleMRegs _ (MRs is _) = listBS is
199 ------------------------------------------------
200 #if sparc_TARGET_ARCH
201 useMReg (MRs is ss ds) n
202 = if (n _LT_ ILIT(INT_FLPT_CUTOFF)) then
203 MRs (is `minusBS` unitBS IBOX(n)) ss ds
204 else if (n _LT_ ILIT(SNGL_DBL_CUTOFF)) then
205 MRs is (ss `minusBS` unitBS (IBOX(n _SUB_ ILIT(INT_FLPT_CUTOFF)))) ds
207 MRs is ss (ds `minusBS` unitBS (IBOX(n _SUB_ ILIT(INT_FLPT_CUTOFF))))
209 useMReg (MRs is fs) n
210 = if (n _LT_ ILIT(INT_FLPT_CUTOFF))
211 then MRs (is `minusBS` unitBS IBOX(n)) fs
212 else MRs is (fs `minusBS` unitBS (IBOX(n _SUB_ ILIT(INT_FLPT_CUTOFF))))
215 ------------------------------------------------
216 #if sparc_TARGET_ARCH
217 useMRegs (MRs is ss ds) xs
218 = MRs (is `minusBS` is2) (ss `minusBS` ss2) (ds `minusBS` ds2)
220 MRs is2 ss2 ds2 = mkMRegsState xs
222 useMRegs (MRs is fs) xs
223 = MRs (is `minusBS` is2) (fs `minusBS` fs2)
225 MRs is2 fs2 = mkMRegsState xs
228 ------------------------------------------------
229 #if sparc_TARGET_ARCH
230 freeMReg (MRs is ss ds) n
231 = if (n _LT_ ILIT(INT_FLPT_CUTOFF)) then
232 MRs (is `unionBS` unitBS IBOX(n)) ss ds
233 else if (n _LT_ ILIT(SNGL_DBL_CUTOFF)) then
234 MRs is (ss `unionBS` unitBS (IBOX(n _SUB_ ILIT(INT_FLPT_CUTOFF)))) ds
236 MRs is ss (ds `unionBS` unitBS (IBOX(n _SUB_ ILIT(INT_FLPT_CUTOFF))))
238 freeMReg (MRs is fs) n
239 = if (n _LT_ ILIT(INT_FLPT_CUTOFF))
240 then MRs (is `unionBS` unitBS IBOX(n)) fs
241 else MRs is (fs `unionBS` unitBS (IBOX(n _SUB_ ILIT(INT_FLPT_CUTOFF))))
244 ------------------------------------------------
245 #if sparc_TARGET_ARCH
246 freeMRegs (MRs is ss ds) xs
247 = MRs (is `unionBS` is2) (ss `unionBS` ss2) (ds `unionBS` ds2)
249 MRs is2 ss2 ds2 = mkMRegsState xs
251 freeMRegs (MRs is fs) xs
252 = MRs (is `unionBS` is2) (fs `unionBS` fs2)
254 MRs is2 fs2 = mkMRegsState xs
258 %************************************************************************
260 \subsection{@RegUsage@ type; @noUsage@, @endUsage@, @regUsage@ functions}
262 %************************************************************************
264 @regUsage@ returns the sets of src and destination registers used by a
265 particular instruction. Machine registers that are pre-allocated to
266 stgRegs are filtered out, because they are uninteresting from a
267 register allocation standpoint. (We wouldn't want them to end up on
270 An important point: The @regUsage@ function for a particular
271 assembly language must not refer to fixed registers, such as Hp, SpA,
272 etc. The source and destination MRegsStates should only refer to
273 dynamically allocated registers or static registers from the free
274 list. As far as we are concerned, the fixed registers simply don't
275 exist (for allocation purposes, anyway).
278 data RegUsage = RU RegSet RegSet
280 noUsage, endUsage :: RegUsage
281 noUsage = RU emptyRegSet emptyRegSet
282 endUsage = RU emptyRegSet freeRegSet
284 regUsage :: Instr -> RegUsage
286 #if alpha_TARGET_ARCH
288 regUsage instr = case instr of
289 LD B reg addr -> usage (regAddr addr, [reg, t9])
290 LD BU reg addr -> usage (regAddr addr, [reg, t9])
291 -- LD W reg addr -> usage (regAddr addr, [reg, t9]) : UNUSED
292 -- LD WU reg addr -> usage (regAddr addr, [reg, t9]) : UNUSED
293 LD sz reg addr -> usage (regAddr addr, [reg])
294 LDA reg addr -> usage (regAddr addr, [reg])
295 LDAH reg addr -> usage (regAddr addr, [reg])
296 LDGP reg addr -> usage (regAddr addr, [reg])
297 LDI sz reg imm -> usage ([], [reg])
298 ST B reg addr -> usage (reg : regAddr addr, [t9, t10])
299 -- ST W reg addr -> usage (reg : regAddr addr, [t9, t10]) : UNUSED
300 ST sz reg addr -> usage (reg : regAddr addr, [])
301 CLR reg -> usage ([], [reg])
302 ABS sz ri reg -> usage (regRI ri, [reg])
303 NEG sz ov ri reg -> usage (regRI ri, [reg])
304 ADD sz ov r1 ar r2 -> usage (r1 : regRI ar, [r2])
305 SADD sz sc r1 ar r2 -> usage (r1 : regRI ar, [r2])
306 SUB sz ov r1 ar r2 -> usage (r1 : regRI ar, [r2])
307 SSUB sz sc r1 ar r2 -> usage (r1 : regRI ar, [r2])
308 MUL sz ov r1 ar r2 -> usage (r1 : regRI ar, [r2])
309 DIV sz un r1 ar r2 -> usage (r1 : regRI ar, [r2, t9, t10, t11, t12])
310 REM sz un r1 ar r2 -> usage (r1 : regRI ar, [r2, t9, t10, t11, t12])
311 NOT ri reg -> usage (regRI ri, [reg])
312 AND r1 ar r2 -> usage (r1 : regRI ar, [r2])
313 ANDNOT r1 ar r2 -> usage (r1 : regRI ar, [r2])
314 OR r1 ar r2 -> usage (r1 : regRI ar, [r2])
315 ORNOT r1 ar r2 -> usage (r1 : regRI ar, [r2])
316 XOR r1 ar r2 -> usage (r1 : regRI ar, [r2])
317 XORNOT r1 ar r2 -> usage (r1 : regRI ar, [r2])
318 SLL r1 ar r2 -> usage (r1 : regRI ar, [r2])
319 SRL r1 ar r2 -> usage (r1 : regRI ar, [r2])
320 SRA r1 ar r2 -> usage (r1 : regRI ar, [r2])
321 ZAP r1 ar r2 -> usage (r1 : regRI ar, [r2])
322 ZAPNOT r1 ar r2 -> usage (r1 : regRI ar, [r2])
323 CMP co r1 ar r2 -> usage (r1 : regRI ar, [r2])
324 FCLR reg -> usage ([], [reg])
325 FABS r1 r2 -> usage ([r1], [r2])
326 FNEG sz r1 r2 -> usage ([r1], [r2])
327 FADD sz r1 r2 r3 -> usage ([r1, r2], [r3])
328 FDIV sz r1 r2 r3 -> usage ([r1, r2], [r3])
329 FMUL sz r1 r2 r3 -> usage ([r1, r2], [r3])
330 FSUB sz r1 r2 r3 -> usage ([r1, r2], [r3])
331 CVTxy sz1 sz2 r1 r2 -> usage ([r1], [r2])
332 FCMP sz co r1 r2 r3 -> usage ([r1, r2], [r3])
333 FMOV r1 r2 -> usage ([r1], [r2])
336 -- We assume that all local jumps will be BI/BF/BR. JMP must be out-of-line.
337 BI cond reg lbl -> usage ([reg], [])
338 BF cond reg lbl -> usage ([reg], [])
339 JMP reg addr hint -> RU (mkRegSet (filter interesting (regAddr addr))) freeRegSet
341 BSR _ n -> RU (argRegSet n) callClobberedRegSet
342 JSR reg addr n -> RU (argRegSet n) callClobberedRegSet
347 usage (src, dst) = RU (mkRegSet (filter interesting src))
348 (mkRegSet (filter interesting dst))
350 interesting (FixedReg _) = False
353 regAddr (AddrReg r1) = [r1]
354 regAddr (AddrRegImm r1 _) = [r1]
355 regAddr (AddrImm _) = []
357 regRI (RIReg r) = [r]
360 #endif {- alpha_TARGET_ARCH -}
361 -- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
364 regUsage instr = case instr of
365 MOV sz src dst -> usage2 src dst
366 MOVZX sz src dst -> usage2 src dst
367 MOVSX sz src dst -> usage2 src dst
368 LEA sz src dst -> usage2 src dst
369 ADD sz src dst -> usage2 src dst
370 SUB sz src dst -> usage2 src dst
371 IMUL sz src dst -> usage2 src dst
372 IDIV sz src -> usage (eax:edx:opToReg src) [eax,edx]
373 AND sz src dst -> usage2 src dst
374 OR sz src dst -> usage2 src dst
375 XOR sz src dst -> usage2 src dst
376 NOT sz op -> usage1 op
377 NEGI sz op -> usage1 op
378 SHL sz imm dst -> usage1 dst -- imm has to be an Imm
379 SAR sz imm dst -> usage1 dst -- imm has to be an Imm
380 SHR sz imm dst -> usage1 dst -- imm has to be an Imm
381 PUSH sz op -> usage (opToReg op) []
382 POP sz op -> usage [] (opToReg op)
383 TEST sz src dst -> usage (opToReg src ++ opToReg dst) []
384 CMP sz src dst -> usage (opToReg src ++ opToReg dst) []
385 SETCC cond op -> usage [] (opToReg op)
386 JXX cond label -> usage [] []
387 JMP op -> usage (opToReg op) freeRegs
388 CALL imm -> usage [] callClobberedRegs
389 CLTD -> usage [eax] [edx]
391 SAHF -> usage [eax] []
392 FABS -> usage [st0] [st0]
393 FADD sz src -> usage (st0:opToReg src) [st0] -- allFPRegs
394 FADDP -> usage [st0,st1] [st0] -- allFPRegs
395 FIADD sz asrc -> usage (addrToRegs asrc) [st0]
396 FCHS -> usage [st0] [st0]
397 FCOM sz src -> usage (st0:opToReg src) []
398 FCOS -> usage [st0] [st0]
399 FDIV sz src -> usage (st0:opToReg src) [st0]
400 FDIVP -> usage [st0,st1] [st0]
401 FDIVRP -> usage [st0,st1] [st0]
402 FIDIV sz asrc -> usage (addrToRegs asrc) [st0]
403 FDIVR sz src -> usage (st0:opToReg src) [st0]
404 FIDIVR sz asrc -> usage (addrToRegs asrc) [st0]
405 FICOM sz asrc -> usage (addrToRegs asrc) []
406 FILD sz asrc dst -> usage (addrToRegs asrc) [dst] -- allFPRegs
407 FIST sz adst -> usage (st0:addrToRegs adst) []
408 FLD sz src -> usage (opToReg src) [st0] -- allFPRegs
409 FLD1 -> usage [] [st0] -- allFPRegs
410 FLDZ -> usage [] [st0] -- allFPRegs
411 FMUL sz src -> usage (st0:opToReg src) [st0]
412 FMULP -> usage [st0,st1] [st0]
413 FIMUL sz asrc -> usage (addrToRegs asrc) [st0]
414 FRNDINT -> usage [st0] [st0]
415 FSIN -> usage [st0] [st0]
416 FSQRT -> usage [st0] [st0]
417 FST sz (OpReg r) -> usage [st0] [r]
418 FST sz dst -> usage (st0:opToReg dst) []
419 FSTP sz (OpReg r) -> usage [st0] [r] -- allFPRegs
420 FSTP sz dst -> usage (st0:opToReg dst) [] -- allFPRegs
421 FSUB sz src -> usage (st0:opToReg src) [st0] -- allFPRegs
422 FSUBR sz src -> usage (st0:opToReg src) [st0] -- allFPRegs
423 FISUB sz asrc -> usage (addrToRegs asrc) [st0]
424 FSUBP -> usage [st0,st1] [st0] -- allFPRegs
425 FSUBRP -> usage [st0,st1] [st0] -- allFPRegs
426 FISUBR sz asrc -> usage (addrToRegs asrc) [st0]
427 FTST -> usage [st0] []
428 FCOMP sz op -> usage (st0:opToReg op) [st0] -- allFPRegs
429 FUCOMPP -> usage [st0, st1] [] -- allFPRegs
430 FXCH -> usage [st0, st1] [st0, st1]
431 FNSTSW -> usage [] [eax]
434 usage2 :: Operand -> Operand -> RegUsage
435 usage2 op (OpReg reg) = usage (opToReg op) [reg]
436 usage2 op (OpAddr ea) = usage (opToReg op ++ addrToRegs ea) []
437 usage2 op (OpImm imm) = usage (opToReg op) []
438 usage1 :: Operand -> RegUsage
439 usage1 (OpReg reg) = usage [reg] [reg]
440 usage1 (OpAddr ea) = usage (addrToRegs ea) []
441 allFPRegs = [st0,st1,st2,st3,st4,st5,st6,st7]
443 --callClobberedRegs = [ eax, ecx, edx ] -- according to gcc, anyway.
444 callClobberedRegs = [eax]
446 -- General purpose register collecting functions.
448 opToReg (OpReg reg) = [reg]
449 opToReg (OpImm imm) = []
450 opToReg (OpAddr ea) = addrToRegs ea
452 addrToRegs (Addr base index _) = baseToReg base ++ indexToReg index
453 where baseToReg Nothing = []
454 baseToReg (Just r) = [r]
455 indexToReg Nothing = []
456 indexToReg (Just (r,_)) = [r]
457 addrToRegs (ImmAddr _ _) = []
459 usage src dst = RU (mkRegSet (filter interesting src))
460 (mkRegSet (filter interesting dst))
462 interesting (FixedReg _) = False
465 #endif {- i386_TARGET_ARCH -}
466 -- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
467 #if sparc_TARGET_ARCH
469 regUsage instr = case instr of
470 LD sz addr reg -> usage (regAddr addr, [reg])
471 ST sz reg addr -> usage (reg : regAddr addr, [])
472 ADD x cc r1 ar r2 -> usage (r1 : regRI ar, [r2])
473 SUB x cc r1 ar r2 -> usage (r1 : regRI ar, [r2])
474 AND b r1 ar r2 -> usage (r1 : regRI ar, [r2])
475 ANDN b r1 ar r2 -> usage (r1 : regRI ar, [r2])
476 OR b r1 ar r2 -> usage (r1 : regRI ar, [r2])
477 ORN b r1 ar r2 -> usage (r1 : regRI ar, [r2])
478 XOR b r1 ar r2 -> usage (r1 : regRI ar, [r2])
479 XNOR b r1 ar r2 -> usage (r1 : regRI ar, [r2])
480 SLL r1 ar r2 -> usage (r1 : regRI ar, [r2])
481 SRL r1 ar r2 -> usage (r1 : regRI ar, [r2])
482 SRA r1 ar r2 -> usage (r1 : regRI ar, [r2])
483 SETHI imm reg -> usage ([], [reg])
484 FABS s r1 r2 -> usage ([r1], [r2])
485 FADD s r1 r2 r3 -> usage ([r1, r2], [r3])
486 FCMP e s r1 r2 -> usage ([r1, r2], [])
487 FDIV s r1 r2 r3 -> usage ([r1, r2], [r3])
488 FMOV s r1 r2 -> usage ([r1], [r2])
489 FMUL s r1 r2 r3 -> usage ([r1, r2], [r3])
490 FNEG s r1 r2 -> usage ([r1], [r2])
491 FSQRT s r1 r2 -> usage ([r1], [r2])
492 FSUB s r1 r2 r3 -> usage ([r1, r2], [r3])
493 FxTOy s1 s2 r1 r2 -> usage ([r1], [r2])
495 -- We assume that all local jumps will be BI/BF. JMP must be out-of-line.
496 JMP addr -> RU (mkRegSet (filter interesting (regAddr addr))) freeRegSet
498 CALL _ n True -> endUsage
499 CALL _ n False -> RU (argRegSet n) callClobberedRegSet
503 usage (src, dst) = RU (mkRegSet (filter interesting src))
504 (mkRegSet (filter interesting dst))
506 interesting (FixedReg _) = False
509 regAddr (AddrRegReg r1 r2) = [r1, r2]
510 regAddr (AddrRegImm r1 _) = [r1]
512 regRI (RIReg r) = [r]
515 #endif {- sparc_TARGET_ARCH -}
518 %************************************************************************
520 \subsection{@RegLiveness@ type; @regLiveness@ function}
522 %************************************************************************
524 @regLiveness@ takes future liveness information and modifies it
525 according to the semantics of branches and labels. (An out-of-line
526 branch clobbers the liveness passed back by the following instruction;
527 a forward local branch passes back the liveness from the target label;
528 a conditional branch merges the liveness from the target and the
529 liveness from its successor; a label stashes away the current liveness
530 in the future liveness environment).
533 data RegLiveness = RL RegSet FutureLive
535 regLiveness :: Instr -> RegLiveness -> RegLiveness
537 regLiveness instr info@(RL live future@(FL all env))
540 = case (lookupFM env lbl) of
542 Nothing -> trace ("Missing " ++ (show (pprCLabel_asm lbl)) ++
543 " in future?") emptyRegSet
545 case instr of -- the rest is machine-specific...
547 #if alpha_TARGET_ARCH
549 -- We assume that all local jumps will be BI/BF. JMP must be out-of-line.
551 BR (ImmCLbl lbl) -> RL (lookup lbl) future
552 BI _ _ (ImmCLbl lbl) -> RL (lookup lbl `unionRegSets` live) future
553 BF _ _ (ImmCLbl lbl) -> RL (lookup lbl `unionRegSets` live) future
554 JMP _ _ _ -> RL emptyRegSet future
555 BSR _ _ -> RL live future
556 JSR _ _ _ -> RL live future
557 LABEL lbl -> RL live (FL (all `unionRegSets` live) (addToFM env lbl live))
560 #endif {- alpha_TARGET_ARCH -}
561 -- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
564 JXX _ lbl -> RL (lookup lbl `unionRegSets` live) future
565 JMP _ -> RL emptyRegSet future
566 CALL _ -> RL live future
567 LABEL lbl -> RL live (FL (all `unionRegSets` live) (addToFM env lbl live))
570 #endif {- i386_TARGET_ARCH -}
571 -- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
572 #if sparc_TARGET_ARCH
574 -- We assume that all local jumps will be BI/BF. JMP must be out-of-line.
576 BI ALWAYS _ (ImmCLbl lbl) -> RL (lookup lbl) future
577 BI _ _ (ImmCLbl lbl) -> RL (lookup lbl `unionRegSets` live) future
578 BF ALWAYS _ (ImmCLbl lbl) -> RL (lookup lbl) future
579 BF _ _ (ImmCLbl lbl) -> RL (lookup lbl `unionRegSets` live) future
580 JMP _ -> RL emptyRegSet future
581 CALL _ i True -> RL emptyRegSet future
582 CALL _ i False -> RL live future
583 LABEL lbl -> RL live (FL (all `unionRegSets` live) (addToFM env lbl live))
586 #endif {- sparc_TARGET_ARCH -}
589 %************************************************************************
591 \subsection{@patchRegs@ function}
593 %************************************************************************
595 @patchRegs@ takes an instruction (possibly with
596 MemoryReg/UnmappedReg registers) and changes all register references
597 according to the supplied environment.
600 patchRegs :: Instr -> (Reg -> Reg) -> Instr
602 #if alpha_TARGET_ARCH
604 patchRegs instr env = case instr of
605 LD sz reg addr -> LD sz (env reg) (fixAddr addr)
606 LDA reg addr -> LDA (env reg) (fixAddr addr)
607 LDAH reg addr -> LDAH (env reg) (fixAddr addr)
608 LDGP reg addr -> LDGP (env reg) (fixAddr addr)
609 LDI sz reg imm -> LDI sz (env reg) imm
610 ST sz reg addr -> ST sz (env reg) (fixAddr addr)
611 CLR reg -> CLR (env reg)
612 ABS sz ar reg -> ABS sz (fixRI ar) (env reg)
613 NEG sz ov ar reg -> NEG sz ov (fixRI ar) (env reg)
614 ADD sz ov r1 ar r2 -> ADD sz ov (env r1) (fixRI ar) (env r2)
615 SADD sz sc r1 ar r2 -> SADD sz sc (env r1) (fixRI ar) (env r2)
616 SUB sz ov r1 ar r2 -> SUB sz ov (env r1) (fixRI ar) (env r2)
617 SSUB sz sc r1 ar r2 -> SSUB sz sc (env r1) (fixRI ar) (env r2)
618 MUL sz ov r1 ar r2 -> MUL sz ov (env r1) (fixRI ar) (env r2)
619 DIV sz un r1 ar r2 -> DIV sz un (env r1) (fixRI ar) (env r2)
620 REM sz un r1 ar r2 -> REM sz un (env r1) (fixRI ar) (env r2)
621 NOT ar reg -> NOT (fixRI ar) (env reg)
622 AND r1 ar r2 -> AND (env r1) (fixRI ar) (env r2)
623 ANDNOT r1 ar r2 -> ANDNOT (env r1) (fixRI ar) (env r2)
624 OR r1 ar r2 -> OR (env r1) (fixRI ar) (env r2)
625 ORNOT r1 ar r2 -> ORNOT (env r1) (fixRI ar) (env r2)
626 XOR r1 ar r2 -> XOR (env r1) (fixRI ar) (env r2)
627 XORNOT r1 ar r2 -> XORNOT (env r1) (fixRI ar) (env r2)
628 SLL r1 ar r2 -> SLL (env r1) (fixRI ar) (env r2)
629 SRL r1 ar r2 -> SRL (env r1) (fixRI ar) (env r2)
630 SRA r1 ar r2 -> SRA (env r1) (fixRI ar) (env r2)
631 ZAP r1 ar r2 -> ZAP (env r1) (fixRI ar) (env r2)
632 ZAPNOT r1 ar r2 -> ZAPNOT (env r1) (fixRI ar) (env r2)
633 CMP co r1 ar r2 -> CMP co (env r1) (fixRI ar) (env r2)
634 FCLR reg -> FCLR (env reg)
635 FABS r1 r2 -> FABS (env r1) (env r2)
636 FNEG s r1 r2 -> FNEG s (env r1) (env r2)
637 FADD s r1 r2 r3 -> FADD s (env r1) (env r2) (env r3)
638 FDIV s r1 r2 r3 -> FDIV s (env r1) (env r2) (env r3)
639 FMUL s r1 r2 r3 -> FMUL s (env r1) (env r2) (env r3)
640 FSUB s r1 r2 r3 -> FSUB s (env r1) (env r2) (env r3)
641 CVTxy s1 s2 r1 r2 -> CVTxy s1 s2 (env r1) (env r2)
642 FCMP s co r1 r2 r3 -> FCMP s co (env r1) (env r2) (env r3)
643 FMOV r1 r2 -> FMOV (env r1) (env r2)
644 BI cond reg lbl -> BI cond (env reg) lbl
645 BF cond reg lbl -> BF cond (env reg) lbl
646 JMP reg addr hint -> JMP (env reg) (fixAddr addr) hint
647 JSR reg addr i -> JSR (env reg) (fixAddr addr) i
650 fixAddr (AddrReg r1) = AddrReg (env r1)
651 fixAddr (AddrRegImm r1 i) = AddrRegImm (env r1) i
652 fixAddr other = other
654 fixRI (RIReg r) = RIReg (env r)
657 #endif {- alpha_TARGET_ARCH -}
658 -- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
661 patchRegs instr env = case instr of
662 MOV sz src dst -> patch2 (MOV sz) src dst
663 MOVZX sz src dst -> patch2 (MOVZX sz) src dst
664 MOVSX sz src dst -> patch2 (MOVSX sz) src dst
665 LEA sz src dst -> patch2 (LEA sz) src dst
666 ADD sz src dst -> patch2 (ADD sz) src dst
667 SUB sz src dst -> patch2 (SUB sz) src dst
668 IMUL sz src dst -> patch2 (IMUL sz) src dst
669 IDIV sz src -> patch1 (IDIV sz) src
670 AND sz src dst -> patch2 (AND sz) src dst
671 OR sz src dst -> patch2 (OR sz) src dst
672 XOR sz src dst -> patch2 (XOR sz) src dst
673 NOT sz op -> patch1 (NOT sz) op
674 NEGI sz op -> patch1 (NEGI sz) op
675 SHL sz imm dst -> patch1 (SHL sz imm) dst
676 SAR sz imm dst -> patch1 (SAR sz imm) dst
677 SHR sz imm dst -> patch1 (SHR sz imm) dst
678 TEST sz src dst -> patch2 (TEST sz) src dst
679 CMP sz src dst -> patch2 (CMP sz) src dst
680 PUSH sz op -> patch1 (PUSH sz) op
681 POP sz op -> patch1 (POP sz) op
682 SETCC cond op -> patch1 (SETCC cond) op
683 JMP op -> patch1 JMP op
684 FADD sz src -> FADD sz (patchOp src)
685 FIADD sz asrc -> FIADD sz (lookupAddr asrc)
686 FCOM sz src -> patch1 (FCOM sz) src
687 FDIV sz src -> FDIV sz (patchOp src)
688 --FDIVP sz src -> FDIVP sz (patchOp src)
689 FIDIV sz asrc -> FIDIV sz (lookupAddr asrc)
690 FDIVR sz src -> FDIVR sz (patchOp src)
691 --FDIVRP sz src -> FDIVRP sz (patchOp src)
692 FIDIVR sz asrc -> FIDIVR sz (lookupAddr asrc)
693 FICOM sz asrc -> FICOM sz (lookupAddr asrc)
694 FILD sz asrc dst -> FILD sz (lookupAddr asrc) (env dst)
695 FIST sz adst -> FIST sz (lookupAddr adst)
696 FLD sz src -> patch1 (FLD sz) (patchOp src)
697 FMUL sz src -> FMUL sz (patchOp src)
698 --FMULP sz src -> FMULP sz (patchOp src)
699 FIMUL sz asrc -> FIMUL sz (lookupAddr asrc)
700 FST sz dst -> FST sz (patchOp dst)
701 FSTP sz dst -> FSTP sz (patchOp dst)
702 FSUB sz src -> FSUB sz (patchOp src)
703 --FSUBP sz src -> FSUBP sz (patchOp src)
704 FISUB sz asrc -> FISUB sz (lookupAddr asrc)
705 FSUBR sz src -> FSUBR sz (patchOp src)
706 --FSUBRP sz src -> FSUBRP sz (patchOp src)
707 FISUBR sz asrc -> FISUBR sz (lookupAddr asrc)
708 FCOMP sz src -> FCOMP sz (patchOp src)
711 patch1 insn op = insn (patchOp op)
712 patch2 insn src dst = insn (patchOp src) (patchOp dst)
714 patchOp (OpReg reg) = OpReg (env reg)
715 patchOp (OpImm imm) = OpImm imm
716 patchOp (OpAddr ea) = OpAddr (lookupAddr ea)
718 lookupAddr (ImmAddr imm off) = ImmAddr imm off
719 lookupAddr (Addr base index disp)
720 = Addr (lookupBase base) (lookupIndex index) disp
722 lookupBase Nothing = Nothing
723 lookupBase (Just r) = Just (env r)
725 lookupIndex Nothing = Nothing
726 lookupIndex (Just (r,i)) = Just (env r, i)
728 #endif {- i386_TARGET_ARCH -}
729 -- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
730 #if sparc_TARGET_ARCH
732 patchRegs instr env = case instr of
733 LD sz addr reg -> LD sz (fixAddr addr) (env reg)
734 ST sz reg addr -> ST sz (env reg) (fixAddr addr)
735 ADD x cc r1 ar r2 -> ADD x cc (env r1) (fixRI ar) (env r2)
736 SUB x cc r1 ar r2 -> SUB x cc (env r1) (fixRI ar) (env r2)
737 AND b r1 ar r2 -> AND b (env r1) (fixRI ar) (env r2)
738 ANDN b r1 ar r2 -> ANDN b (env r1) (fixRI ar) (env r2)
739 OR b r1 ar r2 -> OR b (env r1) (fixRI ar) (env r2)
740 ORN b r1 ar r2 -> ORN b (env r1) (fixRI ar) (env r2)
741 XOR b r1 ar r2 -> XOR b (env r1) (fixRI ar) (env r2)
742 XNOR b r1 ar r2 -> XNOR b (env r1) (fixRI ar) (env r2)
743 SLL r1 ar r2 -> SLL (env r1) (fixRI ar) (env r2)
744 SRL r1 ar r2 -> SRL (env r1) (fixRI ar) (env r2)
745 SRA r1 ar r2 -> SRA (env r1) (fixRI ar) (env r2)
746 SETHI imm reg -> SETHI imm (env reg)
747 FABS s r1 r2 -> FABS s (env r1) (env r2)
748 FADD s r1 r2 r3 -> FADD s (env r1) (env r2) (env r3)
749 FCMP e s r1 r2 -> FCMP e s (env r1) (env r2)
750 FDIV s r1 r2 r3 -> FDIV s (env r1) (env r2) (env r3)
751 FMOV s r1 r2 -> FMOV s (env r1) (env r2)
752 FMUL s r1 r2 r3 -> FMUL s (env r1) (env r2) (env r3)
753 FNEG s r1 r2 -> FNEG s (env r1) (env r2)
754 FSQRT s r1 r2 -> FSQRT s (env r1) (env r2)
755 FSUB s r1 r2 r3 -> FSUB s (env r1) (env r2) (env r3)
756 FxTOy s1 s2 r1 r2 -> FxTOy s1 s2 (env r1) (env r2)
757 JMP addr -> JMP (fixAddr addr)
760 fixAddr (AddrRegReg r1 r2) = AddrRegReg (env r1) (env r2)
761 fixAddr (AddrRegImm r1 i) = AddrRegImm (env r1) i
763 fixRI (RIReg r) = RIReg (env r)
766 #endif {- sparc_TARGET_ARCH -}
769 %************************************************************************
771 \subsection{@spillReg@ and @loadReg@ functions}
773 %************************************************************************
775 Spill to memory, and load it back...
778 spillReg, loadReg :: Reg -> Reg -> InstrList
780 spillReg dyn (MemoryReg i pk)
782 sz = primRepToSize pk
785 {-Alpha: spill below the stack pointer (?)-}
786 IF_ARCH_alpha( ST sz dyn (spRel i)
788 {-I386: spill below stack pointer leaving 2 words/spill-}
789 ,IF_ARCH_i386 ( MOV sz (OpReg dyn) (OpAddr (spRel (-2 * i)))
791 {-SPARC: spill below frame pointer leaving 2 words/spill-}
792 ,IF_ARCH_sparc( ST sz dyn (fpRel (-2 * i))
796 ----------------------------
797 loadReg (MemoryReg i pk) dyn
799 sz = primRepToSize pk
802 IF_ARCH_alpha( LD sz dyn (spRel i)
803 ,IF_ARCH_i386 ( MOV sz (OpAddr (spRel (-2 * i))) (OpReg dyn)
804 ,IF_ARCH_sparc( LD sz (fpRel (-2 * i)) dyn