ghc/compiler/nativeGen/RegAllocInfo.hs

   1 -----------------------------------------------------------------------------
   2 --
   3 -- Machine-specific parts of the register allocator
   4 --
   5 -- (c) The University of Glasgow 1996-2004
   6 --
   7 -----------------------------------------------------------------------------
   8
   9 #include "nativeGen/NCG.h"
  10
  11 module RegAllocInfo (
  12         RegUsage(..),
  13         noUsage,
  14         regUsage,
  15         patchRegs,
  16         jumpDests,
  17         isRegRegMove,
  18
  19         maxSpillSlots,
  20         mkSpillInstr,
  21         mkLoadInstr,
  22     ) where
  23
  24 #include "HsVersions.h"
  25
  26 import Cmm              ( BlockId )
  27 #if powerpc_TARGET_ARCH || i386_TARGET_ARCH || x86_64_TARGET_ARCH || sparc_TARGET_ARCH
  28 import MachOp           ( MachRep(..) )
  29 #endif
  30 import MachInstrs
  31 import MachRegs
  32 import Outputable
  33 import Constants        ( rESERVED_C_STACK_BYTES )
  34 import FastTypes
  35
  36 -- -----------------------------------------------------------------------------
  37 -- RegUsage type
  38
  39 -- @regUsage@ returns the sets of src and destination registers used
  40 -- by a particular instruction.  Machine registers that are
  41 -- pre-allocated to stgRegs are filtered out, because they are
  42 -- uninteresting from a register allocation standpoint.  (We wouldn't
  43 -- want them to end up on the free list!)  As far as we are concerned,
  44 -- the fixed registers simply don't exist (for allocation purposes,
  45 -- anyway).
  46
  47 -- regUsage doesn't need to do any trickery for jumps and such.  Just
  48 -- state precisely the regs read and written by that insn.  The
  49 -- consequences of control flow transfers, as far as register
  50 -- allocation goes, are taken care of by the register allocator.
  51
  52 data RegUsage = RU [Reg] [Reg]
  53
  54 noUsage :: RegUsage
  55 noUsage  = RU [] []
  56
  57 regUsage :: Instr -> RegUsage
  58
  59 interesting (VirtualRegI  _)  = True
  60 interesting (VirtualRegHi _)  = True
  61 interesting (VirtualRegF  _)  = True
  62 interesting (VirtualRegD  _)  = True
  63 interesting (RealReg i)       = isFastTrue (freeReg i)
  64
  65
  66 #if alpha_TARGET_ARCH
  67 regUsage instr = case instr of
  68     LD B reg addr       -> usage (regAddr addr, [reg, t9])
  69     LD Bu reg addr      -> usage (regAddr addr, [reg, t9])
  70 --  LD W reg addr       -> usage (regAddr addr, [reg, t9]) : UNUSED
  71 --  LD Wu reg addr      -> usage (regAddr addr, [reg, t9]) : UNUSED
  72     LD sz reg addr      -> usage (regAddr addr, [reg])
  73     LDA reg addr        -> usage (regAddr addr, [reg])
  74     LDAH reg addr       -> usage (regAddr addr, [reg])
  75     LDGP reg addr       -> usage (regAddr addr, [reg])
  76     LDI sz reg imm      -> usage ([], [reg])
  77     ST B reg addr       -> usage (reg : regAddr addr, [t9, t10])
  78 --  ST W reg addr       -> usage (reg : regAddr addr, [t9, t10]) : UNUSED
  79     ST sz reg addr      -> usage (reg : regAddr addr, [])
  80     CLR reg             -> usage ([], [reg])
  81     ABS sz ri reg       -> usage (regRI ri, [reg])
  82     NEG sz ov ri reg    -> usage (regRI ri, [reg])
  83     ADD sz ov r1 ar r2  -> usage (r1 : regRI ar, [r2])
  84     SADD sz sc r1 ar r2 -> usage (r1 : regRI ar, [r2])
  85     SUB sz ov r1 ar r2  -> usage (r1 : regRI ar, [r2])
  86     SSUB sz sc r1 ar r2 -> usage (r1 : regRI ar, [r2])
  87     MUL sz ov r1 ar r2  -> usage (r1 : regRI ar, [r2])
  88     DIV sz un r1 ar r2  -> usage (r1 : regRI ar, [r2, t9, t10, t11, t12])
  89     REM sz un r1 ar r2  -> usage (r1 : regRI ar, [r2, t9, t10, t11, t12])
  90     NOT ri reg          -> usage (regRI ri, [reg])
  91     AND r1 ar r2        -> usage (r1 : regRI ar, [r2])
  92     ANDNOT r1 ar r2     -> usage (r1 : regRI ar, [r2])
  93     OR r1 ar r2         -> usage (r1 : regRI ar, [r2])
  94     ORNOT r1 ar r2      -> usage (r1 : regRI ar, [r2])
  95     XOR r1 ar r2        -> usage (r1 : regRI ar, [r2])
  96     XORNOT r1 ar r2     -> usage (r1 : regRI ar, [r2])
  97     SLL r1 ar r2        -> usage (r1 : regRI ar, [r2])
  98     SRL r1 ar r2        -> usage (r1 : regRI ar, [r2])
  99     SRA r1 ar r2        -> usage (r1 : regRI ar, [r2])
 100     ZAP r1 ar r2        -> usage (r1 : regRI ar, [r2])
 101     ZAPNOT r1 ar r2     -> usage (r1 : regRI ar, [r2])
 102     CMP co r1 ar r2     -> usage (r1 : regRI ar, [r2])
 103     FCLR reg            -> usage ([], [reg])
 104     FABS r1 r2          -> usage ([r1], [r2])
 105     FNEG sz r1 r2       -> usage ([r1], [r2])
 106     FADD sz r1 r2 r3    -> usage ([r1, r2], [r3])
 107     FDIV sz r1 r2 r3    -> usage ([r1, r2], [r3])
 108     FMUL sz r1 r2 r3    -> usage ([r1, r2], [r3])
 109     FSUB sz r1 r2 r3    -> usage ([r1, r2], [r3])
 110     CVTxy sz1 sz2 r1 r2 -> usage ([r1], [r2])
 111     FCMP sz co r1 r2 r3 -> usage ([r1, r2], [r3])
 112     FMOV r1 r2          -> usage ([r1], [r2])
 113
 114
 115     -- We assume that all local jumps will be BI/BF/BR.  JMP must be out-of-line.
 116     BI cond reg lbl     -> usage ([reg], [])
 117     BF cond reg lbl     -> usage ([reg], [])
 118     JMP reg addr hint   -> RU (mkRegSet (filter interesting (regAddr addr))) freeRegSet
 119
 120     BSR _ n             -> RU (argRegSet n) callClobberedRegSet
 121     JSR reg addr n      -> RU (argRegSet n) callClobberedRegSet
 122
 123     _                   -> noUsage
 124
 125   where
 126     usage (src, dst) = RU (mkRegSet (filter interesting src))
 127                           (mkRegSet (filter interesting dst))
 128
 129     interesting (FixedReg _) = False
 130     interesting _ = True
 131
 132     regAddr (AddrReg r1)      = [r1]
 133     regAddr (AddrRegImm r1 _) = [r1]
 134     regAddr (AddrImm _)       = []
 135
 136     regRI (RIReg r) = [r]
 137     regRI  _    = []
 138
 139 #endif /* alpha_TARGET_ARCH */
 140 -- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
 141 #if i386_TARGET_ARCH || x86_64_TARGET_ARCH
 142
 143 regUsage instr = case instr of
 144     MOV    sz src dst   -> usageRW src dst
 145     MOVZxL sz src dst   -> usageRW src dst
 146     MOVSxL sz src dst   -> usageRW src dst
 147     LEA    sz src dst   -> usageRW src dst
 148     ADD    sz src dst   -> usageRM src dst
 149     ADC    sz src dst   -> usageRM src dst
 150     SUB    sz src dst   -> usageRM src dst
 151     IMUL   sz src dst   -> usageRM src dst
 152     IMUL2  sz src       -> mkRU (eax:use_R src) [eax,edx]
 153     MUL    sz src dst   -> usageRM src dst
 154     DIV    sz op        -> mkRU (eax:edx:use_R op) [eax,edx]
 155     IDIV   sz op        -> mkRU (eax:edx:use_R op) [eax,edx]
 156     AND    sz src dst   -> usageRM src dst
 157     OR     sz src dst   -> usageRM src dst
 158     XOR    sz src dst   -> usageRM src dst
 159     NOT    sz op        -> usageM op
 160     NEGI   sz op        -> usageM op
 161     SHL    sz imm dst   -> usageRM imm dst
 162     SAR    sz imm dst   -> usageRM imm dst
 163     SHR    sz imm dst   -> usageRM imm dst
 164     BT     sz imm src   -> mkRUR (use_R src)
 165
 166     PUSH   sz op        -> mkRUR (use_R op)
 167     POP    sz op        -> mkRU [] (def_W op)
 168     TEST   sz src dst   -> mkRUR (use_R src ++ use_R dst)
 169     CMP    sz src dst   -> mkRUR (use_R src ++ use_R dst)
 170     SETCC  cond op      -> mkRU [] (def_W op)
 171     JXX    cond lbl     -> mkRU [] []
 172     JMP    op           -> mkRUR (use_R op)
 173     JMP_TBL op ids      -> mkRUR (use_R op)
 174     CALL (Left imm)  params -> mkRU params callClobberedRegs
 175     CALL (Right reg) params -> mkRU (reg:params) callClobberedRegs
 176     CLTD   sz           -> mkRU [eax] [edx]
 177     NOP                 -> mkRU [] []
 178
 179 #if i386_TARGET_ARCH
 180     GMOV   src dst      -> mkRU [src] [dst]
 181     GLD    sz src dst   -> mkRU (use_EA src) [dst]
 182     GST    sz src dst   -> mkRUR (src : use_EA dst)
 183
 184     GLDZ   dst          -> mkRU [] [dst]
 185     GLD1   dst          -> mkRU [] [dst]
 186
 187     GFTOI  src dst      -> mkRU [src] [dst]
 188     GDTOI  src dst      -> mkRU [src] [dst]
 189
 190     GITOF  src dst      -> mkRU [src] [dst]
 191     GITOD  src dst      -> mkRU [src] [dst]
 192
 193     GADD   sz s1 s2 dst -> mkRU [s1,s2] [dst]
 194     GSUB   sz s1 s2 dst -> mkRU [s1,s2] [dst]
 195     GMUL   sz s1 s2 dst -> mkRU [s1,s2] [dst]
 196     GDIV   sz s1 s2 dst -> mkRU [s1,s2] [dst]
 197
 198     GCMP   sz src1 src2 -> mkRUR [src1,src2]
 199     GABS   sz src dst   -> mkRU [src] [dst]
 200     GNEG   sz src dst   -> mkRU [src] [dst]
 201     GSQRT  sz src dst   -> mkRU [src] [dst]
 202     GSIN   sz src dst   -> mkRU [src] [dst]
 203     GCOS   sz src dst   -> mkRU [src] [dst]
 204     GTAN   sz src dst   -> mkRU [src] [dst]
 205 #endif
 206
 207 #if x86_64_TARGET_ARCH
 208     CVTSS2SD src dst    -> mkRU [src] [dst]
 209     CVTSD2SS src dst    -> mkRU [src] [dst]
 210     CVTSS2SI src dst    -> mkRU (use_R src) [dst]
 211     CVTSD2SI src dst    -> mkRU (use_R src) [dst]
 212     CVTSI2SS src dst    -> mkRU (use_R src) [dst]
 213     CVTSI2SD src dst    -> mkRU (use_R src) [dst]
 214     FDIV sz src dst     -> usageRM src dst
 215 #endif
 216
 217     FETCHGOT reg        -> mkRU [] [reg]
 218     FETCHPC  reg        -> mkRU [] [reg]
 219
 220     COMMENT _           -> noUsage
 221     DELTA   _           -> noUsage
 222
 223     _other              -> panic "regUsage: unrecognised instr"
 224
 225  where
 226 #if x86_64_TARGET_ARCH
 227         -- call parameters: include %eax, because it is used
 228         -- to pass the number of SSE reg arguments to varargs fns.
 229     params = eax : allArgRegs ++ allFPArgRegs
 230 #endif
 231
 232     -- 2 operand form; first operand Read; second Written
 233     usageRW :: Operand -> Operand -> RegUsage
 234     usageRW op (OpReg reg) = mkRU (use_R op) [reg]
 235     usageRW op (OpAddr ea) = mkRUR (use_R op ++ use_EA ea)
 236
 237     -- 2 operand form; first operand Read; second Modified
 238     usageRM :: Operand -> Operand -> RegUsage
 239     usageRM op (OpReg reg) = mkRU (use_R op ++ [reg]) [reg]
 240     usageRM op (OpAddr ea) = mkRUR (use_R op ++ use_EA ea)
 241
 242     -- 1 operand form; operand Modified
 243     usageM :: Operand -> RegUsage
 244     usageM (OpReg reg)    = mkRU [reg] [reg]
 245     usageM (OpAddr ea)    = mkRUR (use_EA ea)
 246
 247     -- Registers defd when an operand is written.
 248     def_W (OpReg reg)  = [reg]
 249     def_W (OpAddr ea)  = []
 250
 251     -- Registers used when an operand is read.
 252     use_R (OpReg reg)  = [reg]
 253     use_R (OpImm imm)  = []
 254     use_R (OpAddr ea)  = use_EA ea
 255
 256     -- Registers used to compute an effective address.
 257     use_EA (ImmAddr _ _) = []
 258     use_EA (AddrBaseIndex base index _) =
 259         use_base base $! use_index index
 260         where use_base (EABaseReg r) x = r : x
 261               use_base _ x             = x
 262               use_index EAIndexNone   = []
 263               use_index (EAIndex i _) = [i]
 264
 265     mkRUR src = src' `seq` RU src' []
 266         where src' = filter interesting src
 267
 268     mkRU src dst = src' `seq` dst' `seq` RU src' dst'
 269         where src' = filter interesting src
 270               dst' = filter interesting dst
 271
 272 #endif /* i386_TARGET_ARCH || x86_64_TARGET_ARCH */
 273 -- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
 274 #if sparc_TARGET_ARCH
 275
 276 regUsage instr = case instr of
 277     LD    sz addr reg   -> usage (regAddr addr, [reg])
 278     ST    sz reg addr   -> usage (reg : regAddr addr, [])
 279     ADD   x cc r1 ar r2 -> usage (r1 : regRI ar, [r2])
 280     SUB   x cc r1 ar r2 -> usage (r1 : regRI ar, [r2])
 281     UMUL    cc r1 ar r2 -> usage (r1 : regRI ar, [r2])
 282     SMUL    cc r1 ar r2 -> usage (r1 : regRI ar, [r2])
 283     RDY   rd            -> usage ([], [rd])
 284     AND   b r1 ar r2    -> usage (r1 : regRI ar, [r2])
 285     ANDN  b r1 ar r2    -> usage (r1 : regRI ar, [r2])
 286     OR    b r1 ar r2    -> usage (r1 : regRI ar, [r2])
 287     ORN   b r1 ar r2    -> usage (r1 : regRI ar, [r2])
 288     XOR   b r1 ar r2    -> usage (r1 : regRI ar, [r2])
 289     XNOR  b r1 ar r2    -> usage (r1 : regRI ar, [r2])
 290     SLL   r1 ar r2      -> usage (r1 : regRI ar, [r2])
 291     SRL   r1 ar r2      -> usage (r1 : regRI ar, [r2])
 292     SRA   r1 ar r2      -> usage (r1 : regRI ar, [r2])
 293     SETHI imm reg       -> usage ([], [reg])
 294     FABS  s r1 r2       -> usage ([r1], [r2])
 295     FADD  s r1 r2 r3    -> usage ([r1, r2], [r3])
 296     FCMP  e s r1 r2     -> usage ([r1, r2], [])
 297     FDIV  s r1 r2 r3    -> usage ([r1, r2], [r3])
 298     FMOV  s r1 r2       -> usage ([r1], [r2])
 299     FMUL  s r1 r2 r3    -> usage ([r1, r2], [r3])
 300     FNEG  s r1 r2       -> usage ([r1], [r2])
 301     FSQRT s r1 r2       -> usage ([r1], [r2])
 302     FSUB  s r1 r2 r3    -> usage ([r1, r2], [r3])
 303     FxTOy s1 s2 r1 r2   -> usage ([r1], [r2])
 304
 305     -- We assume that all local jumps will be BI/BF.  JMP must be out-of-line.
 306     JMP   addr          -> usage (regAddr addr, [])
 307
 308     CALL  (Left imm)  n True  -> noUsage
 309     CALL  (Left imm)  n False -> usage (argRegs n, callClobberedRegs)
 310     CALL  (Right reg) n True  -> usage ([reg], [])
 311     CALL  (Right reg) n False -> usage (reg : (argRegs n), callClobberedRegs)
 312
 313     _                   -> noUsage
 314   where
 315     usage (src, dst) = RU (filter interesting src)
 316                          (filter interesting dst)
 317
 318     regAddr (AddrRegReg r1 r2) = [r1, r2]
 319     regAddr (AddrRegImm r1 _)  = [r1]
 320
 321     regRI (RIReg r) = [r]
 322     regRI  _    = []
 323
 324 #endif /* sparc_TARGET_ARCH */
 325 -- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
 326 #if powerpc_TARGET_ARCH
 327
 328 regUsage instr = case instr of
 329     LD    sz reg addr   -> usage (regAddr addr, [reg])
 330     LA    sz reg addr   -> usage (regAddr addr, [reg])
 331     ST    sz reg addr   -> usage (reg : regAddr addr, [])
 332     STU    sz reg addr  -> usage (reg : regAddr addr, [])
 333     LIS   reg imm       -> usage ([], [reg])
 334     LI    reg imm       -> usage ([], [reg])
 335     MR    reg1 reg2     -> usage ([reg2], [reg1])
 336     CMP   sz reg ri     -> usage (reg : regRI ri,[])
 337     CMPL  sz reg ri     -> usage (reg : regRI ri,[])
 338     BCC   cond lbl      -> noUsage
 339     MTCTR reg           -> usage ([reg],[])
 340     BCTR  targets       -> noUsage
 341     BL    imm params    -> usage (params, callClobberedRegs)
 342     BCTRL params        -> usage (params, callClobberedRegs)
 343     ADD   reg1 reg2 ri  -> usage (reg2 : regRI ri, [reg1])
 344     ADDC  reg1 reg2 reg3-> usage ([reg2,reg3], [reg1])
 345     ADDE  reg1 reg2 reg3-> usage ([reg2,reg3], [reg1])
 346     ADDIS reg1 reg2 imm -> usage ([reg2], [reg1])
 347     SUBF  reg1 reg2 reg3-> usage ([reg2,reg3], [reg1])
 348     MULLW reg1 reg2 ri  -> usage (reg2 : regRI ri, [reg1])
 349     DIVW  reg1 reg2 reg3-> usage ([reg2,reg3], [reg1])
 350     DIVWU reg1 reg2 reg3-> usage ([reg2,reg3], [reg1])
 351     MULLW_MayOflo reg1 reg2 reg3
 352                         -> usage ([reg2,reg3], [reg1])
 353     AND   reg1 reg2 ri  -> usage (reg2 : regRI ri, [reg1])
 354     OR    reg1 reg2 ri  -> usage (reg2 : regRI ri, [reg1])
 355     XOR   reg1 reg2 ri  -> usage (reg2 : regRI ri, [reg1])
 356     XORIS reg1 reg2 imm -> usage ([reg2], [reg1])
 357     EXTS  siz reg1 reg2 -> usage ([reg2], [reg1])
 358     NEG   reg1 reg2     -> usage ([reg2], [reg1])
 359     NOT   reg1 reg2     -> usage ([reg2], [reg1])
 360     SLW   reg1 reg2 ri  -> usage (reg2 : regRI ri, [reg1])
 361     SRW   reg1 reg2 ri  -> usage (reg2 : regRI ri, [reg1])
 362     SRAW  reg1 reg2 ri  -> usage (reg2 : regRI ri, [reg1])
 363     RLWINM reg1 reg2 sh mb me
 364                         -> usage ([reg2], [reg1])
 365     FADD  sz r1 r2 r3   -> usage ([r2,r3], [r1])
 366     FSUB  sz r1 r2 r3   -> usage ([r2,r3], [r1])
 367     FMUL  sz r1 r2 r3   -> usage ([r2,r3], [r1])
 368     FDIV  sz r1 r2 r3   -> usage ([r2,r3], [r1])
 369     FNEG  r1 r2         -> usage ([r2], [r1])
 370     FCMP  r1 r2         -> usage ([r1,r2], [])
 371     FCTIWZ r1 r2        -> usage ([r2], [r1])
 372     FRSP r1 r2          -> usage ([r2], [r1])
 373     MFCR reg            -> usage ([], [reg])
 374     MFLR reg            -> usage ([], [reg])
 375     FETCHPC reg         -> usage ([], [reg])
 376     _                   -> noUsage
 377   where
 378     usage (src, dst) = RU (filter interesting src)
 379                           (filter interesting dst)
 380     regAddr (AddrRegReg r1 r2) = [r1, r2]
 381     regAddr (AddrRegImm r1 _)  = [r1]
 382
 383     regRI (RIReg r) = [r]
 384     regRI  _    = []
 385 #endif /* powerpc_TARGET_ARCH */
 386
 387
 388 -- -----------------------------------------------------------------------------
 389 -- Determine the possible destinations from the current instruction.
 390
 391 -- (we always assume that the next instruction is also a valid destination;
 392 -- if this isn't the case then the jump should be at the end of the basic
 393 -- block).
 394
 395 jumpDests :: Instr -> [BlockId] -> [BlockId]
 396 jumpDests insn acc
 397   = case insn of
 398 #if i386_TARGET_ARCH || x86_64_TARGET_ARCH
 399         JXX _ id        -> id : acc
 400         JMP_TBL _ ids   -> ids ++ acc
 401 #elif powerpc_TARGET_ARCH
 402         BCC _ id        -> id : acc
 403         BCTR targets    -> targets ++ acc
 404 #endif
 405         _other          -> acc
 406
 407
 408 -- -----------------------------------------------------------------------------
 409 -- 'patchRegs' function
 410
 411 -- 'patchRegs' takes an instruction and applies the given mapping to
 412 -- all the register references.
 413
 414 patchRegs :: Instr -> (Reg -> Reg) -> Instr
 415
 416 #if alpha_TARGET_ARCH
 417
 418 patchRegs instr env = case instr of
 419     LD sz reg addr -> LD sz (env reg) (fixAddr addr)
 420     LDA reg addr -> LDA (env reg) (fixAddr addr)
 421     LDAH reg addr -> LDAH (env reg) (fixAddr addr)
 422     LDGP reg addr -> LDGP (env reg) (fixAddr addr)
 423     LDI sz reg imm -> LDI sz (env reg) imm
 424     ST sz reg addr -> ST sz (env reg) (fixAddr addr)
 425     CLR reg -> CLR (env reg)
 426     ABS sz ar reg -> ABS sz (fixRI ar) (env reg)
 427     NEG sz ov ar reg -> NEG sz ov (fixRI ar) (env reg)
 428     ADD sz ov r1 ar r2 -> ADD sz ov (env r1) (fixRI ar) (env r2)
 429     SADD sz sc r1 ar r2 -> SADD sz sc (env r1) (fixRI ar) (env r2)
 430     SUB sz ov r1 ar r2 -> SUB sz ov (env r1) (fixRI ar) (env r2)
 431     SSUB sz sc r1 ar r2 -> SSUB sz sc (env r1) (fixRI ar) (env r2)
 432     MUL sz ov r1 ar r2 -> MUL sz ov (env r1) (fixRI ar) (env r2)
 433     DIV sz un r1 ar r2 -> DIV sz un (env r1) (fixRI ar) (env r2)
 434     REM sz un r1 ar r2 -> REM sz un (env r1) (fixRI ar) (env r2)
 435     NOT ar reg -> NOT (fixRI ar) (env reg)
 436     AND r1 ar r2 -> AND (env r1) (fixRI ar) (env r2)
 437     ANDNOT r1 ar r2 -> ANDNOT (env r1) (fixRI ar) (env r2)
 438     OR r1 ar r2 -> OR (env r1) (fixRI ar) (env r2)
 439     ORNOT r1 ar r2 -> ORNOT (env r1) (fixRI ar) (env r2)
 440     XOR r1 ar r2 -> XOR (env r1) (fixRI ar) (env r2)
 441     XORNOT r1 ar r2 -> XORNOT (env r1) (fixRI ar) (env r2)
 442     SLL r1 ar r2 -> SLL (env r1) (fixRI ar) (env r2)
 443     SRL r1 ar r2 -> SRL (env r1) (fixRI ar) (env r2)
 444     SRA r1 ar r2 -> SRA (env r1) (fixRI ar) (env r2)
 445     ZAP r1 ar r2 -> ZAP (env r1) (fixRI ar) (env r2)
 446     ZAPNOT r1 ar r2 -> ZAPNOT (env r1) (fixRI ar) (env r2)
 447     CMP co r1 ar r2 -> CMP co (env r1) (fixRI ar) (env r2)
 448     FCLR reg -> FCLR (env reg)
 449     FABS r1 r2 -> FABS (env r1) (env r2)
 450     FNEG s r1 r2 -> FNEG s (env r1) (env r2)
 451     FADD s r1 r2 r3 -> FADD s (env r1) (env r2) (env r3)
 452     FDIV s r1 r2 r3 -> FDIV s (env r1) (env r2) (env r3)
 453     FMUL s r1 r2 r3 -> FMUL s (env r1) (env r2) (env r3)
 454     FSUB s r1 r2 r3 -> FSUB s (env r1) (env r2) (env r3)
 455     CVTxy s1 s2 r1 r2 -> CVTxy s1 s2 (env r1) (env r2)
 456     FCMP s co r1 r2 r3 -> FCMP s co (env r1) (env r2) (env r3)
 457     FMOV r1 r2 -> FMOV (env r1) (env r2)
 458     BI cond reg lbl -> BI cond (env reg) lbl
 459     BF cond reg lbl -> BF cond (env reg) lbl
 460     JMP reg addr hint -> JMP (env reg) (fixAddr addr) hint
 461     JSR reg addr i -> JSR (env reg) (fixAddr addr) i
 462     _ -> instr
 463   where
 464     fixAddr (AddrReg r1)       = AddrReg (env r1)
 465     fixAddr (AddrRegImm r1 i)  = AddrRegImm (env r1) i
 466     fixAddr other              = other
 467
 468     fixRI (RIReg r) = RIReg (env r)
 469     fixRI other = other
 470
 471 #endif /* alpha_TARGET_ARCH */
 472 -- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
 473 #if i386_TARGET_ARCH || x86_64_TARGET_ARCH
 474
 475 patchRegs instr env = case instr of
 476     MOV  sz src dst     -> patch2 (MOV  sz) src dst
 477     MOVZxL sz src dst   -> patch2 (MOVZxL sz) src dst
 478     MOVSxL sz src dst   -> patch2 (MOVSxL sz) src dst
 479     LEA  sz src dst     -> patch2 (LEA  sz) src dst
 480     ADD  sz src dst     -> patch2 (ADD  sz) src dst
 481     ADC  sz src dst     -> patch2 (ADC  sz) src dst
 482     SUB  sz src dst     -> patch2 (SUB  sz) src dst
 483     IMUL sz src dst     -> patch2 (IMUL sz) src dst
 484     IMUL2 sz src        -> patch1 (IMUL2 sz) src
 485     MUL sz src dst      -> patch2 (MUL sz) src dst
 486     IDIV sz op          -> patch1 (IDIV sz) op
 487     DIV sz op           -> patch1 (DIV sz) op
 488     AND  sz src dst     -> patch2 (AND  sz) src dst
 489     OR   sz src dst     -> patch2 (OR   sz) src dst
 490     XOR  sz src dst     -> patch2 (XOR  sz) src dst
 491     NOT  sz op          -> patch1 (NOT  sz) op
 492     NEGI sz op          -> patch1 (NEGI sz) op
 493     SHL  sz imm dst     -> patch1 (SHL sz imm) dst
 494     SAR  sz imm dst     -> patch1 (SAR sz imm) dst
 495     SHR  sz imm dst     -> patch1 (SHR sz imm) dst
 496     BT   sz imm src     -> patch1 (BT  sz imm) src
 497     TEST sz src dst     -> patch2 (TEST sz) src dst
 498     CMP  sz src dst     -> patch2 (CMP  sz) src dst
 499     PUSH sz op          -> patch1 (PUSH sz) op
 500     POP  sz op          -> patch1 (POP  sz) op
 501     SETCC cond op       -> patch1 (SETCC cond) op
 502     JMP op              -> patch1 JMP op
 503     JMP_TBL op ids      -> patch1 JMP_TBL op $ ids
 504
 505 #if i386_TARGET_ARCH
 506     GMOV src dst        -> GMOV (env src) (env dst)
 507     GLD sz src dst      -> GLD sz (lookupAddr src) (env dst)
 508     GST sz src dst      -> GST sz (env src) (lookupAddr dst)
 509
 510     GLDZ dst            -> GLDZ (env dst)
 511     GLD1 dst            -> GLD1 (env dst)
 512
 513     GFTOI src dst       -> GFTOI (env src) (env dst)
 514     GDTOI src dst       -> GDTOI (env src) (env dst)
 515
 516     GITOF src dst       -> GITOF (env src) (env dst)
 517     GITOD src dst       -> GITOD (env src) (env dst)
 518
 519     GADD sz s1 s2 dst   -> GADD sz (env s1) (env s2) (env dst)
 520     GSUB sz s1 s2 dst   -> GSUB sz (env s1) (env s2) (env dst)
 521     GMUL sz s1 s2 dst   -> GMUL sz (env s1) (env s2) (env dst)
 522     GDIV sz s1 s2 dst   -> GDIV sz (env s1) (env s2) (env dst)
 523
 524     GCMP sz src1 src2   -> GCMP sz (env src1) (env src2)
 525     GABS sz src dst     -> GABS sz (env src) (env dst)
 526     GNEG sz src dst     -> GNEG sz (env src) (env dst)
 527     GSQRT sz src dst    -> GSQRT sz (env src) (env dst)
 528     GSIN sz src dst     -> GSIN sz (env src) (env dst)
 529     GCOS sz src dst     -> GCOS sz (env src) (env dst)
 530     GTAN sz src dst     -> GTAN sz (env src) (env dst)
 531 #endif
 532
 533 #if x86_64_TARGET_ARCH
 534     CVTSS2SD src dst    -> CVTSS2SD (env src) (env dst)
 535     CVTSD2SS src dst    -> CVTSD2SS (env src) (env dst)
 536     CVTSS2SI src dst    -> CVTSS2SI (patchOp src) (env dst)
 537     CVTSD2SI src dst    -> CVTSD2SI (patchOp src) (env dst)
 538     CVTSI2SS src dst    -> CVTSI2SS (patchOp src) (env dst)
 539     CVTSI2SD src dst    -> CVTSI2SD (patchOp src) (env dst)
 540     FDIV sz src dst     -> FDIV sz (patchOp src) (patchOp dst)
 541 #endif
 542
 543     CALL (Left imm)  _  -> instr
 544     CALL (Right reg) p  -> CALL (Right (env reg)) p
 545
 546     FETCHGOT reg        -> FETCHGOT (env reg)
 547     FETCHPC  reg        -> FETCHPC  (env reg)
 548
 549     NOP                 -> instr
 550     COMMENT _           -> instr
 551     DELTA _             -> instr
 552     JXX _ _             -> instr
 553     CLTD _              -> instr
 554
 555     _other              -> panic "patchRegs: unrecognised instr"
 556
 557   where
 558     patch1 insn op      = insn $! patchOp op
 559     patch2 insn src dst = (insn $! patchOp src) $! patchOp dst
 560
 561     patchOp (OpReg  reg) = OpReg $! env reg
 562     patchOp (OpImm  imm) = OpImm imm
 563     patchOp (OpAddr ea)  = OpAddr $! lookupAddr ea
 564
 565     lookupAddr (ImmAddr imm off) = ImmAddr imm off
 566     lookupAddr (AddrBaseIndex base index disp)
 567       = ((AddrBaseIndex $! lookupBase base) $! lookupIndex index) disp
 568       where
 569         lookupBase EABaseNone       = EABaseNone
 570         lookupBase EABaseRip        = EABaseRip
 571         lookupBase (EABaseReg r)    = EABaseReg (env r)
 572
 573         lookupIndex EAIndexNone     = EAIndexNone
 574         lookupIndex (EAIndex r i)   = EAIndex (env r) i
 575
 576 #endif /* i386_TARGET_ARCH || x86_64_TARGET_ARCH*/
 577 -- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
 578 #if sparc_TARGET_ARCH
 579
 580 patchRegs instr env = case instr of
 581     LD    sz addr reg   -> LD sz (fixAddr addr) (env reg)
 582     ST    sz reg addr   -> ST sz (env reg) (fixAddr addr)
 583     ADD   x cc r1 ar r2 -> ADD x cc (env r1) (fixRI ar) (env r2)
 584     SUB   x cc r1 ar r2 -> SUB x cc (env r1) (fixRI ar) (env r2)
 585     UMUL    cc r1 ar r2 -> UMUL cc (env r1) (fixRI ar) (env r2)
 586     SMUL    cc r1 ar r2 -> SMUL cc (env r1) (fixRI ar) (env r2)
 587     RDY   rd            -> RDY (env rd)
 588     AND   b r1 ar r2    -> AND b (env r1) (fixRI ar) (env r2)
 589     ANDN  b r1 ar r2    -> ANDN b (env r1) (fixRI ar) (env r2)
 590     OR    b r1 ar r2    -> OR b (env r1) (fixRI ar) (env r2)
 591     ORN   b r1 ar r2    -> ORN b (env r1) (fixRI ar) (env r2)
 592     XOR   b r1 ar r2    -> XOR b (env r1) (fixRI ar) (env r2)
 593     XNOR  b r1 ar r2    -> XNOR b (env r1) (fixRI ar) (env r2)
 594     SLL   r1 ar r2      -> SLL (env r1) (fixRI ar) (env r2)
 595     SRL   r1 ar r2      -> SRL (env r1) (fixRI ar) (env r2)
 596     SRA   r1 ar r2      -> SRA (env r1) (fixRI ar) (env r2)
 597     SETHI imm reg       -> SETHI imm (env reg)
 598     FABS  s r1 r2       -> FABS s (env r1) (env r2)
 599     FADD  s r1 r2 r3    -> FADD s (env r1) (env r2) (env r3)
 600     FCMP  e s r1 r2     -> FCMP e s (env r1) (env r2)
 601     FDIV  s r1 r2 r3    -> FDIV s (env r1) (env r2) (env r3)
 602     FMOV  s r1 r2       -> FMOV s (env r1) (env r2)
 603     FMUL  s r1 r2 r3    -> FMUL s (env r1) (env r2) (env r3)
 604     FNEG  s r1 r2       -> FNEG s (env r1) (env r2)
 605     FSQRT s r1 r2       -> FSQRT s (env r1) (env r2)
 606     FSUB  s r1 r2 r3    -> FSUB s (env r1) (env r2) (env r3)
 607     FxTOy s1 s2 r1 r2   -> FxTOy s1 s2 (env r1) (env r2)
 608     JMP   addr          -> JMP (fixAddr addr)
 609     CALL  (Left i) n t  -> CALL (Left i) n t
 610     CALL  (Right r) n t -> CALL (Right (env r)) n t
 611     _ -> instr
 612   where
 613     fixAddr (AddrRegReg r1 r2) = AddrRegReg (env r1) (env r2)
 614     fixAddr (AddrRegImm r1 i)  = AddrRegImm (env r1) i
 615
 616     fixRI (RIReg r) = RIReg (env r)
 617     fixRI other = other
 618
 619 #endif /* sparc_TARGET_ARCH */
 620 -- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
 621 #if powerpc_TARGET_ARCH
 622
 623 patchRegs instr env = case instr of
 624     LD    sz reg addr   -> LD sz (env reg) (fixAddr addr)
 625     LA    sz reg addr   -> LA sz (env reg) (fixAddr addr)
 626     ST    sz reg addr   -> ST sz (env reg) (fixAddr addr)
 627     STU    sz reg addr  -> STU sz (env reg) (fixAddr addr)
 628     LIS   reg imm       -> LIS (env reg) imm
 629     LI    reg imm       -> LI (env reg) imm
 630     MR    reg1 reg2     -> MR (env reg1) (env reg2)
 631     CMP   sz reg ri     -> CMP sz (env reg) (fixRI ri)
 632     CMPL  sz reg ri     -> CMPL sz (env reg) (fixRI ri)
 633     BCC   cond lbl      -> BCC cond lbl
 634     MTCTR reg           -> MTCTR (env reg)
 635     BCTR  targets       -> BCTR targets
 636     BL    imm argRegs   -> BL imm argRegs       -- argument regs
 637     BCTRL argRegs       -> BCTRL argRegs        -- cannot be remapped
 638     ADD   reg1 reg2 ri  -> ADD (env reg1) (env reg2) (fixRI ri)
 639     ADDC  reg1 reg2 reg3-> ADDC (env reg1) (env reg2) (env reg3)
 640     ADDE  reg1 reg2 reg3-> ADDE (env reg1) (env reg2) (env reg3)
 641     ADDIS reg1 reg2 imm -> ADDIS (env reg1) (env reg2) imm
 642     SUBF  reg1 reg2 reg3-> SUBF (env reg1) (env reg2) (env reg3)
 643     MULLW reg1 reg2 ri  -> MULLW (env reg1) (env reg2) (fixRI ri)
 644     DIVW  reg1 reg2 reg3-> DIVW (env reg1) (env reg2) (env reg3)
 645     DIVWU reg1 reg2 reg3-> DIVWU (env reg1) (env reg2) (env reg3)
 646     MULLW_MayOflo reg1 reg2 reg3
 647                         -> MULLW_MayOflo (env reg1) (env reg2) (env reg3)
 648     AND   reg1 reg2 ri  -> AND (env reg1) (env reg2) (fixRI ri)
 649     OR    reg1 reg2 ri  -> OR  (env reg1) (env reg2) (fixRI ri)
 650     XOR   reg1 reg2 ri  -> XOR (env reg1) (env reg2) (fixRI ri)
 651     XORIS reg1 reg2 imm -> XORIS (env reg1) (env reg2) imm
 652     EXTS  sz reg1 reg2 -> EXTS sz (env reg1) (env reg2)
 653     NEG   reg1 reg2     -> NEG (env reg1) (env reg2)
 654     NOT   reg1 reg2     -> NOT (env reg1) (env reg2)
 655     SLW   reg1 reg2 ri  -> SLW (env reg1) (env reg2) (fixRI ri)
 656     SRW   reg1 reg2 ri  -> SRW (env reg1) (env reg2) (fixRI ri)
 657     SRAW  reg1 reg2 ri  -> SRAW (env reg1) (env reg2) (fixRI ri)
 658     RLWINM reg1 reg2 sh mb me
 659                         -> RLWINM (env reg1) (env reg2) sh mb me
 660     FADD  sz r1 r2 r3   -> FADD sz (env r1) (env r2) (env r3)
 661     FSUB  sz r1 r2 r3   -> FSUB sz (env r1) (env r2) (env r3)
 662     FMUL  sz r1 r2 r3   -> FMUL sz (env r1) (env r2) (env r3)
 663     FDIV  sz r1 r2 r3   -> FDIV sz (env r1) (env r2) (env r3)
 664     FNEG  r1 r2         -> FNEG (env r1) (env r2)
 665     FCMP  r1 r2         -> FCMP (env r1) (env r2)
 666     FCTIWZ r1 r2        -> FCTIWZ (env r1) (env r2)
 667     FRSP r1 r2          -> FRSP (env r1) (env r2)
 668     MFCR reg            -> MFCR (env reg)
 669     MFLR reg            -> MFLR (env reg)
 670     FETCHPC reg         -> FETCHPC (env reg)
 671     _ -> instr
 672   where
 673     fixAddr (AddrRegReg r1 r2) = AddrRegReg (env r1) (env r2)
 674     fixAddr (AddrRegImm r1 i)  = AddrRegImm (env r1) i
 675
 676     fixRI (RIReg r) = RIReg (env r)
 677     fixRI other = other
 678 #endif /* powerpc_TARGET_ARCH */
 679
 680 -- -----------------------------------------------------------------------------
 681 -- Detecting reg->reg moves
 682
 683 -- The register allocator attempts to eliminate reg->reg moves whenever it can,
 684 -- by assigning the src and dest temporaries to the same real register.
 685
 686 isRegRegMove :: Instr -> Maybe (Reg,Reg)
 687 #if i386_TARGET_ARCH || x86_64_TARGET_ARCH
 688 -- TMP:
 689 isRegRegMove (MOV _ (OpReg r1) (OpReg r2)) = Just (r1,r2)
 690 #elif powerpc_TARGET_ARCH
 691 isRegRegMove (MR dst src) = Just (src,dst)
 692 #else
 693 #warning ToDo: isRegRegMove
 694 #endif
 695 isRegRegMove _ = Nothing
 696
 697 -- -----------------------------------------------------------------------------
 698 -- Generating spill instructions
 699
 700 mkSpillInstr
 701    :: Reg               -- register to spill (should be a real)
 702    -> Int               -- current stack delta
 703    -> Int               -- spill slot to use
 704    -> Instr
 705 mkSpillInstr reg delta slot
 706   = ASSERT(isRealReg reg)
 707     let
 708         off     = spillSlotToOffset slot
 709     in
 710 #ifdef alpha_TARGET_ARCH
 711     {-Alpha: spill below the stack pointer (?)-}
 712     ST sz dyn (spRel (- (off `div` 8)))
 713 #endif
 714 #ifdef i386_TARGET_ARCH
 715     let off_w = (off-delta) `div` 4
 716     in case regClass reg of
 717            RcInteger -> MOV I32 (OpReg reg) (OpAddr (spRel off_w))
 718            _         -> GST F80 reg (spRel off_w) {- RcFloat/RcDouble -}
 719 #endif
 720 #ifdef x86_64_TARGET_ARCH
 721     let off_w = (off-delta) `div` 8
 722     in case regClass reg of
 723            RcInteger -> MOV I64 (OpReg reg) (OpAddr (spRel off_w))
 724            RcDouble  -> MOV F64 (OpReg reg) (OpAddr (spRel off_w))
 725                 -- ToDo: will it work to always spill as a double?
 726                 -- does that cause a stall if the data was a float?
 727 #endif
 728 #ifdef sparc_TARGET_ARCH
 729         {-SPARC: spill below frame pointer leaving 2 words/spill-}
 730                         let{off_w = 1 + (off `div` 4);
 731                             sz = case regClass reg of {
 732                                     RcInteger -> I32;
 733                                     RcFloat   -> F32;
 734                                     RcDouble  -> F64}}
 735                         in ST sz reg (fpRel (- off_w))
 736 #endif
 737 #ifdef powerpc_TARGET_ARCH
 738     let sz = case regClass reg of
 739                 RcInteger -> I32
 740                 RcDouble -> F64
 741     in ST sz reg (AddrRegImm sp (ImmInt (off-delta)))
 742 #endif
 743
 744
 745 mkLoadInstr
 746    :: Reg               -- register to load (should be a real)
 747    -> Int               -- current stack delta
 748    -> Int               -- spill slot to use
 749    -> Instr
 750 mkLoadInstr reg delta slot
 751   = ASSERT(isRealReg reg)
 752     let
 753         off     = spillSlotToOffset slot
 754     in
 755 #if alpha_TARGET_ARCH
 756          LD  sz dyn (spRel (- (off `div` 8)))
 757 #endif
 758 #if i386_TARGET_ARCH
 759         let off_w = (off-delta) `div` 4
 760         in case regClass reg of {
 761               RcInteger -> MOV I32 (OpAddr (spRel off_w)) (OpReg reg);
 762               _         -> GLD F80 (spRel off_w) reg} {- RcFloat/RcDouble -}
 763 #endif
 764 #if x86_64_TARGET_ARCH
 765         let off_w = (off-delta) `div` 8
 766         in case regClass reg of
 767               RcInteger -> MOV I64 (OpAddr (spRel off_w)) (OpReg reg)
 768               _         -> MOV F64 (OpAddr (spRel off_w)) (OpReg reg)
 769 #endif
 770 #if sparc_TARGET_ARCH
 771         let{off_w = 1 + (off `div` 4);
 772             sz = case regClass reg of {
 773                    RcInteger -> I32;
 774                    RcFloat   -> F32;
 775                    RcDouble  -> F64}}
 776         in LD sz (fpRel (- off_w)) reg
 777 #endif
 778 #if powerpc_TARGET_ARCH
 779     let sz = case regClass reg of
 780                 RcInteger -> I32
 781                 RcDouble -> F64
 782     in LD sz reg (AddrRegImm sp (ImmInt (off-delta)))
 783 #endif
 784
 785
 786 spillSlotSize :: Int
 787 spillSlotSize = IF_ARCH_i386(12, 8)
 788
 789 maxSpillSlots :: Int
 790 maxSpillSlots = ((rESERVED_C_STACK_BYTES - 64) `div` spillSlotSize) - 1
 791
 792 -- convert a spill slot number to a *byte* offset, with no sign:
 793 -- decide on a per arch basis whether you are spilling above or below
 794 -- the C stack pointer.
 795 spillSlotToOffset :: Int -> Int
 796 spillSlotToOffset slot
 797    | slot >= 0 && slot < maxSpillSlots
 798    = 64 + spillSlotSize * slot
 799    | otherwise
 800    = pprPanic "spillSlotToOffset:"
 801               (text "invalid spill location: " <> int slot)