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