    -----------------------------------------------------------------------------
    --
    -- (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]

    -}