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(..))
63 IMPORT_1_3(List(partition))
67 import MachCode ( SYN_IE(InstrList) )
69 import AbsCSyn ( MagicId )
70 import BitSet ( unitBS, mkBS, minusBS, unionBS, listBS, BitSet )
71 import CLabel ( pprCLabel_asm, CLabel{-instance Ord-} )
72 import FiniteMap ( addToFM, lookupFM, FiniteMap )
73 import OrdList ( mkUnitList, OrdList )
74 import PrimRep ( PrimRep(..) )
75 import Stix ( StixTree, CodeSegment )
76 import UniqSet -- quite a bit of it
79 %************************************************************************
81 \subsection{Register allocation information}
83 %************************************************************************
86 type RegSet = UniqSet Reg
88 mkRegSet :: [Reg] -> RegSet
90 unionRegSets, minusRegSet :: RegSet -> RegSet -> RegSet
91 elementOfRegSet :: Reg -> RegSet -> Bool
92 isEmptyRegSet :: RegSet -> Bool
93 regSetToList :: RegSet -> [Reg]
96 emptyRegSet = emptyUniqSet
97 unionRegSets = unionUniqSets
98 minusRegSet = minusUniqSet
99 elementOfRegSet = elementOfUniqSet
100 isEmptyRegSet = isEmptyUniqSet
101 regSetToList = uniqSetToList
103 freeRegSet, callClobberedRegSet :: RegSet
104 argRegSet :: Int -> RegSet
106 freeRegSet = mkRegSet freeRegs
107 callClobberedRegSet = mkRegSet callClobberedRegs
108 argRegSet n = mkRegSet (argRegs n)
110 type RegAssignment = FiniteMap Reg Reg
111 type RegConflicts = FiniteMap Int RegSet
113 data FutureLive = FL RegSet (FiniteMap CLabel RegSet)
123 = RF RegSet -- in use
128 = RI RegSet -- in use
130 RegSet -- destinations
135 %************************************************************************
137 \subsection{Register allocation information}
139 %************************************************************************
141 COMMENT ON THE EXTRA BitSet FOR SPARC MRegsState: Getting the conflicts
142 right is a bit tedious for doubles. We'd have to add a conflict
143 function to the MachineRegisters class, and we'd have to put a PrimRep
144 in the MappedReg datatype, or use some kludge (e.g. register 64 + n is
145 really the same as 32 + n, except that it's used for a double, so it
146 also conflicts with 33 + n) to deal with it. It's just not worth the
147 bother, so we just partition the free floating point registers into
148 two sets: one for single precision and one for double precision. We
149 never seem to run out of floating point registers anyway.
153 = MRs BitSet -- integer registers
154 BitSet -- floating-point registers
155 IF_ARCH_sparc(BitSet,) -- double registers handled separately
159 #if alpha_TARGET_ARCH
160 # define INT_FLPT_CUTOFF 32
163 # define INT_FLPT_CUTOFF 8
165 #if sparc_TARGET_ARCH
166 # define INT_FLPT_CUTOFF 32
167 # define SNGL_DBL_CUTOFF 48
170 mkMRegsState :: [RegNo] -> MRegsState
171 possibleMRegs :: PrimRep -> MRegsState -> [RegNo]
172 useMReg :: MRegsState -> FAST_REG_NO -> MRegsState
173 useMRegs :: MRegsState -> [RegNo] -> MRegsState
174 freeMReg :: MRegsState -> FAST_REG_NO -> MRegsState
175 freeMRegs :: MRegsState -> [RegNo] -> MRegsState
178 = MRs (mkBS is) (mkBS fs2) IF_ARCH_sparc((mkBS ds2),)
180 (is, fs) = partition (< INT_FLPT_CUTOFF) xs
181 #if sparc_TARGET_ARCH
182 (ss, ds) = partition (< SNGL_DBL_CUTOFF) fs
183 fs2 = map (subtract INT_FLPT_CUTOFF) ss
184 ds2 = map (subtract INT_FLPT_CUTOFF) (filter even ds)
186 fs2 = map (subtract INT_FLPT_CUTOFF) fs
189 ------------------------------------------------
190 #if sparc_TARGET_ARCH
191 possibleMRegs FloatRep (MRs _ ss _) = [ x + INT_FLPT_CUTOFF | x <- listBS ss]
192 possibleMRegs DoubleRep (MRs _ _ ds) = [ x + INT_FLPT_CUTOFF | x <- listBS ds]
193 possibleMRegs _ (MRs is _ _) = listBS is
195 possibleMRegs FloatRep (MRs _ fs) = [ x + INT_FLPT_CUTOFF | x <- listBS fs]
196 possibleMRegs DoubleRep (MRs _ fs) = [ x + INT_FLPT_CUTOFF | x <- listBS fs]
197 possibleMRegs _ (MRs is _) = listBS is
200 ------------------------------------------------
201 #if sparc_TARGET_ARCH
202 useMReg (MRs is ss ds) n
203 = if (n _LT_ ILIT(INT_FLPT_CUTOFF)) then
204 MRs (is `minusBS` unitBS IBOX(n)) ss ds
205 else if (n _LT_ ILIT(SNGL_DBL_CUTOFF)) then
206 MRs is (ss `minusBS` unitBS (IBOX(n _SUB_ ILIT(INT_FLPT_CUTOFF)))) ds
208 MRs is ss (ds `minusBS` unitBS (IBOX(n _SUB_ ILIT(INT_FLPT_CUTOFF))))
210 useMReg (MRs is fs) n
211 = if (n _LT_ ILIT(INT_FLPT_CUTOFF))
212 then MRs (is `minusBS` unitBS IBOX(n)) fs
213 else MRs is (fs `minusBS` unitBS (IBOX(n _SUB_ ILIT(INT_FLPT_CUTOFF))))
216 ------------------------------------------------
217 #if sparc_TARGET_ARCH
218 useMRegs (MRs is ss ds) xs
219 = MRs (is `minusBS` is2) (ss `minusBS` ss2) (ds `minusBS` ds2)
221 MRs is2 ss2 ds2 = mkMRegsState xs
223 useMRegs (MRs is fs) xs
224 = MRs (is `minusBS` is2) (fs `minusBS` fs2)
226 MRs is2 fs2 = mkMRegsState xs
229 ------------------------------------------------
230 #if sparc_TARGET_ARCH
231 freeMReg (MRs is ss ds) n
232 = if (n _LT_ ILIT(INT_FLPT_CUTOFF)) then
233 MRs (is `unionBS` unitBS IBOX(n)) ss ds
234 else if (n _LT_ ILIT(SNGL_DBL_CUTOFF)) then
235 MRs is (ss `unionBS` unitBS (IBOX(n _SUB_ ILIT(INT_FLPT_CUTOFF)))) ds
237 MRs is ss (ds `unionBS` unitBS (IBOX(n _SUB_ ILIT(INT_FLPT_CUTOFF))))
239 freeMReg (MRs is fs) n
240 = if (n _LT_ ILIT(INT_FLPT_CUTOFF))
241 then MRs (is `unionBS` unitBS IBOX(n)) fs
242 else MRs is (fs `unionBS` unitBS (IBOX(n _SUB_ ILIT(INT_FLPT_CUTOFF))))
245 ------------------------------------------------
246 #if sparc_TARGET_ARCH
247 freeMRegs (MRs is ss ds) xs
248 = MRs (is `unionBS` is2) (ss `unionBS` ss2) (ds `unionBS` ds2)
250 MRs is2 ss2 ds2 = mkMRegsState xs
252 freeMRegs (MRs is fs) xs
253 = MRs (is `unionBS` is2) (fs `unionBS` fs2)
255 MRs is2 fs2 = mkMRegsState xs
259 %************************************************************************
261 \subsection{@RegUsage@ type; @noUsage@, @endUsage@, @regUsage@ functions}
263 %************************************************************************
265 @regUsage@ returns the sets of src and destination registers used by a
266 particular instruction. Machine registers that are pre-allocated to
267 stgRegs are filtered out, because they are uninteresting from a
268 register allocation standpoint. (We wouldn't want them to end up on
271 An important point: The @regUsage@ function for a particular
272 assembly language must not refer to fixed registers, such as Hp, SpA,
273 etc. The source and destination MRegsStates should only refer to
274 dynamically allocated registers or static registers from the free
275 list. As far as we are concerned, the fixed registers simply don't
276 exist (for allocation purposes, anyway).
279 data RegUsage = RU RegSet RegSet
281 noUsage, endUsage :: RegUsage
282 noUsage = RU emptyRegSet emptyRegSet
283 endUsage = RU emptyRegSet freeRegSet
285 regUsage :: Instr -> RegUsage
287 #if alpha_TARGET_ARCH
289 regUsage instr = case instr of
290 LD B reg addr -> usage (regAddr addr, [reg, t9])
291 LD BU reg addr -> usage (regAddr addr, [reg, t9])
292 -- LD W reg addr -> usage (regAddr addr, [reg, t9]) : UNUSED
293 -- LD WU reg addr -> usage (regAddr addr, [reg, t9]) : UNUSED
294 LD sz reg addr -> usage (regAddr addr, [reg])
295 LDA reg addr -> usage (regAddr addr, [reg])
296 LDAH reg addr -> usage (regAddr addr, [reg])
297 LDGP reg addr -> usage (regAddr addr, [reg])
298 LDI sz reg imm -> usage ([], [reg])
299 ST B reg addr -> usage (reg : regAddr addr, [t9, t10])
300 -- ST W reg addr -> usage (reg : regAddr addr, [t9, t10]) : UNUSED
301 ST sz reg addr -> usage (reg : regAddr addr, [])
302 CLR reg -> usage ([], [reg])
303 ABS sz ri reg -> usage (regRI ri, [reg])
304 NEG sz ov ri reg -> usage (regRI ri, [reg])
305 ADD sz ov r1 ar r2 -> usage (r1 : regRI ar, [r2])
306 SADD sz sc r1 ar r2 -> usage (r1 : regRI ar, [r2])
307 SUB sz ov r1 ar r2 -> usage (r1 : regRI ar, [r2])
308 SSUB sz sc r1 ar r2 -> usage (r1 : regRI ar, [r2])
309 MUL sz ov r1 ar r2 -> usage (r1 : regRI ar, [r2])
310 DIV sz un r1 ar r2 -> usage (r1 : regRI ar, [r2, t9, t10, t11, t12])
311 REM sz un r1 ar r2 -> usage (r1 : regRI ar, [r2, t9, t10, t11, t12])
312 NOT ri reg -> usage (regRI ri, [reg])
313 AND r1 ar r2 -> usage (r1 : regRI ar, [r2])
314 ANDNOT r1 ar r2 -> usage (r1 : regRI ar, [r2])
315 OR r1 ar r2 -> usage (r1 : regRI ar, [r2])
316 ORNOT r1 ar r2 -> usage (r1 : regRI ar, [r2])
317 XOR r1 ar r2 -> usage (r1 : regRI ar, [r2])
318 XORNOT r1 ar r2 -> usage (r1 : regRI ar, [r2])
319 SLL r1 ar r2 -> usage (r1 : regRI ar, [r2])
320 SRL r1 ar r2 -> usage (r1 : regRI ar, [r2])
321 SRA r1 ar r2 -> usage (r1 : regRI ar, [r2])
322 ZAP r1 ar r2 -> usage (r1 : regRI ar, [r2])
323 ZAPNOT r1 ar r2 -> usage (r1 : regRI ar, [r2])
324 CMP co r1 ar r2 -> usage (r1 : regRI ar, [r2])
325 FCLR reg -> usage ([], [reg])
326 FABS r1 r2 -> usage ([r1], [r2])
327 FNEG sz r1 r2 -> usage ([r1], [r2])
328 FADD sz r1 r2 r3 -> usage ([r1, r2], [r3])
329 FDIV sz r1 r2 r3 -> usage ([r1, r2], [r3])
330 FMUL sz r1 r2 r3 -> usage ([r1, r2], [r3])
331 FSUB sz r1 r2 r3 -> usage ([r1, r2], [r3])
332 CVTxy sz1 sz2 r1 r2 -> usage ([r1], [r2])
333 FCMP sz co r1 r2 r3 -> usage ([r1, r2], [r3])
334 FMOV r1 r2 -> usage ([r1], [r2])
337 -- We assume that all local jumps will be BI/BF/BR. JMP must be out-of-line.
338 BI cond reg lbl -> usage ([reg], [])
339 BF cond reg lbl -> usage ([reg], [])
340 JMP reg addr hint -> RU (mkRegSet (filter interesting (regAddr addr))) freeRegSet
342 BSR _ n -> RU (argRegSet n) callClobberedRegSet
343 JSR reg addr n -> RU (argRegSet n) callClobberedRegSet
348 usage (src, dst) = RU (mkRegSet (filter interesting src))
349 (mkRegSet (filter interesting dst))
351 interesting (FixedReg _) = False
354 regAddr (AddrReg r1) = [r1]
355 regAddr (AddrRegImm r1 _) = [r1]
356 regAddr (AddrImm _) = []
358 regRI (RIReg r) = [r]
361 #endif {- alpha_TARGET_ARCH -}
362 -- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
365 regUsage instr = case instr of
366 MOV sz src dst -> usage2 src dst
367 MOVZX sz src dst -> usage2 src dst
368 MOVSX sz src dst -> usage2 src dst
369 LEA sz src dst -> usage2 src dst
370 ADD sz src dst -> usage2 src dst
371 SUB sz src dst -> usage2 src dst
372 IMUL sz src dst -> usage2 src dst
373 IDIV sz src -> usage (eax:edx:opToReg src) [eax,edx]
374 AND sz src dst -> usage2 src dst
375 OR sz src dst -> usage2 src dst
376 XOR sz src dst -> usage2 src dst
377 NOT sz op -> usage1 op
378 NEGI sz op -> usage1 op
379 SHL sz imm dst -> usage1 dst -- imm has to be an Imm
380 SAR sz imm dst -> usage1 dst -- imm has to be an Imm
381 SHR sz imm dst -> usage1 dst -- imm has to be an Imm
382 PUSH sz op -> usage (opToReg op) []
383 POP sz op -> usage [] (opToReg op)
384 TEST sz src dst -> usage (opToReg src ++ opToReg dst) []
385 CMP sz src dst -> usage (opToReg src ++ opToReg dst) []
386 SETCC cond op -> usage [] (opToReg op)
387 JXX cond label -> usage [] []
388 JMP op -> usage (opToReg op) freeRegs
389 CALL imm -> usage [] callClobberedRegs
390 CLTD -> usage [eax] [edx]
392 SAHF -> usage [eax] []
393 FABS -> usage [st0] [st0]
394 FADD sz src -> usage (st0:opToReg src) [st0] -- allFPRegs
395 FADDP -> usage [st0,st1] [st0] -- allFPRegs
396 FIADD sz asrc -> usage (addrToRegs asrc) [st0]
397 FCHS -> usage [st0] [st0]
398 FCOM sz src -> usage (st0:opToReg src) []
399 FCOS -> usage [st0] [st0]
400 FDIV sz src -> usage (st0:opToReg src) [st0]
401 FDIVP -> usage [st0,st1] [st0]
402 FDIVRP -> usage [st0,st1] [st0]
403 FIDIV sz asrc -> usage (addrToRegs asrc) [st0]
404 FDIVR sz src -> usage (st0:opToReg src) [st0]
405 FIDIVR sz asrc -> usage (addrToRegs asrc) [st0]
406 FICOM sz asrc -> usage (addrToRegs asrc) []
407 FILD sz asrc dst -> usage (addrToRegs asrc) [dst] -- allFPRegs
408 FIST sz adst -> usage (st0:addrToRegs adst) []
409 FLD sz src -> usage (opToReg src) [st0] -- allFPRegs
410 FLD1 -> usage [] [st0] -- allFPRegs
411 FLDZ -> usage [] [st0] -- allFPRegs
412 FMUL sz src -> usage (st0:opToReg src) [st0]
413 FMULP -> usage [st0,st1] [st0]
414 FIMUL sz asrc -> usage (addrToRegs asrc) [st0]
415 FRNDINT -> usage [st0] [st0]
416 FSIN -> usage [st0] [st0]
417 FSQRT -> usage [st0] [st0]
418 FST sz (OpReg r) -> usage [st0] [r]
419 FST sz dst -> usage (st0:opToReg dst) []
420 FSTP sz (OpReg r) -> usage [st0] [r] -- allFPRegs
421 FSTP sz dst -> usage (st0:opToReg dst) [] -- allFPRegs
422 FSUB sz src -> usage (st0:opToReg src) [st0] -- allFPRegs
423 FSUBR sz src -> usage (st0:opToReg src) [st0] -- allFPRegs
424 FISUB sz asrc -> usage (addrToRegs asrc) [st0]
425 FSUBP -> usage [st0,st1] [st0] -- allFPRegs
426 FSUBRP -> usage [st0,st1] [st0] -- allFPRegs
427 FISUBR sz asrc -> usage (addrToRegs asrc) [st0]
428 FTST -> usage [st0] []
429 FCOMP sz op -> usage (st0:opToReg op) [st0] -- allFPRegs
430 FUCOMPP -> usage [st0, st1] [] -- allFPRegs
431 FXCH -> usage [st0, st1] [st0, st1]
432 FNSTSW -> usage [] [eax]
435 usage2 :: Operand -> Operand -> RegUsage
436 usage2 op (OpReg reg) = usage (opToReg op) [reg]
437 usage2 op (OpAddr ea) = usage (opToReg op ++ addrToRegs ea) []
438 usage2 op (OpImm imm) = usage (opToReg op) []
439 usage1 :: Operand -> RegUsage
440 usage1 (OpReg reg) = usage [reg] [reg]
441 usage1 (OpAddr ea) = usage (addrToRegs ea) []
442 allFPRegs = [st0,st1,st2,st3,st4,st5,st6,st7]
444 --callClobberedRegs = [ eax, ecx, edx ] -- according to gcc, anyway.
445 callClobberedRegs = [eax]
447 -- General purpose register collecting functions.
449 opToReg (OpReg reg) = [reg]
450 opToReg (OpImm imm) = []
451 opToReg (OpAddr ea) = addrToRegs ea
453 addrToRegs (Addr base index _) = baseToReg base ++ indexToReg index
454 where baseToReg Nothing = []
455 baseToReg (Just r) = [r]
456 indexToReg Nothing = []
457 indexToReg (Just (r,_)) = [r]
458 addrToRegs (ImmAddr _ _) = []
460 usage src dst = RU (mkRegSet (filter interesting src))
461 (mkRegSet (filter interesting dst))
463 interesting (FixedReg _) = False
466 #endif {- i386_TARGET_ARCH -}
467 -- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
468 #if sparc_TARGET_ARCH
470 regUsage instr = case instr of
471 LD sz addr reg -> usage (regAddr addr, [reg])
472 ST sz reg addr -> usage (reg : regAddr addr, [])
473 ADD x cc r1 ar r2 -> usage (r1 : regRI ar, [r2])
474 SUB x cc r1 ar r2 -> usage (r1 : regRI ar, [r2])
475 AND b r1 ar r2 -> usage (r1 : regRI ar, [r2])
476 ANDN b r1 ar r2 -> usage (r1 : regRI ar, [r2])
477 OR b r1 ar r2 -> usage (r1 : regRI ar, [r2])
478 ORN b r1 ar r2 -> usage (r1 : regRI ar, [r2])
479 XOR b r1 ar r2 -> usage (r1 : regRI ar, [r2])
480 XNOR b r1 ar r2 -> usage (r1 : regRI ar, [r2])
481 SLL r1 ar r2 -> usage (r1 : regRI ar, [r2])
482 SRL r1 ar r2 -> usage (r1 : regRI ar, [r2])
483 SRA r1 ar r2 -> usage (r1 : regRI ar, [r2])
484 SETHI imm reg -> usage ([], [reg])
485 FABS s r1 r2 -> usage ([r1], [r2])
486 FADD s r1 r2 r3 -> usage ([r1, r2], [r3])
487 FCMP e s r1 r2 -> usage ([r1, r2], [])
488 FDIV s r1 r2 r3 -> usage ([r1, r2], [r3])
489 FMOV s r1 r2 -> usage ([r1], [r2])
490 FMUL s r1 r2 r3 -> usage ([r1, r2], [r3])
491 FNEG s r1 r2 -> usage ([r1], [r2])
492 FSQRT s r1 r2 -> usage ([r1], [r2])
493 FSUB s r1 r2 r3 -> usage ([r1, r2], [r3])
494 FxTOy s1 s2 r1 r2 -> usage ([r1], [r2])
496 -- We assume that all local jumps will be BI/BF. JMP must be out-of-line.
497 JMP addr -> RU (mkRegSet (filter interesting (regAddr addr))) freeRegSet
499 CALL _ n True -> endUsage
500 CALL _ n False -> RU (argRegSet n) callClobberedRegSet
504 usage (src, dst) = RU (mkRegSet (filter interesting src))
505 (mkRegSet (filter interesting dst))
507 interesting (FixedReg _) = False
510 regAddr (AddrRegReg r1 r2) = [r1, r2]
511 regAddr (AddrRegImm r1 _) = [r1]
513 regRI (RIReg r) = [r]
516 #endif {- sparc_TARGET_ARCH -}
519 %************************************************************************
521 \subsection{@RegLiveness@ type; @regLiveness@ function}
523 %************************************************************************
525 @regLiveness@ takes future liveness information and modifies it
526 according to the semantics of branches and labels. (An out-of-line
527 branch clobbers the liveness passed back by the following instruction;
528 a forward local branch passes back the liveness from the target label;
529 a conditional branch merges the liveness from the target and the
530 liveness from its successor; a label stashes away the current liveness
531 in the future liveness environment).
534 data RegLiveness = RL RegSet FutureLive
536 regLiveness :: Instr -> RegLiveness -> RegLiveness
538 regLiveness instr info@(RL live future@(FL all env))
541 = case (lookupFM env lbl) of
543 Nothing -> trace ("Missing " ++ (show (pprCLabel_asm lbl)) ++
544 " in future?") emptyRegSet
546 case instr of -- the rest is machine-specific...
548 #if alpha_TARGET_ARCH
550 -- We assume that all local jumps will be BI/BF. JMP must be out-of-line.
552 BR (ImmCLbl lbl) -> RL (lookup lbl) future
553 BI _ _ (ImmCLbl lbl) -> RL (lookup lbl `unionRegSets` live) future
554 BF _ _ (ImmCLbl lbl) -> RL (lookup lbl `unionRegSets` live) future
555 JMP _ _ _ -> RL emptyRegSet future
556 BSR _ _ -> RL live future
557 JSR _ _ _ -> RL live future
558 LABEL lbl -> RL live (FL (all `unionRegSets` live) (addToFM env lbl live))
561 #endif {- alpha_TARGET_ARCH -}
562 -- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
565 JXX _ lbl -> RL (lookup lbl `unionRegSets` live) future
566 JMP _ -> RL emptyRegSet future
567 CALL _ -> RL live future
568 LABEL lbl -> RL live (FL (all `unionRegSets` live) (addToFM env lbl live))
571 #endif {- i386_TARGET_ARCH -}
572 -- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
573 #if sparc_TARGET_ARCH
575 -- We assume that all local jumps will be BI/BF. JMP must be out-of-line.
577 BI ALWAYS _ (ImmCLbl lbl) -> RL (lookup lbl) future
578 BI _ _ (ImmCLbl lbl) -> RL (lookup lbl `unionRegSets` live) future
579 BF ALWAYS _ (ImmCLbl lbl) -> RL (lookup lbl) future
580 BF _ _ (ImmCLbl lbl) -> RL (lookup lbl `unionRegSets` live) future
581 JMP _ -> RL emptyRegSet future
582 CALL _ i True -> RL emptyRegSet future
583 CALL _ i False -> RL live future
584 LABEL lbl -> RL live (FL (all `unionRegSets` live) (addToFM env lbl live))
587 #endif {- sparc_TARGET_ARCH -}
590 %************************************************************************
592 \subsection{@patchRegs@ function}
594 %************************************************************************
596 @patchRegs@ takes an instruction (possibly with
597 MemoryReg/UnmappedReg registers) and changes all register references
598 according to the supplied environment.
601 patchRegs :: Instr -> (Reg -> Reg) -> Instr
603 #if alpha_TARGET_ARCH
605 patchRegs instr env = case instr of
606 LD sz reg addr -> LD sz (env reg) (fixAddr addr)
607 LDA reg addr -> LDA (env reg) (fixAddr addr)
608 LDAH reg addr -> LDAH (env reg) (fixAddr addr)
609 LDGP reg addr -> LDGP (env reg) (fixAddr addr)
610 LDI sz reg imm -> LDI sz (env reg) imm
611 ST sz reg addr -> ST sz (env reg) (fixAddr addr)
612 CLR reg -> CLR (env reg)
613 ABS sz ar reg -> ABS sz (fixRI ar) (env reg)
614 NEG sz ov ar reg -> NEG sz ov (fixRI ar) (env reg)
615 ADD sz ov r1 ar r2 -> ADD sz ov (env r1) (fixRI ar) (env r2)
616 SADD sz sc r1 ar r2 -> SADD sz sc (env r1) (fixRI ar) (env r2)
617 SUB sz ov r1 ar r2 -> SUB sz ov (env r1) (fixRI ar) (env r2)
618 SSUB sz sc r1 ar r2 -> SSUB sz sc (env r1) (fixRI ar) (env r2)
619 MUL sz ov r1 ar r2 -> MUL sz ov (env r1) (fixRI ar) (env r2)
620 DIV sz un r1 ar r2 -> DIV sz un (env r1) (fixRI ar) (env r2)
621 REM sz un r1 ar r2 -> REM sz un (env r1) (fixRI ar) (env r2)
622 NOT ar reg -> NOT (fixRI ar) (env reg)
623 AND r1 ar r2 -> AND (env r1) (fixRI ar) (env r2)
624 ANDNOT r1 ar r2 -> ANDNOT (env r1) (fixRI ar) (env r2)
625 OR r1 ar r2 -> OR (env r1) (fixRI ar) (env r2)
626 ORNOT r1 ar r2 -> ORNOT (env r1) (fixRI ar) (env r2)
627 XOR r1 ar r2 -> XOR (env r1) (fixRI ar) (env r2)
628 XORNOT r1 ar r2 -> XORNOT (env r1) (fixRI ar) (env r2)
629 SLL r1 ar r2 -> SLL (env r1) (fixRI ar) (env r2)
630 SRL r1 ar r2 -> SRL (env r1) (fixRI ar) (env r2)
631 SRA r1 ar r2 -> SRA (env r1) (fixRI ar) (env r2)
632 ZAP r1 ar r2 -> ZAP (env r1) (fixRI ar) (env r2)
633 ZAPNOT r1 ar r2 -> ZAPNOT (env r1) (fixRI ar) (env r2)
634 CMP co r1 ar r2 -> CMP co (env r1) (fixRI ar) (env r2)
635 FCLR reg -> FCLR (env reg)
636 FABS r1 r2 -> FABS (env r1) (env r2)
637 FNEG s r1 r2 -> FNEG s (env r1) (env r2)
638 FADD s r1 r2 r3 -> FADD s (env r1) (env r2) (env r3)
639 FDIV s r1 r2 r3 -> FDIV s (env r1) (env r2) (env r3)
640 FMUL s r1 r2 r3 -> FMUL s (env r1) (env r2) (env r3)
641 FSUB s r1 r2 r3 -> FSUB s (env r1) (env r2) (env r3)
642 CVTxy s1 s2 r1 r2 -> CVTxy s1 s2 (env r1) (env r2)
643 FCMP s co r1 r2 r3 -> FCMP s co (env r1) (env r2) (env r3)
644 FMOV r1 r2 -> FMOV (env r1) (env r2)
645 BI cond reg lbl -> BI cond (env reg) lbl
646 BF cond reg lbl -> BF cond (env reg) lbl
647 JMP reg addr hint -> JMP (env reg) (fixAddr addr) hint
648 JSR reg addr i -> JSR (env reg) (fixAddr addr) i
651 fixAddr (AddrReg r1) = AddrReg (env r1)
652 fixAddr (AddrRegImm r1 i) = AddrRegImm (env r1) i
653 fixAddr other = other
655 fixRI (RIReg r) = RIReg (env r)
658 #endif {- alpha_TARGET_ARCH -}
659 -- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
662 patchRegs instr env = case instr of
663 MOV sz src dst -> patch2 (MOV sz) src dst
664 MOVZX sz src dst -> patch2 (MOVZX sz) src dst
665 MOVSX sz src dst -> patch2 (MOVSX sz) src dst
666 LEA sz src dst -> patch2 (LEA sz) src dst
667 ADD sz src dst -> patch2 (ADD sz) src dst
668 SUB sz src dst -> patch2 (SUB sz) src dst
669 IMUL sz src dst -> patch2 (IMUL sz) src dst
670 IDIV sz src -> patch1 (IDIV sz) src
671 AND sz src dst -> patch2 (AND sz) src dst
672 OR sz src dst -> patch2 (OR sz) src dst
673 XOR sz src dst -> patch2 (XOR sz) src dst
674 NOT sz op -> patch1 (NOT sz) op
675 NEGI sz op -> patch1 (NEGI sz) op
676 SHL sz imm dst -> patch1 (SHL sz imm) dst
677 SAR sz imm dst -> patch1 (SAR sz imm) dst
678 SHR sz imm dst -> patch1 (SHR sz imm) dst
679 TEST sz src dst -> patch2 (TEST sz) src dst
680 CMP sz src dst -> patch2 (CMP sz) src dst
681 PUSH sz op -> patch1 (PUSH sz) op
682 POP sz op -> patch1 (POP sz) op
683 SETCC cond op -> patch1 (SETCC cond) op
684 JMP op -> patch1 JMP op
685 FADD sz src -> FADD sz (patchOp src)
686 FIADD sz asrc -> FIADD sz (lookupAddr asrc)
687 FCOM sz src -> patch1 (FCOM sz) src
688 FDIV sz src -> FDIV sz (patchOp src)
689 --FDIVP sz src -> FDIVP sz (patchOp src)
690 FIDIV sz asrc -> FIDIV sz (lookupAddr asrc)
691 FDIVR sz src -> FDIVR sz (patchOp src)
692 --FDIVRP sz src -> FDIVRP sz (patchOp src)
693 FIDIVR sz asrc -> FIDIVR sz (lookupAddr asrc)
694 FICOM sz asrc -> FICOM sz (lookupAddr asrc)
695 FILD sz asrc dst -> FILD sz (lookupAddr asrc) (env dst)
696 FIST sz adst -> FIST sz (lookupAddr adst)
697 FLD sz src -> patch1 (FLD sz) (patchOp src)
698 FMUL sz src -> FMUL sz (patchOp src)
699 --FMULP sz src -> FMULP sz (patchOp src)
700 FIMUL sz asrc -> FIMUL sz (lookupAddr asrc)
701 FST sz dst -> FST sz (patchOp dst)
702 FSTP sz dst -> FSTP sz (patchOp dst)
703 FSUB sz src -> FSUB sz (patchOp src)
704 --FSUBP sz src -> FSUBP sz (patchOp src)
705 FISUB sz asrc -> FISUB sz (lookupAddr asrc)
706 FSUBR sz src -> FSUBR sz (patchOp src)
707 --FSUBRP sz src -> FSUBRP sz (patchOp src)
708 FISUBR sz asrc -> FISUBR sz (lookupAddr asrc)
709 FCOMP sz src -> FCOMP sz (patchOp src)
712 patch1 insn op = insn (patchOp op)
713 patch2 insn src dst = insn (patchOp src) (patchOp dst)
715 patchOp (OpReg reg) = OpReg (env reg)
716 patchOp (OpImm imm) = OpImm imm
717 patchOp (OpAddr ea) = OpAddr (lookupAddr ea)
719 lookupAddr (ImmAddr imm off) = ImmAddr imm off
720 lookupAddr (Addr base index disp)
721 = Addr (lookupBase base) (lookupIndex index) disp
723 lookupBase Nothing = Nothing
724 lookupBase (Just r) = Just (env r)
726 lookupIndex Nothing = Nothing
727 lookupIndex (Just (r,i)) = Just (env r, i)
729 #endif {- i386_TARGET_ARCH -}
730 -- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
731 #if sparc_TARGET_ARCH
733 patchRegs instr env = case instr of
734 LD sz addr reg -> LD sz (fixAddr addr) (env reg)
735 ST sz reg addr -> ST sz (env reg) (fixAddr addr)
736 ADD x cc r1 ar r2 -> ADD x cc (env r1) (fixRI ar) (env r2)
737 SUB x cc r1 ar r2 -> SUB x cc (env r1) (fixRI ar) (env r2)
738 AND b r1 ar r2 -> AND b (env r1) (fixRI ar) (env r2)
739 ANDN b r1 ar r2 -> ANDN b (env r1) (fixRI ar) (env r2)
740 OR b r1 ar r2 -> OR b (env r1) (fixRI ar) (env r2)
741 ORN b r1 ar r2 -> ORN b (env r1) (fixRI ar) (env r2)
742 XOR b r1 ar r2 -> XOR b (env r1) (fixRI ar) (env r2)
743 XNOR b r1 ar r2 -> XNOR b (env r1) (fixRI ar) (env r2)
744 SLL r1 ar r2 -> SLL (env r1) (fixRI ar) (env r2)
745 SRL r1 ar r2 -> SRL (env r1) (fixRI ar) (env r2)
746 SRA r1 ar r2 -> SRA (env r1) (fixRI ar) (env r2)
747 SETHI imm reg -> SETHI imm (env reg)
748 FABS s r1 r2 -> FABS s (env r1) (env r2)
749 FADD s r1 r2 r3 -> FADD s (env r1) (env r2) (env r3)
750 FCMP e s r1 r2 -> FCMP e s (env r1) (env r2)
751 FDIV s r1 r2 r3 -> FDIV s (env r1) (env r2) (env r3)
752 FMOV s r1 r2 -> FMOV s (env r1) (env r2)
753 FMUL s r1 r2 r3 -> FMUL s (env r1) (env r2) (env r3)
754 FNEG s r1 r2 -> FNEG s (env r1) (env r2)
755 FSQRT s r1 r2 -> FSQRT s (env r1) (env r2)
756 FSUB s r1 r2 r3 -> FSUB s (env r1) (env r2) (env r3)
757 FxTOy s1 s2 r1 r2 -> FxTOy s1 s2 (env r1) (env r2)
758 JMP addr -> JMP (fixAddr addr)
761 fixAddr (AddrRegReg r1 r2) = AddrRegReg (env r1) (env r2)
762 fixAddr (AddrRegImm r1 i) = AddrRegImm (env r1) i
764 fixRI (RIReg r) = RIReg (env r)
767 #endif {- sparc_TARGET_ARCH -}
770 %************************************************************************
772 \subsection{@spillReg@ and @loadReg@ functions}
774 %************************************************************************
776 Spill to memory, and load it back...
779 spillReg, loadReg :: Reg -> Reg -> InstrList
781 spillReg dyn (MemoryReg i pk)
783 sz = primRepToSize pk
786 {-Alpha: spill below the stack pointer (?)-}
787 IF_ARCH_alpha( ST sz dyn (spRel i)
789 {-I386: spill below stack pointer leaving 2 words/spill-}
790 ,IF_ARCH_i386 ( MOV sz (OpReg dyn) (OpAddr (spRel (-2 * i)))
792 {-SPARC: spill below frame pointer leaving 2 words/spill-}
793 ,IF_ARCH_sparc( ST sz dyn (fpRel (-2 * i))
797 ----------------------------
798 loadReg (MemoryReg i pk) dyn
800 sz = primRepToSize pk
803 IF_ARCH_alpha( LD sz dyn (spRel i)
804 ,IF_ARCH_i386 ( MOV sz (OpAddr (spRel (-2 * i))) (OpReg dyn)
805 ,IF_ARCH_sparc( LD sz (fpRel (-2 * i)) dyn