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