-%
-% (c) The AQUA Project, Glasgow University, 1996-1998
-%
-\section[RegAllocInfo]{Machine-specific info used for register allocation}
+-----------------------------------------------------------------------------
+--
+-- Machine-specific parts of the register allocator
+--
+-- (c) The University of Glasgow 1996-2004
+--
+-----------------------------------------------------------------------------
-The (machine-independent) allocator itself is in @AsmRegAlloc@.
-
-\begin{code}
#include "nativeGen/NCG.h"
module RegAllocInfo (
RegUsage(..),
noUsage,
regUsage,
- InsnFuture(..),
- insnFuture,
-
- loadReg,
patchRegs,
- spillReg,
- findReservedRegs,
-
- RegSet,
- regSetFromList,
- regSetToList,
- isEmptyRegSet,
- emptyRegSet,
- eqRegSets,
- filterRegSet,
- unitRegSet,
- elemRegSet,
- unionRegSets,
- minusRegSets,
- intersectionRegSets
+ jumpDests,
+ isRegRegMove,
+
+ maxSpillSlots,
+ mkSpillInstr,
+ mkLoadInstr,
) where
#include "HsVersions.h"
-import List ( sort )
-import MachMisc
+import Cmm ( BlockId )
+#if powerpc_TARGET_ARCH || i386_TARGET_ARCH
+import MachOp ( MachRep(..) )
+#endif
+import MachInstrs
import MachRegs
-import Stix ( DestInfo(..) )
-import CLabel ( isAsmTemp, CLabel{-instance Ord-} )
-import FiniteMap ( addToFM, lookupFM, FiniteMap )
import Outputable
import Constants ( rESERVED_C_STACK_BYTES )
-import Unique ( Unique, Uniquable(..) )
import FastTypes
-\end{code}
-
-%************************************************************************
-%* *
-\subsection{Sets of registers}
-%* *
-%************************************************************************
-
-\begin{code}
-
--- Blargh. Use ghc stuff soon! Or: perhaps that's not such a good
--- idea. Most of these sets are either empty or very small, and it
--- might be that the overheads of the FiniteMap based set implementation
--- is a net loss. The same might be true of FeSets.
-
-newtype RegSet = MkRegSet [Reg]
-
-regSetFromList xs
- = MkRegSet (nukeDups (sort xs))
- where nukeDups :: [Reg] -> [Reg]
- nukeDups [] = []
- nukeDups [x] = [x]
- nukeDups (x:y:xys)
- = if x == y then nukeDups (y:xys)
- else x : nukeDups (y:xys)
-
-regSetToList (MkRegSet xs) = xs
-isEmptyRegSet (MkRegSet xs) = null xs
-emptyRegSet = MkRegSet []
-eqRegSets (MkRegSet xs1) (MkRegSet xs2) = xs1 == xs2
-unitRegSet x = MkRegSet [x]
-filterRegSet p (MkRegSet xs) = MkRegSet (filter p xs)
-
-elemRegSet x (MkRegSet xs)
- = f xs
- where
- f [] = False
- f (y:ys) | x == y = True
- | x < y = False
- | otherwise = f ys
-
-unionRegSets (MkRegSet xs1) (MkRegSet xs2)
- = MkRegSet (f xs1 xs2)
- where
- f [] bs = bs
- f as [] = as
- f (a:as) (b:bs)
- | a < b = a : f as (b:bs)
- | a > b = b : f (a:as) bs
- | otherwise = a : f as bs
-
-minusRegSets (MkRegSet xs1) (MkRegSet xs2)
- = MkRegSet (f xs1 xs2)
- where
- f [] bs = []
- f as [] = as
- f (a:as) (b:bs)
- | a < b = a : f as (b:bs)
- | a > b = f (a:as) bs
- | otherwise = f as bs
-
-intersectionRegSets (MkRegSet xs1) (MkRegSet xs2)
- = MkRegSet (f xs1 xs2)
- where
- f [] bs = []
- f as [] = []
- f (a:as) (b:bs)
- | a < b = f as (b:bs)
- | a > b = f (a:as) bs
- | otherwise = a : f as bs
-\end{code}
-
-%************************************************************************
-%* *
-\subsection{@RegUsage@ type; @noUsage@ and @regUsage@ functions}
-%* *
-%************************************************************************
-
-@regUsage@ returns the sets of src and destination registers used by a
-particular instruction. Machine registers that are pre-allocated to
-stgRegs are filtered out, because they are uninteresting from a
-register allocation standpoint. (We wouldn't want them to end up on
-the free list!) As far as we are concerned, the fixed registers
-simply don't exist (for allocation purposes, anyway).
-
-regUsage doesn't need to do any trickery for jumps and such. Just
-state precisely the regs read and written by that insn. The
-consequences of control flow transfers, as far as register allocation
-goes, are taken care of by @insnFuture@.
-
-\begin{code}
-data RegUsage = RU RegSet RegSet
+-- -----------------------------------------------------------------------------
+-- RegUsage type
+
+-- @regUsage@ returns the sets of src and destination registers used
+-- by a particular instruction. Machine registers that are
+-- pre-allocated to stgRegs are filtered out, because they are
+-- uninteresting from a register allocation standpoint. (We wouldn't
+-- want them to end up on the free list!) As far as we are concerned,
+-- the fixed registers simply don't exist (for allocation purposes,
+-- anyway).
+
+-- regUsage doesn't need to do any trickery for jumps and such. Just
+-- state precisely the regs read and written by that insn. The
+-- consequences of control flow transfers, as far as register
+-- allocation goes, are taken care of by the register allocator.
+
+data RegUsage = RU [Reg] [Reg]
noUsage :: RegUsage
-noUsage = RU emptyRegSet emptyRegSet
+noUsage = RU [] []
regUsage :: Instr -> RegUsage
-interesting (VirtualRegI _) = True
-interesting (VirtualRegF _) = True
-interesting (VirtualRegD _) = True
-interesting (RealReg i) = isFastTrue (freeReg i)
+interesting (VirtualRegI _) = True
+interesting (VirtualRegHi _) = True
+interesting (VirtualRegF _) = True
+interesting (VirtualRegD _) = True
+interesting (RealReg i) = isFastTrue (freeReg i)
-#if alpha_TARGET_ARCH
+#if alpha_TARGET_ARCH
regUsage instr = case instr of
LD B reg addr -> usage (regAddr addr, [reg, t9])
LD Bu reg addr -> usage (regAddr addr, [reg, t9])
MOVSxL sz src dst -> usageRW src dst
LEA sz src dst -> usageRW src dst
ADD sz src dst -> usageRM src dst
+ ADC sz src dst -> usageRM src dst
SUB sz src dst -> usageRM src dst
IMUL sz src dst -> usageRM src dst
IMUL64 sd1 sd2 -> mkRU [sd1,sd2] [sd1,sd2]
MUL sz src dst -> usageRM src dst
- IQUOT sz src dst -> usageRM src dst
- IREM sz src dst -> usageRM src dst
- QUOT sz src dst -> usageRM src dst
- REM sz src dst -> usageRM src dst
+ DIV sz op -> mkRU (eax:edx:use_R op) [eax,edx]
+ IDIV sz op -> mkRU (eax:edx:use_R op) [eax,edx]
AND sz src dst -> usageRM src dst
OR sz src dst -> usageRM src dst
XOR sz src dst -> usageRM src dst
NOT sz op -> usageM op
NEGI sz op -> usageM op
- SHL sz imm dst -> usageM dst
- SAR sz imm dst -> usageM dst
- SHR sz imm dst -> usageM dst
+ SHL sz imm dst -> usageRM imm dst
+ SAR sz imm dst -> usageRM imm dst
+ SHR sz imm dst -> usageRM imm dst
BT sz imm src -> mkRU (use_R src) []
PUSH sz op -> mkRU (use_R op) []
CMP sz src dst -> mkRU (use_R src ++ use_R dst) []
SETCC cond op -> mkRU [] (def_W op)
JXX cond lbl -> mkRU [] []
- JMP dsts op -> mkRU (use_R op) []
+ JMP op -> mkRU (use_R op) []
+ JMP_TBL op ids -> mkRU (use_R op) []
CALL (Left imm) -> mkRU [] callClobberedRegs
CALL (Right reg) -> mkRU [reg] callClobberedRegs
CLTD -> mkRU [eax] [edx]
GTAN sz src dst -> mkRU [src] [dst]
COMMENT _ -> noUsage
- SEGMENT _ -> noUsage
- LABEL _ -> noUsage
- ASCII _ _ -> noUsage
- DATA _ _ -> noUsage
DELTA _ -> noUsage
- _ -> pprPanic "regUsage(x86)" empty
+
+ _other -> panic "regUsage: unrecognised instr"
where
-- 2 operand form; first operand Read; second Written
use_EA (AddrBaseIndex Nothing (Just (i,_)) _) = [i]
use_EA (AddrBaseIndex (Just b) (Just (i,_)) _) = [b,i]
- mkRU src dst = RU (regSetFromList (filter interesting src))
- (regSetFromList (filter interesting dst))
+ mkRU src dst = RU (filter interesting src)
+ (filter interesting dst)
#endif /* i386_TARGET_ARCH */
-- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
regUsage instr = case instr of
LD sz reg addr -> usage (regAddr addr, [reg])
+ LA sz reg addr -> usage (regAddr addr, [reg])
ST sz reg addr -> usage (reg : regAddr addr, [])
STU sz reg addr -> usage (reg : regAddr addr, [])
LIS reg imm -> usage ([], [reg])
CMPL sz reg ri -> usage (reg : regRI ri,[])
BCC cond lbl -> noUsage
MTCTR reg -> usage ([reg],[])
- BCTR dsts -> noUsage
+ BCTR targets -> noUsage
BL imm params -> usage (params, callClobberedRegs)
BCTRL params -> usage (params, callClobberedRegs)
ADD reg1 reg2 ri -> usage (reg2 : regRI ri, [reg1])
+ ADDC reg1 reg2 reg3-> usage ([reg2,reg3], [reg1])
+ ADDE reg1 reg2 reg3-> usage ([reg2,reg3], [reg1])
+ ADDIS reg1 reg2 imm -> usage ([reg2], [reg1])
SUBF reg1 reg2 reg3-> usage ([reg2,reg3], [reg1])
MULLW reg1 reg2 ri -> usage (reg2 : regRI ri, [reg1])
DIVW reg1 reg2 reg3-> usage ([reg2,reg3], [reg1])
DIVWU reg1 reg2 reg3-> usage ([reg2,reg3], [reg1])
+ MULLW_MayOflo reg1 reg2 reg3
+ -> usage ([reg2,reg3], [reg1])
AND reg1 reg2 ri -> usage (reg2 : regRI ri, [reg1])
OR reg1 reg2 ri -> usage (reg2 : regRI ri, [reg1])
XOR reg1 reg2 ri -> usage (reg2 : regRI ri, [reg1])
XORIS reg1 reg2 imm -> usage ([reg2], [reg1])
+ EXTS siz reg1 reg2 -> usage ([reg2], [reg1])
NEG reg1 reg2 -> usage ([reg2], [reg1])
NOT reg1 reg2 -> usage ([reg2], [reg1])
SLW reg1 reg2 ri -> usage (reg2 : regRI ri, [reg1])
SRW reg1 reg2 ri -> usage (reg2 : regRI ri, [reg1])
SRAW reg1 reg2 ri -> usage (reg2 : regRI ri, [reg1])
+ RLWINM reg1 reg2 sh mb me
+ -> usage ([reg2], [reg1])
FADD sz r1 r2 r3 -> usage ([r2,r3], [r1])
FSUB sz r1 r2 r3 -> usage ([r2,r3], [r1])
FMUL sz r1 r2 r3 -> usage ([r2,r3], [r1])
FNEG r1 r2 -> usage ([r2], [r1])
FCMP r1 r2 -> usage ([r1,r2], [])
FCTIWZ r1 r2 -> usage ([r2], [r1])
+ FRSP r1 r2 -> usage ([r2], [r1])
+ MFCR reg -> usage ([], [reg])
_ -> noUsage
where
- usage (src, dst) = RU (regSetFromList (filter interesting src))
- (regSetFromList (filter interesting dst))
+ usage (src, dst) = RU (filter interesting src)
+ (filter interesting dst)
regAddr (AddrRegReg r1 r2) = [r1, r2]
regAddr (AddrRegImm r1 _) = [r1]
regRI (RIReg r) = [r]
regRI _ = []
#endif /* powerpc_TARGET_ARCH */
-\end{code}
-
-
-%************************************************************************
-%* *
-\subsection{Free, reserved, call-clobbered, and argument registers}
-%* *
-%************************************************************************
-
-@freeRegs@ is the list of registers we can use in register allocation.
-@freeReg@ (below) says if a particular register is free.
-
-With a per-instruction clobber list, we might be able to get some of
-these back, but it's probably not worth the hassle.
-
-@callClobberedRegs@ ... the obvious.
-
-@argRegs@: assuming a call with N arguments, what registers will be
-used to hold arguments? (NB: it doesn't know whether the arguments
-are integer or floating-point...)
-
-findReservedRegs tells us which regs can be used as spill temporaries.
-The list of instructions for which we are attempting allocation is
-supplied. This is so that we can (at least for x86) examine it to
-discover which registers are being used in a fixed way -- for example,
-%eax and %edx are used by integer division, so they can't be used as
-spill temporaries. However, most instruction lists don't do integer
-division, so we don't want to rule them out altogether.
-
-findReservedRegs returns not a list of spill temporaries, but a list
-of list of them. This is so that the allocator can attempt allocating
-with at first no spill temps, then if that fails, increasing numbers.
-For x86 it is important that we minimise the number of regs reserved
-as spill temporaries, since there are so few. For Alpha and Sparc
-this isn't a concern; we just ignore the supplied code list and return
-a singleton list which we know will satisfy all spill demands.
-
-\begin{code}
-findReservedRegs :: [Instr] -> [[Reg]]
-findReservedRegs instrs
-#if alpha_TARGET_ARCH
- = --[[NCG_Reserved_I1, NCG_Reserved_I2,
- -- NCG_Reserved_F1, NCG_Reserved_F2]]
- error "findReservedRegs: alpha"
-#endif
-#if sparc_TARGET_ARCH
- = [[NCG_SpillTmp_I1, NCG_SpillTmp_I2,
- NCG_SpillTmp_D1, NCG_SpillTmp_D2,
- NCG_SpillTmp_F1, NCG_SpillTmp_F2]]
-#endif
-#if i386_TARGET_ARCH
- -- We can use %fake4 and %fake5 safely for float temps.
- -- Int regs are more troublesome. Only %ecx and %edx are
- -- definitely. At a pinch, we also could bag %eax if there
- -- are no ccalls, but so far we've never encountered
- -- a situation where three integer temporaries are necessary.
- --
- -- Because registers are in short supply on x86, we give the
- -- allocator a whole bunch of possibilities, starting with zero
- -- temporaries and working up to all that are available. This
- -- is inefficient, but spills are pretty rare, so we don't care
- -- if the register allocator has to try half a dozen or so possibilities
- -- before getting to one that works.
- = let f1 = fake5
- f2 = fake4
- intregs_avail
- = [ecx, edx]
- possibilities
- = case intregs_avail of
- [i1] -> [ [], [i1], [f1], [i1,f1], [f1,f2],
- [i1,f1,f2] ]
-
- [i1,i2] -> [ [], [i1], [f1], [i1,i2], [i1,f1], [f1,f2],
- [i1,i2,f1], [i1,f1,f2], [i1,i2,f1,f2] ]
- in
- possibilities
-#endif
-#if powerpc_TARGET_ARCH
- = [[NCG_SpillTmp_I1, NCG_SpillTmp_I2,
- NCG_SpillTmp_D1, NCG_SpillTmp_D2]]
-#endif
-\end{code}
-
-%************************************************************************
-%* *
-\subsection{@InsnFuture@ type; @insnFuture@ function}
-%* *
-%************************************************************************
-@insnFuture@ indicates the places we could get to following the
-current instruction. This is used by the register allocator to
-compute the flow edges between instructions.
-\begin{code}
-data InsnFuture
- = NoFuture -- makes a non-local jump; for the purposes of
- -- register allocation, it exits our domain
- | Next -- falls through to next insn
- | Branch CLabel -- unconditional branch to the label
- | NextOrBranch CLabel -- conditional branch to the label
- | MultiFuture [CLabel] -- multiple specific futures
+-- -----------------------------------------------------------------------------
+-- Determine the possible destinations from the current instruction.
---instance Outputable InsnFuture where
--- ppr NoFuture = text "NoFuture"
--- ppr Next = text "Next"
--- ppr (Branch clbl) = text "(Branch " <> ppr clbl <> char ')'
--- ppr (NextOrBranch clbl) = text "(NextOrBranch " <> ppr clbl <> char ')'
+-- (we always assume that the next instruction is also a valid destination;
+-- if this isn't the case then the jump should be at the end of the basic
+-- block).
-
-insnFuture insn
- = case insn of
-
-#if alpha_TARGET_ARCH
-
- -- We assume that all local jumps will be BI/BF. JMP must be out-of-line.
-
- BR (ImmCLbl lbl) -> RL (lookup lbl) future
- BI _ _ (ImmCLbl lbl) -> RL (lookup lbl `unionRegSets` live) future
- BF _ _ (ImmCLbl lbl) -> RL (lookup lbl `unionRegSets` live) future
- JMP _ _ _ -> RL emptyRegSet future
- BSR _ _ -> RL live future
- JSR _ _ _ -> RL live future
- LABEL lbl -> RL live (FL (all `unionRegSets` live) (addToFM env lbl live))
- _ -> info
-
-#endif /* alpha_TARGET_ARCH */
--- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+jumpDests :: Instr -> [BlockId] -> [BlockId]
+jumpDests insn acc
+ = case insn of
#if i386_TARGET_ARCH
+ JXX _ id -> id : acc
+ JMP_TBL _ ids -> ids ++ acc
+#elif powerpc_TARGET_ARCH
+ BCC _ id -> id : acc
+ BCTR targets -> targets ++ acc
+#endif
+ _other -> acc
- -- conditional jump
- JXX _ clbl | isAsmTemp clbl -> NextOrBranch clbl
- JXX _ _ -> panic "insnFuture: conditional jump to non-local label"
-
- -- If the insn says what its dests are, use em!
- JMP (DestInfo dsts) _ -> MultiFuture dsts
-
- -- unconditional jump to local label
- JMP NoDestInfo (OpImm (ImmCLbl clbl)) | isAsmTemp clbl -> Branch clbl
-
- -- unconditional jump to non-local label
- JMP NoDestInfo lbl -> NoFuture
-
- -- be extra-paranoid
- JMP _ _ -> panic "insnFuture(x86): JMP wierdness"
-
- boring -> Next
-
-#endif /* i386_TARGET_ARCH */
--- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
-#if sparc_TARGET_ARCH
-
- -- We assume that all local jumps will be BI/BF.
- BI ALWAYS _ (ImmCLbl clbl) -> Branch clbl
- BI other _ (ImmCLbl clbl) -> NextOrBranch clbl
- BI other _ _ -> panic "nativeGen(sparc):insnFuture(BI)"
-
- BF ALWAYS _ (ImmCLbl clbl) -> Branch clbl
- BF other _ (ImmCLbl clbl) -> NextOrBranch clbl
- BF other _ _ -> panic "nativeGen(sparc):insnFuture(BF)"
-
- -- CALL(terminal) must be out-of-line. JMP is not out-of-line
- -- iff it specifies its destinations.
- JMP NoDestInfo _ -> NoFuture -- n.b. NoFuture == MultiFuture []
- JMP (DestInfo dsts) _ -> MultiFuture dsts
-
- CALL _ _ True -> NoFuture
-
- boring -> Next
-#endif /* sparc_TARGET_ARCH */
--- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
-#if powerpc_TARGET_ARCH
- BCC ALWAYS clbl | isAsmTemp clbl -> Branch clbl
- | otherwise -> NoFuture
- BCC _ clbl | isAsmTemp clbl -> NextOrBranch clbl
- BCC _ _ -> panic "insnFuture: conditional jump to non-local label"
-
- BCTR (DestInfo dsts) -> MultiFuture dsts
- BCTR NoDestInfo -> NoFuture
- boring -> Next
-#endif /* powerpc_TARGET_ARCH */
-\end{code}
+-- -----------------------------------------------------------------------------
+-- 'patchRegs' function
-%************************************************************************
-%* *
-\subsection{@patchRegs@ function}
-%* *
-%************************************************************************
+-- 'patchRegs' takes an instruction and applies the given mapping to
+-- all the register references.
-@patchRegs@ takes an instruction (possibly with
-MemoryReg/UnmappedReg registers) and changes all register references
-according to the supplied environment.
-
-\begin{code}
patchRegs :: Instr -> (Reg -> Reg) -> Instr
#if alpha_TARGET_ARCH
MOVSxL sz src dst -> patch2 (MOVSxL sz) src dst
LEA sz src dst -> patch2 (LEA sz) src dst
ADD sz src dst -> patch2 (ADD sz) src dst
+ ADC sz src dst -> patch2 (ADC sz) src dst
SUB sz src dst -> patch2 (SUB sz) src dst
IMUL sz src dst -> patch2 (IMUL sz) src dst
IMUL64 sd1 sd2 -> IMUL64 (env sd1) (env sd2)
MUL sz src dst -> patch2 (MUL sz) src dst
- IQUOT sz src dst -> patch2 (IQUOT sz) src dst
- IREM sz src dst -> patch2 (IREM sz) src dst
- QUOT sz src dst -> patch2 (QUOT sz) src dst
- REM sz src dst -> patch2 (REM sz) src dst
+ IDIV sz op -> patch1 (IDIV sz) op
+ DIV sz op -> patch1 (DIV sz) op
AND sz src dst -> patch2 (AND sz) src dst
OR sz src dst -> patch2 (OR sz) src dst
XOR sz src dst -> patch2 (XOR sz) src dst
PUSH sz op -> patch1 (PUSH sz) op
POP sz op -> patch1 (POP sz) op
SETCC cond op -> patch1 (SETCC cond) op
- JMP dsts op -> patch1 (JMP dsts) op
+ JMP op -> patch1 JMP op
+ JMP_TBL op ids -> patch1 JMP_TBL op $ ids
GMOV src dst -> GMOV (env src) (env dst)
GLD sz src dst -> GLD sz (lookupAddr src) (env dst)
CALL (Left imm) -> instr
CALL (Right reg) -> CALL (Right (env reg))
+ NOP -> instr
COMMENT _ -> instr
- SEGMENT _ -> instr
- LABEL _ -> instr
- ASCII _ _ -> instr
- DATA _ _ -> instr
DELTA _ -> instr
JXX _ _ -> instr
CLTD -> instr
- _ -> pprPanic "patchRegs(x86)" empty
+
+ _other -> panic "patchRegs: unrecognised instr"
where
- patch1 insn op = insn (patchOp op)
- patch2 insn src dst = insn (patchOp src) (patchOp dst)
+ patch1 insn op = insn $! patchOp op
+ patch2 insn src dst = (insn $! patchOp src) $! patchOp dst
patchOp (OpReg reg) = OpReg (env reg)
patchOp (OpImm imm) = OpImm imm
patchRegs instr env = case instr of
LD sz reg addr -> LD sz (env reg) (fixAddr addr)
+ LA sz reg addr -> LA sz (env reg) (fixAddr addr)
ST sz reg addr -> ST sz (env reg) (fixAddr addr)
STU sz reg addr -> STU sz (env reg) (fixAddr addr)
LIS reg imm -> LIS (env reg) imm
CMPL sz reg ri -> CMPL sz (env reg) (fixRI ri)
BCC cond lbl -> BCC cond lbl
MTCTR reg -> MTCTR (env reg)
- BCTR dsts -> BCTR dsts
+ BCTR targets -> BCTR targets
BL imm argRegs -> BL imm argRegs -- argument regs
BCTRL argRegs -> BCTRL argRegs -- cannot be remapped
ADD reg1 reg2 ri -> ADD (env reg1) (env reg2) (fixRI ri)
+ ADDC reg1 reg2 reg3-> ADDC (env reg1) (env reg2) (env reg3)
+ ADDE reg1 reg2 reg3-> ADDE (env reg1) (env reg2) (env reg3)
+ ADDIS reg1 reg2 imm -> ADDIS (env reg1) (env reg2) imm
SUBF reg1 reg2 reg3-> SUBF (env reg1) (env reg2) (env reg3)
MULLW reg1 reg2 ri -> MULLW (env reg1) (env reg2) (fixRI ri)
DIVW reg1 reg2 reg3-> DIVW (env reg1) (env reg2) (env reg3)
DIVWU reg1 reg2 reg3-> DIVWU (env reg1) (env reg2) (env reg3)
+ MULLW_MayOflo reg1 reg2 reg3
+ -> MULLW_MayOflo (env reg1) (env reg2) (env reg3)
AND reg1 reg2 ri -> AND (env reg1) (env reg2) (fixRI ri)
OR reg1 reg2 ri -> OR (env reg1) (env reg2) (fixRI ri)
XOR reg1 reg2 ri -> XOR (env reg1) (env reg2) (fixRI ri)
XORIS reg1 reg2 imm -> XORIS (env reg1) (env reg2) imm
+ EXTS sz reg1 reg2 -> EXTS sz (env reg1) (env reg2)
NEG reg1 reg2 -> NEG (env reg1) (env reg2)
NOT reg1 reg2 -> NOT (env reg1) (env reg2)
SLW reg1 reg2 ri -> SLW (env reg1) (env reg2) (fixRI ri)
SRW reg1 reg2 ri -> SRW (env reg1) (env reg2) (fixRI ri)
SRAW reg1 reg2 ri -> SRAW (env reg1) (env reg2) (fixRI ri)
+ RLWINM reg1 reg2 sh mb me
+ -> RLWINM (env reg1) (env reg2) sh mb me
FADD sz r1 r2 r3 -> FADD sz (env r1) (env r2) (env r3)
FSUB sz r1 r2 r3 -> FSUB sz (env r1) (env r2) (env r3)
FMUL sz r1 r2 r3 -> FMUL sz (env r1) (env r2) (env r3)
FNEG r1 r2 -> FNEG (env r1) (env r2)
FCMP r1 r2 -> FCMP (env r1) (env r2)
FCTIWZ r1 r2 -> FCTIWZ (env r1) (env r2)
+ FRSP r1 r2 -> FRSP (env r1) (env r2)
+ MFCR reg -> MFCR (env reg)
_ -> instr
where
fixAddr (AddrRegReg r1 r2) = AddrRegReg (env r1) (env r2)
fixRI (RIReg r) = RIReg (env r)
fixRI other = other
#endif /* powerpc_TARGET_ARCH */
-\end{code}
-%************************************************************************
-%* *
-\subsection{@spillReg@ and @loadReg@ functions}
-%* *
-%************************************************************************
+-- -----------------------------------------------------------------------------
+-- Detecting reg->reg moves
+
+-- The register allocator attempts to eliminate reg->reg moves whenever it can,
+-- by assigning the src and dest temporaries to the same real register.
+
+isRegRegMove :: Instr -> Maybe (Reg,Reg)
+#ifdef i386_TARGET_ARCH
+-- TMP:
+isRegRegMove (MOV _ (OpReg r1) (OpReg r2)) = Just (r1,r2)
+#elif powerpc_TARGET_ARCH
+isRegRegMove (MR dst src) = Just (src,dst)
+#else
+#warning ToDo: isRegRegMove
+#endif
+isRegRegMove _ = Nothing
+
+-- -----------------------------------------------------------------------------
+-- Generating spill instructions
+
+mkSpillInstr
+ :: Reg -- register to spill (should be a real)
+ -> Int -- current stack delta
+ -> Int -- spill slot to use
+ -> Instr
+mkSpillInstr reg delta slot
+ = ASSERT(isRealReg reg)
+ let
+ off = spillSlotToOffset slot
+ in
+#ifdef alpha_TARGET_ARCH
+ {-Alpha: spill below the stack pointer (?)-}
+ ST sz dyn (spRel (- (off `div` 8)))
+#endif
+#ifdef i386_TARGET_ARCH
+ let off_w = (off-delta) `div` 4
+ in case regClass reg of
+ RcInteger -> MOV I32 (OpReg reg) (OpAddr (spRel off_w))
+ _ -> GST F80 reg (spRel off_w) {- RcFloat/RcDouble -}
+#endif
+#ifdef sparc_TARGET_ARCH
+ {-SPARC: spill below frame pointer leaving 2 words/spill-}
+ let{off_w = 1 + (off `div` 4);
+ sz = case regClass vreg of {
+ RcInteger -> W;
+ RcFloat -> F;
+ RcDouble -> DF}}
+ in ST sz dyn (fpRel (- off_w))
+#endif
+#ifdef powerpc_TARGET_ARCH
+ let sz = case regClass reg of
+ RcInteger -> I32
+ RcDouble -> F64
+ in ST sz reg (AddrRegImm sp (ImmInt (off-delta)))
+#endif
+
-Spill to memory, and load it back...
+mkLoadInstr
+ :: Reg -- register to load (should be a real)
+ -> Int -- current stack delta
+ -> Int -- spill slot to use
+ -> Instr
+mkLoadInstr reg delta slot
+ = ASSERT(isRealReg reg)
+ let
+ off = spillSlotToOffset slot
+ in
+#ifdef alpha_TARGET_ARCH
+ LD sz dyn (spRel (- (off `div` 8)))
+#endif
+#ifdef i386_TARGET_ARCH
+ let off_w = (off-delta) `div` 4
+ in case regClass reg of {
+ RcInteger -> MOV I32 (OpAddr (spRel off_w)) (OpReg reg);
+ _ -> GLD F80 (spRel off_w) reg} {- RcFloat/RcDouble -}
+#endif
+#ifdef sparc_TARGET_ARCH
+ let{off_w = 1 + (off `div` 4);
+ sz = case regClass vreg of {
+ RcInteger -> W;
+ RcFloat -> F;
+ RcDouble -> DF}}
+ in LD sz (fpRel (- off_w)) dyn
+#endif
+#ifdef powerpc_TARGET_ARCH
+ let sz = case regClass reg of
+ RcInteger -> I32
+ RcDouble -> F64
+ in LD sz reg (AddrRegImm sp (ImmInt (off-delta)))
+#endif
-JRS, 000122: on x86, don't spill directly above the stack pointer,
-since some insn sequences (int <-> conversions) use this as a temp
-location. Leave 8 words (ie, 64 bytes for a 64-bit arch) of slop.
-\begin{code}
spillSlotSize :: Int
-spillSlotSize = IF_ARCH_alpha( 8, IF_ARCH_sparc( 8, IF_ARCH_i386( 12, IF_ARCH_powerpc( 8, ))))
+spillSlotSize = IF_ARCH_i386(12, 8)
maxSpillSlots :: Int
maxSpillSlots = ((rESERVED_C_STACK_BYTES - 64) `div` spillSlotSize) - 1
| otherwise
= pprPanic "spillSlotToOffset:"
(text "invalid spill location: " <> int slot)
-
-vregToSpillSlot :: FiniteMap VRegUnique Int -> VRegUnique -> Int
-vregToSpillSlot vreg_to_slot_map u
- = case lookupFM vreg_to_slot_map u of
- Just xx -> xx
- Nothing -> pprPanic "vregToSpillSlot: unmapped vreg" (pprVRegUnique u)
-
-
-spillReg, loadReg :: FiniteMap VRegUnique Int -> Int -> Reg -> Reg -> Instr
-
-spillReg vreg_to_slot_map delta dyn vreg
- | isVirtualReg vreg
- = let slot_no = vregToSpillSlot vreg_to_slot_map (getVRegUnique vreg)
- off = spillSlotToOffset slot_no
- in
- {-Alpha: spill below the stack pointer (?)-}
- IF_ARCH_alpha( ST sz dyn (spRel (- (off `div` 8)))
-
- {-I386: spill above stack pointer leaving 3 words/spill-}
- ,IF_ARCH_i386 ( let off_w = (off-delta) `div` 4
- in case regClass vreg of {
- RcInteger -> MOV L (OpReg dyn) (OpAddr (spRel off_w));
- _ -> GST F80 dyn (spRel off_w)} {- RcFloat/RcDouble -}
-
- {-SPARC: spill below frame pointer leaving 2 words/spill-}
- ,IF_ARCH_sparc(
- let{off_w = 1 + (off `div` 4);
- sz = case regClass vreg of {
- RcInteger -> W;
- RcFloat -> F;
- RcDouble -> DF}}
- in ST sz dyn (fpRel (- off_w))
- ,IF_ARCH_powerpc(
- let{sz = case regClass vreg of {
- RcInteger -> W;
- RcFloat -> F;
- RcDouble -> DF}}
- in ST sz dyn (AddrRegImm sp (ImmInt (off-delta)))
- ,))))
-
-
-loadReg vreg_to_slot_map delta vreg dyn
- | isVirtualReg vreg
- = let slot_no = vregToSpillSlot vreg_to_slot_map (getVRegUnique vreg)
- off = spillSlotToOffset slot_no
- in
- IF_ARCH_alpha( LD sz dyn (spRel (- (off `div` 8)))
-
- ,IF_ARCH_i386 ( let off_w = (off-delta) `div` 4
- in case regClass vreg of {
- RcInteger -> MOV L (OpAddr (spRel off_w)) (OpReg dyn);
- _ -> GLD F80 (spRel off_w) dyn} {- RcFloat/RcDouble -}
-
- ,IF_ARCH_sparc(
- let{off_w = 1 + (off `div` 4);
- sz = case regClass vreg of {
- RcInteger -> W;
- RcFloat -> F;
- RcDouble -> DF}}
- in LD sz (fpRel (- off_w)) dyn
- ,IF_ARCH_powerpc(
- let{sz = case regClass vreg of {
- RcInteger -> W;
- RcFloat -> F;
- RcDouble -> DF}}
- in LD sz dyn (AddrRegImm sp (ImmInt (off-delta)))
- ,))))
-\end{code}
projects / ghc-hetmet.git / blobdiff