compiler/nativeGen/Alpha/RegInfo.hs

   1
   2 -----------------------------------------------------------------------------
   3 --
   4 -- (c) The University of Glasgow 1996-2004
   5 --
   6 -----------------------------------------------------------------------------
   7
   8 module Alpha.RegInfo (
   9 {-
  10         RegUsage(..),
  11         noUsage,
  12         regUsage,
  13         patchRegs,
  14         jumpDests,
  15         isJumpish,
  16         patchJump,
  17         isRegRegMove,
  18
  19         JumpDest, canShortcut, shortcutJump, shortcutStatic,
  20
  21         maxSpillSlots,
  22         mkSpillInstr,
  23         mkLoadInstr,
  24         mkRegRegMoveInstr,
  25         mkBranchInstr
  26 -}
  27 )
  28
  29 where
  30
  31 {-
  32 #include "nativeGen/NCG.h"
  33 #include "HsVersions.h"
  34
  35
  36 import BlockId
  37 import Cmm
  38 import CLabel
  39 import Instrs
  40 import Regs
  41 import Outputable
  42 import Constants        ( rESERVED_C_STACK_BYTES )
  43 import FastBool
  44
  45 data RegUsage = RU [Reg] [Reg]
  46
  47 noUsage :: RegUsage
  48 noUsage  = RU [] []
  49
  50 regUsage :: Instr -> RegUsage
  51
  52 regUsage instr = case instr of
  53     SPILL  reg slot     -> usage ([reg], [])
  54     RELOAD slot reg     -> usage ([], [reg])
  55     LD B reg addr       -> usage (regAddr addr, [reg, t9])
  56     LD Bu reg addr      -> usage (regAddr addr, [reg, t9])
  57 --  LD W reg addr       -> usage (regAddr addr, [reg, t9]) : UNUSED
  58 --  LD Wu reg addr      -> usage (regAddr addr, [reg, t9]) : UNUSED
  59     LD sz reg addr      -> usage (regAddr addr, [reg])
  60     LDA reg addr        -> usage (regAddr addr, [reg])
  61     LDAH reg addr       -> usage (regAddr addr, [reg])
  62     LDGP reg addr       -> usage (regAddr addr, [reg])
  63     LDI sz reg imm      -> usage ([], [reg])
  64     ST B reg addr       -> usage (reg : regAddr addr, [t9, t10])
  65 --  ST W reg addr       -> usage (reg : regAddr addr, [t9, t10]) : UNUSED
  66     ST sz reg addr      -> usage (reg : regAddr addr, [])
  67     CLR reg             -> usage ([], [reg])
  68     ABS sz ri reg       -> usage (regRI ri, [reg])
  69     NEG sz ov ri reg    -> usage (regRI ri, [reg])
  70     ADD sz ov r1 ar r2  -> usage (r1 : regRI ar, [r2])
  71     SADD sz sc r1 ar r2 -> usage (r1 : regRI ar, [r2])
  72     SUB sz ov r1 ar r2  -> usage (r1 : regRI ar, [r2])
  73     SSUB sz sc r1 ar r2 -> usage (r1 : regRI ar, [r2])
  74     MUL sz ov r1 ar r2  -> usage (r1 : regRI ar, [r2])
  75     DIV sz un r1 ar r2  -> usage (r1 : regRI ar, [r2, t9, t10, t11, t12])
  76     REM sz un r1 ar r2  -> usage (r1 : regRI ar, [r2, t9, t10, t11, t12])
  77     NOT ri reg          -> usage (regRI ri, [reg])
  78     AND r1 ar r2        -> usage (r1 : regRI ar, [r2])
  79     ANDNOT r1 ar r2     -> usage (r1 : regRI ar, [r2])
  80     OR r1 ar r2         -> usage (r1 : regRI ar, [r2])
  81     ORNOT r1 ar r2      -> usage (r1 : regRI ar, [r2])
  82     XOR r1 ar r2        -> usage (r1 : regRI ar, [r2])
  83     XORNOT r1 ar r2     -> usage (r1 : regRI ar, [r2])
  84     SLL r1 ar r2        -> usage (r1 : regRI ar, [r2])
  85     SRL r1 ar r2        -> usage (r1 : regRI ar, [r2])
  86     SRA r1 ar r2        -> usage (r1 : regRI ar, [r2])
  87     ZAP r1 ar r2        -> usage (r1 : regRI ar, [r2])
  88     ZAPNOT r1 ar r2     -> usage (r1 : regRI ar, [r2])
  89     CMP co r1 ar r2     -> usage (r1 : regRI ar, [r2])
  90     FCLR reg            -> usage ([], [reg])
  91     FABS r1 r2          -> usage ([r1], [r2])
  92     FNEG sz r1 r2       -> usage ([r1], [r2])
  93     FADD sz r1 r2 r3    -> usage ([r1, r2], [r3])
  94     FDIV sz r1 r2 r3    -> usage ([r1, r2], [r3])
  95     FMUL sz r1 r2 r3    -> usage ([r1, r2], [r3])
  96     FSUB sz r1 r2 r3    -> usage ([r1, r2], [r3])
  97     CVTxy sz1 sz2 r1 r2 -> usage ([r1], [r2])
  98     FCMP sz co r1 r2 r3 -> usage ([r1, r2], [r3])
  99     FMOV r1 r2          -> usage ([r1], [r2])
 100
 101
 102     -- We assume that all local jumps will be BI/BF/BR.  JMP must be out-of-line.
 103     BI cond reg lbl     -> usage ([reg], [])
 104     BF cond reg lbl     -> usage ([reg], [])
 105     JMP reg addr hint   -> RU (mkRegSet (filter interesting (regAddr addr))) freeRegSet
 106
 107     BSR _ n             -> RU (argRegSet n) callClobberedRegSet
 108     JSR reg addr n      -> RU (argRegSet n) callClobberedRegSet
 109
 110     _                   -> noUsage
 111
 112   where
 113     usage (src, dst) = RU (mkRegSet (filter interesting src))
 114                           (mkRegSet (filter interesting dst))
 115
 116     interesting (FixedReg _) = False
 117     interesting _ = True
 118
 119     regAddr (AddrReg r1)      = [r1]
 120     regAddr (AddrRegImm r1 _) = [r1]
 121     regAddr (AddrImm _)       = []
 122
 123     regRI (RIReg r) = [r]
 124     regRI  _    = []
 125
 126
 127 patchRegs :: Instr -> (Reg -> Reg) -> Instr
 128 patchRegs instr env = case instr of
 129     SPILL  reg slot     -> SPILL (env reg) slot
 130     RELOAD slot reg     -> RELOAD slot (env reg)
 131     LD sz reg addr -> LD sz (env reg) (fixAddr addr)
 132     LDA reg addr -> LDA (env reg) (fixAddr addr)
 133     LDAH reg addr -> LDAH (env reg) (fixAddr addr)
 134     LDGP reg addr -> LDGP (env reg) (fixAddr addr)
 135     LDI sz reg imm -> LDI sz (env reg) imm
 136     ST sz reg addr -> ST sz (env reg) (fixAddr addr)
 137     CLR reg -> CLR (env reg)
 138     ABS sz ar reg -> ABS sz (fixRI ar) (env reg)
 139     NEG sz ov ar reg -> NEG sz ov (fixRI ar) (env reg)
 140     ADD sz ov r1 ar r2 -> ADD sz ov (env r1) (fixRI ar) (env r2)
 141     SADD sz sc r1 ar r2 -> SADD sz sc (env r1) (fixRI ar) (env r2)
 142     SUB sz ov r1 ar r2 -> SUB sz ov (env r1) (fixRI ar) (env r2)
 143     SSUB sz sc r1 ar r2 -> SSUB sz sc (env r1) (fixRI ar) (env r2)
 144     MUL sz ov r1 ar r2 -> MUL sz ov (env r1) (fixRI ar) (env r2)
 145     DIV sz un r1 ar r2 -> DIV sz un (env r1) (fixRI ar) (env r2)
 146     REM sz un r1 ar r2 -> REM sz un (env r1) (fixRI ar) (env r2)
 147     NOT ar reg -> NOT (fixRI ar) (env reg)
 148     AND r1 ar r2 -> AND (env r1) (fixRI ar) (env r2)
 149     ANDNOT r1 ar r2 -> ANDNOT (env r1) (fixRI ar) (env r2)
 150     OR r1 ar r2 -> OR (env r1) (fixRI ar) (env r2)
 151     ORNOT r1 ar r2 -> ORNOT (env r1) (fixRI ar) (env r2)
 152     XOR r1 ar r2 -> XOR (env r1) (fixRI ar) (env r2)
 153     XORNOT r1 ar r2 -> XORNOT (env r1) (fixRI ar) (env r2)
 154     SLL r1 ar r2 -> SLL (env r1) (fixRI ar) (env r2)
 155     SRL r1 ar r2 -> SRL (env r1) (fixRI ar) (env r2)
 156     SRA r1 ar r2 -> SRA (env r1) (fixRI ar) (env r2)
 157     ZAP r1 ar r2 -> ZAP (env r1) (fixRI ar) (env r2)
 158     ZAPNOT r1 ar r2 -> ZAPNOT (env r1) (fixRI ar) (env r2)
 159     CMP co r1 ar r2 -> CMP co (env r1) (fixRI ar) (env r2)
 160     FCLR reg -> FCLR (env reg)
 161     FABS r1 r2 -> FABS (env r1) (env r2)
 162     FNEG s r1 r2 -> FNEG s (env r1) (env r2)
 163     FADD s r1 r2 r3 -> FADD s (env r1) (env r2) (env r3)
 164     FDIV s r1 r2 r3 -> FDIV s (env r1) (env r2) (env r3)
 165     FMUL s r1 r2 r3 -> FMUL s (env r1) (env r2) (env r3)
 166     FSUB s r1 r2 r3 -> FSUB s (env r1) (env r2) (env r3)
 167     CVTxy s1 s2 r1 r2 -> CVTxy s1 s2 (env r1) (env r2)
 168     FCMP s co r1 r2 r3 -> FCMP s co (env r1) (env r2) (env r3)
 169     FMOV r1 r2 -> FMOV (env r1) (env r2)
 170     BI cond reg lbl -> BI cond (env reg) lbl
 171     BF cond reg lbl -> BF cond (env reg) lbl
 172     JMP reg addr hint -> JMP (env reg) (fixAddr addr) hint
 173     JSR reg addr i -> JSR (env reg) (fixAddr addr) i
 174     _ -> instr
 175   where
 176     fixAddr (AddrReg r1)       = AddrReg (env r1)
 177     fixAddr (AddrRegImm r1 i)  = AddrRegImm (env r1) i
 178     fixAddr other              = other
 179
 180     fixRI (RIReg r) = RIReg (env r)
 181     fixRI other = other
 182
 183
 184 mkSpillInstr
 185    :: Reg               -- register to spill
 186    -> Int               -- current stack delta
 187    -> Int               -- spill slot to use
 188    -> Instr
 189
 190 mkSpillInstr reg delta slot
 191   = let off     = spillSlotToOffset slot
 192     in
 193     -- Alpha: spill below the stack pointer (?)
 194     ST sz dyn (spRel (- (off `div` 8)))
 195
 196
 197 mkLoadInstr
 198    :: Reg               -- register to load
 199    -> Int               -- current stack delta
 200    -> Int               -- spill slot to use
 201    -> Instr
 202 mkLoadInstr reg delta slot
 203   = let off     = spillSlotToOffset slot
 204     in
 205          LD  sz dyn (spRel (- (off `div` 8)))
 206
 207
 208 mkBranchInstr
 209     :: BlockId
 210     -> [Instr]
 211
 212 mkBranchInstr id = [BR id]
 213
 214 -}
 215
 216
 217
 218