compiler/nativeGen/RegAllocInfo.hs

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