X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2FnativeGen%2FAlpha%2FRegInfo.hs;fp=compiler%2FnativeGen%2FAlpha%2FRegInfo.hs;h=7fdde4daf69cb773d354bf80c7d098bd2e0ad647;hb=67136d3a04b96b043328df9d4716d3da7a24a517;hp=0000000000000000000000000000000000000000;hpb=ee6bba6f3d80c56b47bc623bc6e4f076be1f046f;p=ghc-hetmet.git

diff --git a/compiler/nativeGen/Alpha/RegInfo.hs b/compiler/nativeGen/Alpha/RegInfo.hs
new file mode 100644
index 0000000..7fdde4d
--- /dev/null
+++ b/compiler/nativeGen/Alpha/RegInfo.hs
@@ -0,0 +1,218 @@
+
+-----------------------------------------------------------------------------
+--
+-- (c) The University of Glasgow 1996-2004
+--
+-----------------------------------------------------------------------------
+
+module Alpha.RegInfo (
+{-
+	RegUsage(..),
+	noUsage,
+	regUsage,
+	patchRegs,
+	jumpDests,
+	isJumpish,
+	patchJump,
+	isRegRegMove,
+
+        JumpDest, canShortcut, shortcutJump, shortcutStatic,
+
+	maxSpillSlots,
+	mkSpillInstr,
+	mkLoadInstr,
+	mkRegRegMoveInstr,
+	mkBranchInstr
+-}
+)
+
+where
+
+{-
+#include "nativeGen/NCG.h"
+#include "HsVersions.h"
+
+
+import BlockId
+import Cmm
+import CLabel
+import Instrs
+import Regs
+import Outputable
+import Constants	( rESERVED_C_STACK_BYTES )
+import FastBool
+
+data RegUsage = RU [Reg] [Reg]
+
+noUsage :: RegUsage
+noUsage  = RU [] []
+
+regUsage :: Instr -> RegUsage
+
+regUsage instr = case instr of
+    SPILL  reg slot	-> usage ([reg], [])
+    RELOAD slot reg	-> usage ([], [reg])
+    LD B reg addr	-> usage (regAddr addr, [reg, t9])
+    LD Bu reg addr	-> usage (regAddr addr, [reg, t9])
+--  LD W reg addr	-> usage (regAddr addr, [reg, t9]) : UNUSED
+--  LD Wu reg addr	-> usage (regAddr addr, [reg, t9]) : UNUSED
+    LD sz reg addr	-> usage (regAddr addr, [reg])
+    LDA reg addr	-> usage (regAddr addr, [reg])
+    LDAH reg addr	-> usage (regAddr addr, [reg])
+    LDGP reg addr	-> usage (regAddr addr, [reg])
+    LDI sz reg imm	-> usage ([], [reg])
+    ST B reg addr	-> usage (reg : regAddr addr, [t9, t10])
+--  ST W reg addr	-> usage (reg : regAddr addr, [t9, t10]) : UNUSED
+    ST sz reg addr	-> usage (reg : regAddr addr, [])
+    CLR reg		-> usage ([], [reg])
+    ABS sz ri reg	-> usage (regRI ri, [reg])
+    NEG sz ov ri reg	-> usage (regRI ri, [reg])
+    ADD sz ov r1 ar r2	-> usage (r1 : regRI ar, [r2])
+    SADD sz sc r1 ar r2 -> usage (r1 : regRI ar, [r2])
+    SUB sz ov r1 ar r2	-> usage (r1 : regRI ar, [r2])
+    SSUB sz sc r1 ar r2 -> usage (r1 : regRI ar, [r2])
+    MUL sz ov r1 ar r2	-> usage (r1 : regRI ar, [r2])
+    DIV sz un r1 ar r2	-> usage (r1 : regRI ar, [r2, t9, t10, t11, t12])
+    REM sz un r1 ar r2	-> usage (r1 : regRI ar, [r2, t9, t10, t11, t12])
+    NOT ri reg		-> usage (regRI ri, [reg])
+    AND r1 ar r2	-> usage (r1 : regRI ar, [r2])
+    ANDNOT r1 ar r2	-> usage (r1 : regRI ar, [r2])
+    OR r1 ar r2		-> usage (r1 : regRI ar, [r2])
+    ORNOT r1 ar r2	-> usage (r1 : regRI ar, [r2])
+    XOR r1 ar r2	-> usage (r1 : regRI ar, [r2])
+    XORNOT r1 ar r2	-> usage (r1 : regRI ar, [r2])
+    SLL r1 ar r2	-> usage (r1 : regRI ar, [r2])
+    SRL r1 ar r2	-> usage (r1 : regRI ar, [r2])
+    SRA r1 ar r2	-> usage (r1 : regRI ar, [r2])
+    ZAP r1 ar r2	-> usage (r1 : regRI ar, [r2])
+    ZAPNOT r1 ar r2	-> usage (r1 : regRI ar, [r2])
+    CMP co r1 ar r2	-> usage (r1 : regRI ar, [r2])
+    FCLR reg		-> usage ([], [reg])
+    FABS r1 r2		-> usage ([r1], [r2])
+    FNEG sz r1 r2	-> usage ([r1], [r2])
+    FADD sz r1 r2 r3	-> usage ([r1, r2], [r3])
+    FDIV sz r1 r2 r3	-> usage ([r1, r2], [r3])
+    FMUL sz r1 r2 r3	-> usage ([r1, r2], [r3])
+    FSUB sz r1 r2 r3	-> usage ([r1, r2], [r3])
+    CVTxy sz1 sz2 r1 r2 -> usage ([r1], [r2])
+    FCMP sz co r1 r2 r3 -> usage ([r1, r2], [r3])
+    FMOV r1 r2		-> usage ([r1], [r2])
+
+
+    -- We assume that all local jumps will be BI/BF/BR.	 JMP must be out-of-line.
+    BI cond reg lbl	-> usage ([reg], [])
+    BF cond reg lbl	-> usage ([reg], [])
+    JMP reg addr hint	-> RU (mkRegSet (filter interesting (regAddr addr))) freeRegSet
+
+    BSR _ n		-> RU (argRegSet n) callClobberedRegSet
+    JSR reg addr n	-> RU (argRegSet n) callClobberedRegSet
+
+    _			-> noUsage
+
+  where
+    usage (src, dst) = RU (mkRegSet (filter interesting src))
+			  (mkRegSet (filter interesting dst))
+
+    interesting (FixedReg _) = False
+    interesting _ = True
+
+    regAddr (AddrReg r1)      = [r1]
+    regAddr (AddrRegImm r1 _) = [r1]
+    regAddr (AddrImm _)	      = []
+
+    regRI (RIReg r) = [r]
+    regRI  _	= []
+
+
+patchRegs :: Instr -> (Reg -> Reg) -> Instr
+patchRegs instr env = case instr of
+    SPILL  reg slot	-> SPILL (env reg) slot
+    RELOAD slot reg	-> RELOAD slot (env reg)
+    LD sz reg addr -> LD sz (env reg) (fixAddr addr)
+    LDA reg addr -> LDA (env reg) (fixAddr addr)
+    LDAH reg addr -> LDAH (env reg) (fixAddr addr)
+    LDGP reg addr -> LDGP (env reg) (fixAddr addr)
+    LDI sz reg imm -> LDI sz (env reg) imm
+    ST sz reg addr -> ST sz (env reg) (fixAddr addr)
+    CLR reg -> CLR (env reg)
+    ABS sz ar reg -> ABS sz (fixRI ar) (env reg)
+    NEG sz ov ar reg -> NEG sz ov (fixRI ar) (env reg)
+    ADD sz ov r1 ar r2 -> ADD sz ov (env r1) (fixRI ar) (env r2)
+    SADD sz sc r1 ar r2 -> SADD sz sc (env r1) (fixRI ar) (env r2)
+    SUB sz ov r1 ar r2 -> SUB sz ov (env r1) (fixRI ar) (env r2)
+    SSUB sz sc r1 ar r2 -> SSUB sz sc (env r1) (fixRI ar) (env r2)
+    MUL sz ov r1 ar r2 -> MUL sz ov (env r1) (fixRI ar) (env r2)
+    DIV sz un r1 ar r2 -> DIV sz un (env r1) (fixRI ar) (env r2)
+    REM sz un r1 ar r2 -> REM sz un (env r1) (fixRI ar) (env r2)
+    NOT ar reg -> NOT (fixRI ar) (env reg)
+    AND r1 ar r2 -> AND (env r1) (fixRI ar) (env r2)
+    ANDNOT r1 ar r2 -> ANDNOT (env r1) (fixRI ar) (env r2)
+    OR r1 ar r2 -> OR (env r1) (fixRI ar) (env r2)
+    ORNOT r1 ar r2 -> ORNOT (env r1) (fixRI ar) (env r2)
+    XOR r1 ar r2 -> XOR (env r1) (fixRI ar) (env r2)
+    XORNOT r1 ar r2 -> XORNOT (env r1) (fixRI ar) (env r2)
+    SLL r1 ar r2 -> SLL (env r1) (fixRI ar) (env r2)
+    SRL r1 ar r2 -> SRL (env r1) (fixRI ar) (env r2)
+    SRA r1 ar r2 -> SRA (env r1) (fixRI ar) (env r2)
+    ZAP r1 ar r2 -> ZAP (env r1) (fixRI ar) (env r2)
+    ZAPNOT r1 ar r2 -> ZAPNOT (env r1) (fixRI ar) (env r2)
+    CMP co r1 ar r2 -> CMP co (env r1) (fixRI ar) (env r2)
+    FCLR reg -> FCLR (env reg)
+    FABS r1 r2 -> FABS (env r1) (env r2)
+    FNEG s r1 r2 -> FNEG s (env r1) (env r2)
+    FADD s r1 r2 r3 -> FADD s (env r1) (env r2) (env r3)
+    FDIV s r1 r2 r3 -> FDIV s (env r1) (env r2) (env r3)
+    FMUL s r1 r2 r3 -> FMUL s (env r1) (env r2) (env r3)
+    FSUB s r1 r2 r3 -> FSUB s (env r1) (env r2) (env r3)
+    CVTxy s1 s2 r1 r2 -> CVTxy s1 s2 (env r1) (env r2)
+    FCMP s co r1 r2 r3 -> FCMP s co (env r1) (env r2) (env r3)
+    FMOV r1 r2 -> FMOV (env r1) (env r2)
+    BI cond reg lbl -> BI cond (env reg) lbl
+    BF cond reg lbl -> BF cond (env reg) lbl
+    JMP reg addr hint -> JMP (env reg) (fixAddr addr) hint
+    JSR reg addr i -> JSR (env reg) (fixAddr addr) i
+    _ -> instr
+  where
+    fixAddr (AddrReg r1)       = AddrReg (env r1)
+    fixAddr (AddrRegImm r1 i)  = AddrRegImm (env r1) i
+    fixAddr other	       = other
+
+    fixRI (RIReg r) = RIReg (env r)
+    fixRI other	= other
+
+
+mkSpillInstr
+   :: Reg		-- register to spill
+   -> Int		-- current stack delta
+   -> Int		-- spill slot to use
+   -> Instr
+
+mkSpillInstr reg delta slot
+  = let	off     = spillSlotToOffset slot
+    in
+    -- Alpha: spill below the stack pointer (?)
+    ST sz dyn (spRel (- (off `div` 8)))
+
+
+mkLoadInstr
+   :: Reg		-- register to load
+   -> Int		-- current stack delta
+   -> Int		-- spill slot to use
+   -> Instr
+mkLoadInstr reg delta slot
+  = let off     = spillSlotToOffset slot
+    in
+	 LD  sz dyn (spRel (- (off `div` 8)))
+
+
+mkBranchInstr
+    :: BlockId
+    -> [Instr]
+
+mkBranchInstr id = [BR id]
+
+-}
+
+
+
+