ghc/compiler/nativeGen/RegAllocInfo.lhs

   1 %
   2 % (c) The AQUA Project, Glasgow University, 1996-1998
   3 %
   4 \section[RegAllocInfo]{Machine-specific info used for register allocation}
   5
   6 The (machine-independent) allocator itself is in @AsmRegAlloc@.
   7
   8 \begin{code}
   9 #include "nativeGen/NCG.h"
  10
  11 module RegAllocInfo (
  12         RegUsage(..),
  13         noUsage,
  14         regUsage,
  15         InsnFuture(..),
  16         insnFuture,
  17
  18         loadReg,
  19         patchRegs,
  20         spillReg,
  21         findReservedRegs,
  22
  23         RegSet,
  24         regSetFromList,
  25         regSetToList,
  26         isEmptyRegSet,
  27         emptyRegSet,
  28         eqRegSets,
  29         filterRegSet,
  30         unitRegSet,
  31         elemRegSet,
  32         unionRegSets,
  33         minusRegSets,
  34         intersectionRegSets
  35     ) where
  36
  37 #include "HsVersions.h"
  38
  39 import List             ( sort )
  40 import MachMisc
  41 import MachRegs
  42 import Stix             ( DestInfo(..) )
  43 import CLabel           ( isAsmTemp, CLabel{-instance Ord-} )
  44 import FiniteMap        ( addToFM, lookupFM, FiniteMap )
  45 import Outputable
  46 import Constants        ( rESERVED_C_STACK_BYTES )
  47 import Unique           ( Unique, Uniquable(..) )
  48 import FastTypes
  49
  50 \end{code}
  51
  52 %************************************************************************
  53 %*                                                                      *
  54 \subsection{Sets of registers}
  55 %*                                                                      *
  56 %************************************************************************
  57
  58 \begin{code}
  59
  60 -- Blargh.  Use ghc stuff soon!  Or: perhaps that's not such a good
  61 -- idea.  Most of these sets are either empty or very small, and it
  62 -- might be that the overheads of the FiniteMap based set implementation
  63 -- is a net loss.  The same might be true of FeSets.
  64
  65 newtype RegSet = MkRegSet [Reg]
  66
  67 regSetFromList xs
  68    = MkRegSet (nukeDups (sort xs))
  69      where nukeDups :: [Reg] -> [Reg]
  70            nukeDups []  = []
  71            nukeDups [x] = [x]
  72            nukeDups (x:y:xys)
  73               = if x == y then nukeDups (y:xys)
  74                           else x : nukeDups (y:xys)
  75
  76 regSetToList   (MkRegSet xs)                 = xs
  77 isEmptyRegSet  (MkRegSet xs)                 = null xs
  78 emptyRegSet                                  = MkRegSet []
  79 eqRegSets      (MkRegSet xs1) (MkRegSet xs2) = xs1 == xs2
  80 unitRegSet x                                 = MkRegSet [x]
  81 filterRegSet p (MkRegSet xs)                 = MkRegSet (filter p xs)
  82
  83 elemRegSet x (MkRegSet xs)
  84    = f xs
  85      where
  86         f []     = False
  87         f (y:ys) | x == y    = True
  88                  | x < y     = False
  89                  | otherwise = f ys
  90
  91 unionRegSets (MkRegSet xs1) (MkRegSet xs2)
  92    = MkRegSet (f xs1 xs2)
  93      where
  94         f [] bs = bs
  95         f as [] = as
  96         f (a:as) (b:bs)
  97            | a < b      = a : f as (b:bs)
  98            | a > b      = b : f (a:as) bs
  99            | otherwise  = a : f as bs
 100
 101 minusRegSets (MkRegSet xs1) (MkRegSet xs2)
 102    = MkRegSet (f xs1 xs2)
 103      where
 104         f [] bs = []
 105         f as [] = as
 106         f (a:as) (b:bs)
 107            | a < b      = a : f as (b:bs)
 108            | a > b      = f (a:as) bs
 109            | otherwise  = f as bs
 110
 111 intersectionRegSets (MkRegSet xs1) (MkRegSet xs2)
 112    = MkRegSet (f xs1 xs2)
 113      where
 114         f [] bs = []
 115         f as [] = []
 116         f (a:as) (b:bs)
 117            | a < b      = f as (b:bs)
 118            | a > b      = f (a:as) bs
 119            | otherwise  = a : f as bs
 120 \end{code}
 121
 122 %************************************************************************
 123 %*                                                                      *
 124 \subsection{@RegUsage@ type; @noUsage@ and @regUsage@ functions}
 125 %*                                                                      *
 126 %************************************************************************
 127
 128 @regUsage@ returns the sets of src and destination registers used by a
 129 particular instruction.  Machine registers that are pre-allocated to
 130 stgRegs are filtered out, because they are uninteresting from a
 131 register allocation standpoint.  (We wouldn't want them to end up on
 132 the free list!)  As far as we are concerned, the fixed registers
 133 simply don't exist (for allocation purposes, anyway).
 134
 135 regUsage doesn't need to do any trickery for jumps and such.  Just
 136 state precisely the regs read and written by that insn.  The
 137 consequences of control flow transfers, as far as register allocation
 138 goes, are taken care of by @insnFuture@.
 139
 140 \begin{code}
 141 data RegUsage = RU RegSet RegSet
 142
 143 noUsage :: RegUsage
 144 noUsage  = RU emptyRegSet emptyRegSet
 145
 146 regUsage :: Instr -> RegUsage
 147
 148 interesting (VirtualRegI _)  = True
 149 interesting (VirtualRegF _)  = True
 150 interesting (VirtualRegD _)  = True
 151 interesting (RealReg i)      = isFastTrue (freeReg i)
 152
 153 #if alpha_TARGET_ARCH
 154
 155 regUsage instr = case instr of
 156     LD B reg addr       -> usage (regAddr addr, [reg, t9])
 157     LD Bu reg addr      -> usage (regAddr addr, [reg, t9])
 158 --  LD W reg addr       -> usage (regAddr addr, [reg, t9]) : UNUSED
 159 --  LD Wu reg addr      -> usage (regAddr addr, [reg, t9]) : UNUSED
 160     LD sz reg addr      -> usage (regAddr addr, [reg])
 161     LDA reg addr        -> usage (regAddr addr, [reg])
 162     LDAH reg addr       -> usage (regAddr addr, [reg])
 163     LDGP reg addr       -> usage (regAddr addr, [reg])
 164     LDI sz reg imm      -> usage ([], [reg])
 165     ST B reg addr       -> usage (reg : regAddr addr, [t9, t10])
 166 --  ST W reg addr       -> usage (reg : regAddr addr, [t9, t10]) : UNUSED
 167     ST sz reg addr      -> usage (reg : regAddr addr, [])
 168     CLR reg             -> usage ([], [reg])
 169     ABS sz ri reg       -> usage (regRI ri, [reg])
 170     NEG sz ov ri reg    -> usage (regRI ri, [reg])
 171     ADD sz ov r1 ar r2  -> usage (r1 : regRI ar, [r2])
 172     SADD sz sc r1 ar r2 -> usage (r1 : regRI ar, [r2])
 173     SUB sz ov r1 ar r2  -> usage (r1 : regRI ar, [r2])
 174     SSUB sz sc r1 ar r2 -> usage (r1 : regRI ar, [r2])
 175     MUL sz ov r1 ar r2  -> usage (r1 : regRI ar, [r2])
 176     DIV sz un r1 ar r2  -> usage (r1 : regRI ar, [r2, t9, t10, t11, t12])
 177     REM sz un r1 ar r2  -> usage (r1 : regRI ar, [r2, t9, t10, t11, t12])
 178     NOT ri reg          -> usage (regRI ri, [reg])
 179     AND r1 ar r2        -> usage (r1 : regRI ar, [r2])
 180     ANDNOT r1 ar r2     -> usage (r1 : regRI ar, [r2])
 181     OR r1 ar r2         -> usage (r1 : regRI ar, [r2])
 182     ORNOT r1 ar r2      -> usage (r1 : regRI ar, [r2])
 183     XOR r1 ar r2        -> usage (r1 : regRI ar, [r2])
 184     XORNOT r1 ar r2     -> usage (r1 : regRI ar, [r2])
 185     SLL r1 ar r2        -> usage (r1 : regRI ar, [r2])
 186     SRL r1 ar r2        -> usage (r1 : regRI ar, [r2])
 187     SRA r1 ar r2        -> usage (r1 : regRI ar, [r2])
 188     ZAP r1 ar r2        -> usage (r1 : regRI ar, [r2])
 189     ZAPNOT r1 ar r2     -> usage (r1 : regRI ar, [r2])
 190     CMP co r1 ar r2     -> usage (r1 : regRI ar, [r2])
 191     FCLR reg            -> usage ([], [reg])
 192     FABS r1 r2          -> usage ([r1], [r2])
 193     FNEG sz r1 r2       -> usage ([r1], [r2])
 194     FADD sz r1 r2 r3    -> usage ([r1, r2], [r3])
 195     FDIV sz r1 r2 r3    -> usage ([r1, r2], [r3])
 196     FMUL sz r1 r2 r3    -> usage ([r1, r2], [r3])
 197     FSUB sz r1 r2 r3    -> usage ([r1, r2], [r3])
 198     CVTxy sz1 sz2 r1 r2 -> usage ([r1], [r2])
 199     FCMP sz co r1 r2 r3 -> usage ([r1, r2], [r3])
 200     FMOV r1 r2          -> usage ([r1], [r2])
 201
 202
 203     -- We assume that all local jumps will be BI/BF/BR.  JMP must be out-of-line.
 204     BI cond reg lbl     -> usage ([reg], [])
 205     BF cond reg lbl     -> usage ([reg], [])
 206     JMP reg addr hint   -> RU (mkRegSet (filter interesting (regAddr addr))) freeRegSet
 207
 208     BSR _ n             -> RU (argRegSet n) callClobberedRegSet
 209     JSR reg addr n      -> RU (argRegSet n) callClobberedRegSet
 210
 211     _                   -> noUsage
 212
 213   where
 214     usage (src, dst) = RU (mkRegSet (filter interesting src))
 215                           (mkRegSet (filter interesting dst))
 216
 217     interesting (FixedReg _) = False
 218     interesting _ = True
 219
 220     regAddr (AddrReg r1)      = [r1]
 221     regAddr (AddrRegImm r1 _) = [r1]
 222     regAddr (AddrImm _)       = []
 223
 224     regRI (RIReg r) = [r]
 225     regRI  _    = []
 226
 227 #endif /* alpha_TARGET_ARCH */
 228 -- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
 229 #if i386_TARGET_ARCH
 230
 231 regUsage instr = case instr of
 232     MOV    sz src dst   -> usageRW src dst
 233     MOVZxL sz src dst   -> usageRW src dst
 234     MOVSxL sz src dst   -> usageRW src dst
 235     LEA    sz src dst   -> usageRW src dst
 236     ADD    sz src dst   -> usageRM src dst
 237     SUB    sz src dst   -> usageRM src dst
 238     IMUL   sz src dst   -> usageRM src dst
 239     IMUL64    sd1 sd2   -> mkRU [sd1,sd2] [sd1,sd2]
 240     MUL    sz src dst   -> usageRM src dst
 241     IQUOT  sz src dst   -> usageRM src dst
 242     IREM   sz src dst   -> usageRM src dst
 243     QUOT   sz src dst   -> usageRM src dst
 244     REM    sz src dst   -> usageRM src dst
 245     AND    sz src dst   -> usageRM src dst
 246     OR     sz src dst   -> usageRM src dst
 247     XOR    sz src dst   -> usageRM src dst
 248     NOT    sz op        -> usageM op
 249     NEGI   sz op        -> usageM op
 250     SHL    sz imm dst   -> usageM dst
 251     SAR    sz imm dst   -> usageM dst
 252     SHR    sz imm dst   -> usageM dst
 253     BT     sz imm src   -> mkRU (use_R src) []
 254
 255     PUSH   sz op        -> mkRU (use_R op) []
 256     POP    sz op        -> mkRU [] (def_W op)
 257     TEST   sz src dst   -> mkRU (use_R src ++ use_R dst) []
 258     CMP    sz src dst   -> mkRU (use_R src ++ use_R dst) []
 259     SETCC  cond op      -> mkRU [] (def_W op)
 260     JXX    cond lbl     -> mkRU [] []
 261     JMP    dsts op      -> mkRU (use_R op) []
 262     CALL   (Left imm)   -> mkRU [] callClobberedRegs
 263     CALL   (Right reg)  -> mkRU [reg] callClobberedRegs
 264     CLTD                -> mkRU [eax] [edx]
 265     NOP                 -> mkRU [] []
 266
 267     GMOV   src dst      -> mkRU [src] [dst]
 268     GLD    sz src dst   -> mkRU (use_EA src) [dst]
 269     GST    sz src dst   -> mkRU (src : use_EA dst) []
 270
 271     GLDZ   dst          -> mkRU [] [dst]
 272     GLD1   dst          -> mkRU [] [dst]
 273
 274     GFTOI  src dst      -> mkRU [src] [dst]
 275     GDTOI  src dst      -> mkRU [src] [dst]
 276
 277     GITOF  src dst      -> mkRU [src] [dst]
 278     GITOD  src dst      -> mkRU [src] [dst]
 279
 280     GADD   sz s1 s2 dst -> mkRU [s1,s2] [dst]
 281     GSUB   sz s1 s2 dst -> mkRU [s1,s2] [dst]
 282     GMUL   sz s1 s2 dst -> mkRU [s1,s2] [dst]
 283     GDIV   sz s1 s2 dst -> mkRU [s1,s2] [dst]
 284
 285     GCMP   sz src1 src2 -> mkRU [src1,src2] []
 286     GABS   sz src dst   -> mkRU [src] [dst]
 287     GNEG   sz src dst   -> mkRU [src] [dst]
 288     GSQRT  sz src dst   -> mkRU [src] [dst]
 289     GSIN   sz src dst   -> mkRU [src] [dst]
 290     GCOS   sz src dst   -> mkRU [src] [dst]
 291     GTAN   sz src dst   -> mkRU [src] [dst]
 292
 293     COMMENT _           -> noUsage
 294     SEGMENT _           -> noUsage
 295     LABEL   _           -> noUsage
 296     ASCII   _ _         -> noUsage
 297     DATA    _ _         -> noUsage
 298     DELTA   _           -> noUsage
 299     _                   -> pprPanic "regUsage(x86)" empty
 300
 301  where
 302     -- 2 operand form; first operand Read; second Written
 303     usageRW :: Operand -> Operand -> RegUsage
 304     usageRW op (OpReg reg) = mkRU (use_R op) [reg]
 305     usageRW op (OpAddr ea) = mkRU (use_R op ++ use_EA ea) []
 306
 307     -- 2 operand form; first operand Read; second Modified
 308     usageRM :: Operand -> Operand -> RegUsage
 309     usageRM op (OpReg reg) = mkRU (use_R op ++ [reg]) [reg]
 310     usageRM op (OpAddr ea) = mkRU (use_R op ++ use_EA ea) []
 311
 312     -- 1 operand form; operand Modified
 313     usageM :: Operand -> RegUsage
 314     usageM (OpReg reg)    = mkRU [reg] [reg]
 315     usageM (OpAddr ea)    = mkRU (use_EA ea) []
 316
 317     -- Registers defd when an operand is written.
 318     def_W (OpReg reg)  = [reg]
 319     def_W (OpAddr ea)  = []
 320
 321     -- Registers used when an operand is read.
 322     use_R (OpReg reg)  = [reg]
 323     use_R (OpImm imm)  = []
 324     use_R (OpAddr ea)  = use_EA ea
 325
 326     -- Registers used to compute an effective address.
 327     use_EA (ImmAddr _ _)                           = []
 328     use_EA (AddrBaseIndex Nothing  Nothing      _) = []
 329     use_EA (AddrBaseIndex (Just b) Nothing      _) = [b]
 330     use_EA (AddrBaseIndex Nothing  (Just (i,_)) _) = [i]
 331     use_EA (AddrBaseIndex (Just b) (Just (i,_)) _) = [b,i]
 332
 333     mkRU src dst = RU (regSetFromList (filter interesting src))
 334                       (regSetFromList (filter interesting dst))
 335
 336 #endif /* i386_TARGET_ARCH */
 337 -- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
 338 #if sparc_TARGET_ARCH
 339
 340 regUsage instr = case instr of
 341     LD    sz addr reg   -> usage (regAddr addr, [reg])
 342     ST    sz reg addr   -> usage (reg : regAddr addr, [])
 343     ADD   x cc r1 ar r2 -> usage (r1 : regRI ar, [r2])
 344     SUB   x cc r1 ar r2 -> usage (r1 : regRI ar, [r2])
 345     UMUL    cc r1 ar r2 -> usage (r1 : regRI ar, [r2])
 346     SMUL    cc r1 ar r2 -> usage (r1 : regRI ar, [r2])
 347     RDY   rd            -> usage ([], [rd])
 348     AND   b r1 ar r2    -> usage (r1 : regRI ar, [r2])
 349     ANDN  b r1 ar r2    -> usage (r1 : regRI ar, [r2])
 350     OR    b r1 ar r2    -> usage (r1 : regRI ar, [r2])
 351     ORN   b r1 ar r2    -> usage (r1 : regRI ar, [r2])
 352     XOR   b r1 ar r2    -> usage (r1 : regRI ar, [r2])
 353     XNOR  b r1 ar r2    -> usage (r1 : regRI ar, [r2])
 354     SLL   r1 ar r2      -> usage (r1 : regRI ar, [r2])
 355     SRL   r1 ar r2      -> usage (r1 : regRI ar, [r2])
 356     SRA   r1 ar r2      -> usage (r1 : regRI ar, [r2])
 357     SETHI imm reg       -> usage ([], [reg])
 358     FABS  s r1 r2       -> usage ([r1], [r2])
 359     FADD  s r1 r2 r3    -> usage ([r1, r2], [r3])
 360     FCMP  e s r1 r2     -> usage ([r1, r2], [])
 361     FDIV  s r1 r2 r3    -> usage ([r1, r2], [r3])
 362     FMOV  s r1 r2       -> usage ([r1], [r2])
 363     FMUL  s r1 r2 r3    -> usage ([r1, r2], [r3])
 364     FNEG  s r1 r2       -> usage ([r1], [r2])
 365     FSQRT s r1 r2       -> usage ([r1], [r2])
 366     FSUB  s r1 r2 r3    -> usage ([r1, r2], [r3])
 367     FxTOy s1 s2 r1 r2   -> usage ([r1], [r2])
 368
 369     -- We assume that all local jumps will be BI/BF.  JMP must be out-of-line.
 370     JMP   dst addr      -> usage (regAddr addr, [])
 371
 372     CALL  (Left imm)  n True  -> noUsage
 373     CALL  (Left imm)  n False -> usage (argRegs n, callClobberedRegs)
 374     CALL  (Right reg) n True  -> usage ([reg], [])
 375     CALL  (Right reg) n False -> usage (reg : (argRegs n), callClobberedRegs)
 376
 377     _                   -> noUsage
 378   where
 379     usage (src, dst) = RU (regSetFromList (filter interesting src))
 380                           (regSetFromList (filter interesting dst))
 381
 382     regAddr (AddrRegReg r1 r2) = [r1, r2]
 383     regAddr (AddrRegImm r1 _)  = [r1]
 384
 385     regRI (RIReg r) = [r]
 386     regRI  _    = []
 387
 388 #endif /* sparc_TARGET_ARCH */
 389 -- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
 390 #if powerpc_TARGET_ARCH
 391
 392 regUsage instr = case instr of
 393     LD    sz reg addr   -> usage (regAddr addr, [reg])
 394     ST    sz reg addr   -> usage (reg : regAddr addr, [])
 395     STU    sz reg addr  -> usage (reg : regAddr addr, [])
 396     LIS   reg imm       -> usage ([], [reg])
 397     LI    reg imm       -> usage ([], [reg])
 398     MR    reg1 reg2     -> usage ([reg2], [reg1])
 399     CMP   sz reg ri     -> usage (reg : regRI ri,[])
 400     CMPL  sz reg ri     -> usage (reg : regRI ri,[])
 401     BCC   cond lbl      -> noUsage
 402     MTCTR reg           -> usage ([reg],[])
 403     BCTR  dsts          -> noUsage
 404     BL    imm params    -> usage (params, callClobberedRegs)
 405     BCTRL params        -> usage (params, callClobberedRegs)
 406     ADD   reg1 reg2 ri  -> usage (reg2 : regRI ri, [reg1])
 407     SUBF  reg1 reg2 reg3-> usage ([reg2,reg3], [reg1])
 408     MULLW reg1 reg2 ri  -> usage (reg2 : regRI ri, [reg1])
 409     DIVW  reg1 reg2 reg3-> usage ([reg2,reg3], [reg1])
 410     DIVWU reg1 reg2 reg3-> usage ([reg2,reg3], [reg1])
 411     AND   reg1 reg2 ri  -> usage (reg2 : regRI ri, [reg1])
 412     OR    reg1 reg2 ri  -> usage (reg2 : regRI ri, [reg1])
 413     XOR   reg1 reg2 ri  -> usage (reg2 : regRI ri, [reg1])
 414     XORIS reg1 reg2 imm -> usage ([reg2], [reg1])
 415     NEG   reg1 reg2     -> usage ([reg2], [reg1])
 416     NOT   reg1 reg2     -> usage ([reg2], [reg1])
 417     SLW   reg1 reg2 ri  -> usage (reg2 : regRI ri, [reg1])
 418     SRW   reg1 reg2 ri  -> usage (reg2 : regRI ri, [reg1])
 419     SRAW  reg1 reg2 ri  -> usage (reg2 : regRI ri, [reg1])
 420     FADD  sz r1 r2 r3   -> usage ([r2,r3], [r1])
 421     FSUB  sz r1 r2 r3   -> usage ([r2,r3], [r1])
 422     FMUL  sz r1 r2 r3   -> usage ([r2,r3], [r1])
 423     FDIV  sz r1 r2 r3   -> usage ([r2,r3], [r1])
 424     FNEG  r1 r2         -> usage ([r2], [r1])
 425     FCMP  r1 r2         -> usage ([r1,r2], [])
 426     FCTIWZ r1 r2        -> usage ([r2], [r1])
 427     _                   -> noUsage
 428   where
 429     usage (src, dst) = RU (regSetFromList (filter interesting src))
 430                           (regSetFromList (filter interesting dst))
 431     regAddr (AddrRegReg r1 r2) = [r1, r2]
 432     regAddr (AddrRegImm r1 _)  = [r1]
 433
 434     regRI (RIReg r) = [r]
 435     regRI  _    = []
 436 #endif /* powerpc_TARGET_ARCH */
 437 \end{code}
 438
 439
 440 %************************************************************************
 441 %*                                                                      *
 442 \subsection{Free, reserved, call-clobbered, and argument registers}
 443 %*                                                                      *
 444 %************************************************************************
 445
 446 @freeRegs@ is the list of registers we can use in register allocation.
 447 @freeReg@ (below) says if a particular register is free.
 448
 449 With a per-instruction clobber list, we might be able to get some of
 450 these back, but it's probably not worth the hassle.
 451
 452 @callClobberedRegs@ ... the obvious.
 453
 454 @argRegs@: assuming a call with N arguments, what registers will be
 455 used to hold arguments?  (NB: it doesn't know whether the arguments
 456 are integer or floating-point...)
 457
 458 findReservedRegs tells us which regs can be used as spill temporaries.
 459 The list of instructions for which we are attempting allocation is
 460 supplied.  This is so that we can (at least for x86) examine it to
 461 discover which registers are being used in a fixed way -- for example,
 462 %eax and %edx are used by integer division, so they can't be used as
 463 spill temporaries.  However, most instruction lists don't do integer
 464 division, so we don't want to rule them out altogether.
 465
 466 findReservedRegs returns not a list of spill temporaries, but a list
 467 of list of them.  This is so that the allocator can attempt allocating
 468 with at first no spill temps, then if that fails, increasing numbers.
 469 For x86 it is important that we minimise the number of regs reserved
 470 as spill temporaries, since there are so few.  For Alpha and Sparc
 471 this isn't a concern; we just ignore the supplied code list and return
 472 a singleton list which we know will satisfy all spill demands.
 473
 474 \begin{code}
 475 findReservedRegs :: [Instr] -> [[Reg]]
 476 findReservedRegs instrs
 477 #if alpha_TARGET_ARCH
 478   = --[[NCG_Reserved_I1, NCG_Reserved_I2,
 479     --  NCG_Reserved_F1, NCG_Reserved_F2]]
 480     error "findReservedRegs: alpha"
 481 #endif
 482 #if sparc_TARGET_ARCH
 483   = [[NCG_SpillTmp_I1, NCG_SpillTmp_I2,
 484       NCG_SpillTmp_D1, NCG_SpillTmp_D2,
 485       NCG_SpillTmp_F1, NCG_SpillTmp_F2]]
 486 #endif
 487 #if i386_TARGET_ARCH
 488   -- We can use %fake4 and %fake5 safely for float temps.
 489   -- Int regs are more troublesome.  Only %ecx and %edx are
 490   -- definitely.  At a pinch, we also could bag %eax if there
 491   -- are no ccalls, but so far we've never encountered
 492   -- a situation where three integer temporaries are necessary.
 493   --
 494   -- Because registers are in short supply on x86, we give the
 495   -- allocator a whole bunch of possibilities, starting with zero
 496   -- temporaries and working up to all that are available.  This
 497   -- is inefficient, but spills are pretty rare, so we don't care
 498   -- if the register allocator has to try half a dozen or so possibilities
 499   -- before getting to one that works.
 500   = let f1 = fake5
 501         f2 = fake4
 502         intregs_avail
 503            = [ecx, edx]
 504         possibilities
 505            = case intregs_avail of
 506                 [i1] -> [ [], [i1], [f1], [i1,f1], [f1,f2],
 507                           [i1,f1,f2] ]
 508
 509                 [i1,i2] -> [ [], [i1], [f1], [i1,i2], [i1,f1], [f1,f2],
 510                              [i1,i2,f1], [i1,f1,f2], [i1,i2,f1,f2] ]
 511     in
 512         possibilities
 513 #endif
 514 #if powerpc_TARGET_ARCH
 515   = [[NCG_SpillTmp_I1, NCG_SpillTmp_I2,
 516       NCG_SpillTmp_D1, NCG_SpillTmp_D2]]
 517 #endif
 518 \end{code}
 519
 520 %************************************************************************
 521 %*                                                                      *
 522 \subsection{@InsnFuture@ type; @insnFuture@ function}
 523 %*                                                                      *
 524 %************************************************************************
 525
 526 @insnFuture@ indicates the places we could get to following the
 527 current instruction.  This is used by the register allocator to
 528 compute the flow edges between instructions.
 529
 530 \begin{code}
 531 data InsnFuture
 532    = NoFuture              -- makes a non-local jump; for the purposes of
 533                            -- register allocation, it exits our domain
 534    | Next                  -- falls through to next insn
 535    | Branch CLabel         -- unconditional branch to the label
 536    | NextOrBranch CLabel   -- conditional branch to the label
 537    | MultiFuture [CLabel]  -- multiple specific futures
 538
 539 --instance Outputable InsnFuture where
 540 --   ppr NoFuture            = text "NoFuture"
 541 --   ppr Next                = text "Next"
 542 --   ppr (Branch clbl)       = text "(Branch " <> ppr clbl <> char ')'
 543 --   ppr (NextOrBranch clbl) = text "(NextOrBranch " <> ppr clbl <> char ')'
 544
 545
 546 insnFuture insn
 547  = case insn of
 548
 549 #if alpha_TARGET_ARCH
 550
 551     -- We assume that all local jumps will be BI/BF.  JMP must be out-of-line.
 552
 553     BR (ImmCLbl lbl)     -> RL (lookup lbl) future
 554     BI _ _ (ImmCLbl lbl) -> RL (lookup lbl `unionRegSets` live) future
 555     BF _ _ (ImmCLbl lbl) -> RL (lookup lbl `unionRegSets` live) future
 556     JMP _ _ _            -> RL emptyRegSet future
 557     BSR _ _              -> RL live future
 558     JSR _ _ _            -> RL live future
 559     LABEL lbl            -> RL live (FL (all `unionRegSets` live) (addToFM env lbl live))
 560     _                    -> info
 561
 562 #endif /* alpha_TARGET_ARCH */
 563 -- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
 564 #if i386_TARGET_ARCH
 565
 566     -- conditional jump
 567     JXX _ clbl | isAsmTemp clbl -> NextOrBranch clbl
 568     JXX _ _ -> panic "insnFuture: conditional jump to non-local label"
 569
 570     -- If the insn says what its dests are, use em!
 571     JMP (DestInfo dsts) _ -> MultiFuture dsts
 572
 573     -- unconditional jump to local label
 574     JMP NoDestInfo (OpImm (ImmCLbl clbl)) | isAsmTemp clbl -> Branch clbl
 575
 576     -- unconditional jump to non-local label
 577     JMP NoDestInfo lbl  -> NoFuture
 578
 579     -- be extra-paranoid
 580     JMP _ _ -> panic "insnFuture(x86): JMP wierdness"
 581
 582     boring      -> Next
 583
 584 #endif /* i386_TARGET_ARCH */
 585 -- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
 586 #if sparc_TARGET_ARCH
 587
 588     -- We assume that all local jumps will be BI/BF.
 589     BI ALWAYS _ (ImmCLbl clbl) -> Branch clbl
 590     BI other  _ (ImmCLbl clbl) -> NextOrBranch clbl
 591     BI other  _ _ -> panic "nativeGen(sparc):insnFuture(BI)"
 592
 593     BF ALWAYS _ (ImmCLbl clbl) -> Branch clbl
 594     BF other  _ (ImmCLbl clbl) -> NextOrBranch clbl
 595     BF other  _ _ -> panic "nativeGen(sparc):insnFuture(BF)"
 596
 597     -- CALL(terminal) must be out-of-line.  JMP is not out-of-line
 598     -- iff it specifies its destinations.
 599     JMP NoDestInfo _      -> NoFuture  -- n.b. NoFuture == MultiFuture []
 600     JMP (DestInfo dsts) _ -> MultiFuture dsts
 601
 602     CALL _ _ True         -> NoFuture
 603
 604     boring -> Next
 605
 606 #endif /* sparc_TARGET_ARCH */
 607 -- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
 608 #if powerpc_TARGET_ARCH
 609     BCC ALWAYS clbl | isAsmTemp clbl -> Branch clbl
 610                     | otherwise -> NoFuture
 611     BCC _ clbl      | isAsmTemp clbl -> NextOrBranch clbl
 612     BCC _ _ -> panic "insnFuture: conditional jump to non-local label"
 613
 614     BCTR (DestInfo dsts) -> MultiFuture dsts
 615     BCTR NoDestInfo -> NoFuture
 616     boring      -> Next
 617 #endif /* powerpc_TARGET_ARCH */
 618 \end{code}
 619
 620 %************************************************************************
 621 %*                                                                      *
 622 \subsection{@patchRegs@ function}
 623 %*                                                                      *
 624 %************************************************************************
 625
 626 @patchRegs@ takes an instruction (possibly with
 627 MemoryReg/UnmappedReg registers) and changes all register references
 628 according to the supplied environment.
 629
 630 \begin{code}
 631 patchRegs :: Instr -> (Reg -> Reg) -> Instr
 632
 633 #if alpha_TARGET_ARCH
 634
 635 patchRegs instr env = case instr of
 636     LD sz reg addr -> LD sz (env reg) (fixAddr addr)
 637     LDA reg addr -> LDA (env reg) (fixAddr addr)
 638     LDAH reg addr -> LDAH (env reg) (fixAddr addr)
 639     LDGP reg addr -> LDGP (env reg) (fixAddr addr)
 640     LDI sz reg imm -> LDI sz (env reg) imm
 641     ST sz reg addr -> ST sz (env reg) (fixAddr addr)
 642     CLR reg -> CLR (env reg)
 643     ABS sz ar reg -> ABS sz (fixRI ar) (env reg)
 644     NEG sz ov ar reg -> NEG sz ov (fixRI ar) (env reg)
 645     ADD sz ov r1 ar r2 -> ADD sz ov (env r1) (fixRI ar) (env r2)
 646     SADD sz sc r1 ar r2 -> SADD sz sc (env r1) (fixRI ar) (env r2)
 647     SUB sz ov r1 ar r2 -> SUB sz ov (env r1) (fixRI ar) (env r2)
 648     SSUB sz sc r1 ar r2 -> SSUB sz sc (env r1) (fixRI ar) (env r2)
 649     MUL sz ov r1 ar r2 -> MUL sz ov (env r1) (fixRI ar) (env r2)
 650     DIV sz un r1 ar r2 -> DIV sz un (env r1) (fixRI ar) (env r2)
 651     REM sz un r1 ar r2 -> REM sz un (env r1) (fixRI ar) (env r2)
 652     NOT ar reg -> NOT (fixRI ar) (env reg)
 653     AND r1 ar r2 -> AND (env r1) (fixRI ar) (env r2)
 654     ANDNOT r1 ar r2 -> ANDNOT (env r1) (fixRI ar) (env r2)
 655     OR r1 ar r2 -> OR (env r1) (fixRI ar) (env r2)
 656     ORNOT r1 ar r2 -> ORNOT (env r1) (fixRI ar) (env r2)
 657     XOR r1 ar r2 -> XOR (env r1) (fixRI ar) (env r2)
 658     XORNOT r1 ar r2 -> XORNOT (env r1) (fixRI ar) (env r2)
 659     SLL r1 ar r2 -> SLL (env r1) (fixRI ar) (env r2)
 660     SRL r1 ar r2 -> SRL (env r1) (fixRI ar) (env r2)
 661     SRA r1 ar r2 -> SRA (env r1) (fixRI ar) (env r2)
 662     ZAP r1 ar r2 -> ZAP (env r1) (fixRI ar) (env r2)
 663     ZAPNOT r1 ar r2 -> ZAPNOT (env r1) (fixRI ar) (env r2)
 664     CMP co r1 ar r2 -> CMP co (env r1) (fixRI ar) (env r2)
 665     FCLR reg -> FCLR (env reg)
 666     FABS r1 r2 -> FABS (env r1) (env r2)
 667     FNEG s r1 r2 -> FNEG s (env r1) (env r2)
 668     FADD s r1 r2 r3 -> FADD s (env r1) (env r2) (env r3)
 669     FDIV s r1 r2 r3 -> FDIV s (env r1) (env r2) (env r3)
 670     FMUL s r1 r2 r3 -> FMUL s (env r1) (env r2) (env r3)
 671     FSUB s r1 r2 r3 -> FSUB s (env r1) (env r2) (env r3)
 672     CVTxy s1 s2 r1 r2 -> CVTxy s1 s2 (env r1) (env r2)
 673     FCMP s co r1 r2 r3 -> FCMP s co (env r1) (env r2) (env r3)
 674     FMOV r1 r2 -> FMOV (env r1) (env r2)
 675     BI cond reg lbl -> BI cond (env reg) lbl
 676     BF cond reg lbl -> BF cond (env reg) lbl
 677     JMP reg addr hint -> JMP (env reg) (fixAddr addr) hint
 678     JSR reg addr i -> JSR (env reg) (fixAddr addr) i
 679     _ -> instr
 680   where
 681     fixAddr (AddrReg r1)       = AddrReg (env r1)
 682     fixAddr (AddrRegImm r1 i)  = AddrRegImm (env r1) i
 683     fixAddr other              = other
 684
 685     fixRI (RIReg r) = RIReg (env r)
 686     fixRI other = other
 687
 688 #endif /* alpha_TARGET_ARCH */
 689 -- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
 690 #if i386_TARGET_ARCH
 691
 692 patchRegs instr env = case instr of
 693     MOV  sz src dst     -> patch2 (MOV  sz) src dst
 694     MOVZxL sz src dst   -> patch2 (MOVZxL sz) src dst
 695     MOVSxL sz src dst   -> patch2 (MOVSxL sz) src dst
 696     LEA  sz src dst     -> patch2 (LEA  sz) src dst
 697     ADD  sz src dst     -> patch2 (ADD  sz) src dst
 698     SUB  sz src dst     -> patch2 (SUB  sz) src dst
 699     IMUL sz src dst     -> patch2 (IMUL sz) src dst
 700     IMUL64  sd1 sd2     -> IMUL64 (env sd1) (env sd2)
 701     MUL sz src dst      -> patch2 (MUL sz) src dst
 702     IQUOT sz src dst    -> patch2 (IQUOT sz) src dst
 703     IREM sz src dst     -> patch2 (IREM sz) src dst
 704     QUOT sz src dst     -> patch2 (QUOT sz) src dst
 705     REM sz src dst      -> patch2 (REM sz) src dst
 706     AND  sz src dst     -> patch2 (AND  sz) src dst
 707     OR   sz src dst     -> patch2 (OR   sz) src dst
 708     XOR  sz src dst     -> patch2 (XOR  sz) src dst
 709     NOT  sz op          -> patch1 (NOT  sz) op
 710     NEGI sz op          -> patch1 (NEGI sz) op
 711     SHL  sz imm dst     -> patch1 (SHL sz imm) dst
 712     SAR  sz imm dst     -> patch1 (SAR sz imm) dst
 713     SHR  sz imm dst     -> patch1 (SHR sz imm) dst
 714     BT   sz imm src     -> patch1 (BT  sz imm) src
 715     TEST sz src dst     -> patch2 (TEST sz) src dst
 716     CMP  sz src dst     -> patch2 (CMP  sz) src dst
 717     PUSH sz op          -> patch1 (PUSH sz) op
 718     POP  sz op          -> patch1 (POP  sz) op
 719     SETCC cond op       -> patch1 (SETCC cond) op
 720     JMP dsts op         -> patch1 (JMP dsts) op
 721
 722     GMOV src dst        -> GMOV (env src) (env dst)
 723     GLD sz src dst      -> GLD sz (lookupAddr src) (env dst)
 724     GST sz src dst      -> GST sz (env src) (lookupAddr dst)
 725
 726     GLDZ dst            -> GLDZ (env dst)
 727     GLD1 dst            -> GLD1 (env dst)
 728
 729     GFTOI src dst       -> GFTOI (env src) (env dst)
 730     GDTOI src dst       -> GDTOI (env src) (env dst)
 731
 732     GITOF src dst       -> GITOF (env src) (env dst)
 733     GITOD src dst       -> GITOD (env src) (env dst)
 734
 735     GADD sz s1 s2 dst   -> GADD sz (env s1) (env s2) (env dst)
 736     GSUB sz s1 s2 dst   -> GSUB sz (env s1) (env s2) (env dst)
 737     GMUL sz s1 s2 dst   -> GMUL sz (env s1) (env s2) (env dst)
 738     GDIV sz s1 s2 dst   -> GDIV sz (env s1) (env s2) (env dst)
 739
 740     GCMP sz src1 src2   -> GCMP sz (env src1) (env src2)
 741     GABS sz src dst     -> GABS sz (env src) (env dst)
 742     GNEG sz src dst     -> GNEG sz (env src) (env dst)
 743     GSQRT sz src dst    -> GSQRT sz (env src) (env dst)
 744     GSIN sz src dst     -> GSIN sz (env src) (env dst)
 745     GCOS sz src dst     -> GCOS sz (env src) (env dst)
 746     GTAN sz src dst     -> GTAN sz (env src) (env dst)
 747
 748     CALL (Left imm)     -> instr
 749     CALL (Right reg)    -> CALL (Right (env reg))
 750
 751     COMMENT _           -> instr
 752     SEGMENT _           -> instr
 753     LABEL _             -> instr
 754     ASCII _ _           -> instr
 755     DATA _ _            -> instr
 756     DELTA _             -> instr
 757     JXX _ _             -> instr
 758     CLTD                -> instr
 759     _                   -> pprPanic "patchRegs(x86)" empty
 760
 761   where
 762     patch1 insn op      = insn (patchOp op)
 763     patch2 insn src dst = insn (patchOp src) (patchOp dst)
 764
 765     patchOp (OpReg  reg) = OpReg (env reg)
 766     patchOp (OpImm  imm) = OpImm imm
 767     patchOp (OpAddr ea)  = OpAddr (lookupAddr ea)
 768
 769     lookupAddr (ImmAddr imm off) = ImmAddr imm off
 770     lookupAddr (AddrBaseIndex base index disp)
 771       = AddrBaseIndex (lookupBase base) (lookupIndex index) disp
 772       where
 773         lookupBase Nothing       = Nothing
 774         lookupBase (Just r)      = Just (env r)
 775
 776         lookupIndex Nothing      = Nothing
 777         lookupIndex (Just (r,i)) = Just (env r, i)
 778
 779 #endif /* i386_TARGET_ARCH */
 780 -- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
 781 #if sparc_TARGET_ARCH
 782
 783 patchRegs instr env = case instr of
 784     LD    sz addr reg   -> LD sz (fixAddr addr) (env reg)
 785     ST    sz reg addr   -> ST sz (env reg) (fixAddr addr)
 786     ADD   x cc r1 ar r2 -> ADD x cc (env r1) (fixRI ar) (env r2)
 787     SUB   x cc r1 ar r2 -> SUB x cc (env r1) (fixRI ar) (env r2)
 788     UMUL    cc r1 ar r2 -> UMUL cc (env r1) (fixRI ar) (env r2)
 789     SMUL    cc r1 ar r2 -> SMUL cc (env r1) (fixRI ar) (env r2)
 790     RDY   rd            -> RDY (env rd)
 791     AND   b r1 ar r2    -> AND b (env r1) (fixRI ar) (env r2)
 792     ANDN  b r1 ar r2    -> ANDN b (env r1) (fixRI ar) (env r2)
 793     OR    b r1 ar r2    -> OR b (env r1) (fixRI ar) (env r2)
 794     ORN   b r1 ar r2    -> ORN b (env r1) (fixRI ar) (env r2)
 795     XOR   b r1 ar r2    -> XOR b (env r1) (fixRI ar) (env r2)
 796     XNOR  b r1 ar r2    -> XNOR b (env r1) (fixRI ar) (env r2)
 797     SLL   r1 ar r2      -> SLL (env r1) (fixRI ar) (env r2)
 798     SRL   r1 ar r2      -> SRL (env r1) (fixRI ar) (env r2)
 799     SRA   r1 ar r2      -> SRA (env r1) (fixRI ar) (env r2)
 800     SETHI imm reg       -> SETHI imm (env reg)
 801     FABS  s r1 r2       -> FABS s (env r1) (env r2)
 802     FADD  s r1 r2 r3    -> FADD s (env r1) (env r2) (env r3)
 803     FCMP  e s r1 r2     -> FCMP e s (env r1) (env r2)
 804     FDIV  s r1 r2 r3    -> FDIV s (env r1) (env r2) (env r3)
 805     FMOV  s r1 r2       -> FMOV s (env r1) (env r2)
 806     FMUL  s r1 r2 r3    -> FMUL s (env r1) (env r2) (env r3)
 807     FNEG  s r1 r2       -> FNEG s (env r1) (env r2)
 808     FSQRT s r1 r2       -> FSQRT s (env r1) (env r2)
 809     FSUB  s r1 r2 r3    -> FSUB s (env r1) (env r2) (env r3)
 810     FxTOy s1 s2 r1 r2   -> FxTOy s1 s2 (env r1) (env r2)
 811     JMP   dsts addr     -> JMP dsts (fixAddr addr)
 812     CALL  (Left i) n t  -> CALL (Left i) n t
 813     CALL  (Right r) n t -> CALL (Right (env r)) n t
 814     _ -> instr
 815   where
 816     fixAddr (AddrRegReg r1 r2) = AddrRegReg (env r1) (env r2)
 817     fixAddr (AddrRegImm r1 i)  = AddrRegImm (env r1) i
 818
 819     fixRI (RIReg r) = RIReg (env r)
 820     fixRI other = other
 821
 822 #endif /* sparc_TARGET_ARCH */
 823 -- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
 824 #if powerpc_TARGET_ARCH
 825
 826 patchRegs instr env = case instr of
 827     LD    sz reg addr   -> LD sz (env reg) (fixAddr addr)
 828     ST    sz reg addr   -> ST sz (env reg) (fixAddr addr)
 829     STU    sz reg addr  -> STU sz (env reg) (fixAddr addr)
 830     LIS   reg imm       -> LIS (env reg) imm
 831     LI    reg imm       -> LI (env reg) imm
 832     MR    reg1 reg2     -> MR (env reg1) (env reg2)
 833     CMP   sz reg ri     -> CMP sz (env reg) (fixRI ri)
 834     CMPL  sz reg ri     -> CMPL sz (env reg) (fixRI ri)
 835     BCC   cond lbl      -> BCC cond lbl
 836     MTCTR reg           -> MTCTR (env reg)
 837     BCTR  dsts          -> BCTR dsts
 838     BL    imm argRegs   -> BL imm argRegs       -- argument regs
 839     BCTRL argRegs       -> BCTRL argRegs        -- cannot be remapped
 840     ADD   reg1 reg2 ri  -> ADD (env reg1) (env reg2) (fixRI ri)
 841     SUBF  reg1 reg2 reg3-> SUBF (env reg1) (env reg2) (env reg3)
 842     MULLW reg1 reg2 ri  -> MULLW (env reg1) (env reg2) (fixRI ri)
 843     DIVW  reg1 reg2 reg3-> DIVW (env reg1) (env reg2) (env reg3)
 844     DIVWU reg1 reg2 reg3-> DIVWU (env reg1) (env reg2) (env reg3)
 845     AND   reg1 reg2 ri  -> AND (env reg1) (env reg2) (fixRI ri)
 846     OR    reg1 reg2 ri  -> OR  (env reg1) (env reg2) (fixRI ri)
 847     XOR   reg1 reg2 ri  -> XOR (env reg1) (env reg2) (fixRI ri)
 848     XORIS reg1 reg2 imm -> XORIS (env reg1) (env reg2) imm
 849     NEG   reg1 reg2     -> NEG (env reg1) (env reg2)
 850     NOT   reg1 reg2     -> NOT (env reg1) (env reg2)
 851     SLW   reg1 reg2 ri  -> SLW (env reg1) (env reg2) (fixRI ri)
 852     SRW   reg1 reg2 ri  -> SRW (env reg1) (env reg2) (fixRI ri)
 853     SRAW  reg1 reg2 ri  -> SRAW (env reg1) (env reg2) (fixRI ri)
 854     FADD  sz r1 r2 r3   -> FADD sz (env r1) (env r2) (env r3)
 855     FSUB  sz r1 r2 r3   -> FSUB sz (env r1) (env r2) (env r3)
 856     FMUL  sz r1 r2 r3   -> FMUL sz (env r1) (env r2) (env r3)
 857     FDIV  sz r1 r2 r3   -> FDIV sz (env r1) (env r2) (env r3)
 858     FNEG  r1 r2         -> FNEG (env r1) (env r2)
 859     FCMP  r1 r2         -> FCMP (env r1) (env r2)
 860     FCTIWZ r1 r2        -> FCTIWZ (env r1) (env r2)
 861     _ -> instr
 862   where
 863     fixAddr (AddrRegReg r1 r2) = AddrRegReg (env r1) (env r2)
 864     fixAddr (AddrRegImm r1 i)  = AddrRegImm (env r1) i
 865
 866     fixRI (RIReg r) = RIReg (env r)
 867     fixRI other = other
 868 #endif /* powerpc_TARGET_ARCH */
 869 \end{code}
 870
 871 %************************************************************************
 872 %*                                                                      *
 873 \subsection{@spillReg@ and @loadReg@ functions}
 874 %*                                                                      *
 875 %************************************************************************
 876
 877 Spill to memory, and load it back...
 878
 879 JRS, 000122: on x86, don't spill directly above the stack pointer,
 880 since some insn sequences (int <-> conversions) use this as a temp
 881 location.  Leave 8 words (ie, 64 bytes for a 64-bit arch) of slop.
 882
 883 \begin{code}
 884 spillSlotSize :: Int
 885 spillSlotSize = IF_ARCH_alpha( 8, IF_ARCH_sparc( 8, IF_ARCH_i386( 12, IF_ARCH_powerpc( 8, ))))
 886
 887 maxSpillSlots :: Int
 888 maxSpillSlots = ((rESERVED_C_STACK_BYTES - 64) `div` spillSlotSize) - 1
 889
 890 -- convert a spill slot number to a *byte* offset, with no sign:
 891 -- decide on a per arch basis whether you are spilling above or below
 892 -- the C stack pointer.
 893 spillSlotToOffset :: Int -> Int
 894 spillSlotToOffset slot
 895    | slot >= 0 && slot < maxSpillSlots
 896    = 64 + spillSlotSize * slot
 897    | otherwise
 898    = pprPanic "spillSlotToOffset:"
 899               (text "invalid spill location: " <> int slot)
 900
 901 vregToSpillSlot :: FiniteMap VRegUnique Int -> VRegUnique -> Int
 902 vregToSpillSlot vreg_to_slot_map u
 903    = case lookupFM vreg_to_slot_map u of
 904         Just xx -> xx
 905         Nothing -> pprPanic "vregToSpillSlot: unmapped vreg" (pprVRegUnique u)
 906
 907
 908 spillReg, loadReg :: FiniteMap VRegUnique Int -> Int -> Reg -> Reg -> Instr
 909
 910 spillReg vreg_to_slot_map delta dyn vreg
 911   | isVirtualReg vreg
 912   = let slot_no = vregToSpillSlot vreg_to_slot_map (getVRegUnique vreg)
 913         off     = spillSlotToOffset slot_no
 914     in
 915         {-Alpha: spill below the stack pointer (?)-}
 916          IF_ARCH_alpha( ST sz dyn (spRel (- (off `div` 8)))
 917
 918         {-I386: spill above stack pointer leaving 3 words/spill-}
 919         ,IF_ARCH_i386 ( let off_w = (off-delta) `div` 4
 920                         in case regClass vreg of {
 921                               RcInteger -> MOV L (OpReg dyn) (OpAddr (spRel off_w));
 922                               _         -> GST F80 dyn (spRel off_w)} {- RcFloat/RcDouble -}
 923
 924         {-SPARC: spill below frame pointer leaving 2 words/spill-}
 925         ,IF_ARCH_sparc(
 926                         let{off_w = 1 + (off `div` 4);
 927                             sz = case regClass vreg of {
 928                                     RcInteger -> W;
 929                                     RcFloat   -> F;
 930                                     RcDouble  -> DF}}
 931                         in ST sz dyn (fpRel (- off_w))
 932         ,IF_ARCH_powerpc(
 933                         let{sz = case regClass vreg of {
 934                                     RcInteger -> W;
 935                                     RcFloat   -> F;
 936                                     RcDouble  -> DF}}
 937                         in ST sz dyn (AddrRegImm sp (ImmInt (off-delta)))
 938         ,))))
 939
 940
 941 loadReg vreg_to_slot_map delta vreg dyn
 942   | isVirtualReg vreg
 943   = let slot_no = vregToSpillSlot vreg_to_slot_map (getVRegUnique vreg)
 944         off     = spillSlotToOffset slot_no
 945     in
 946          IF_ARCH_alpha( LD  sz dyn (spRel (- (off `div` 8)))
 947
 948         ,IF_ARCH_i386 ( let off_w = (off-delta) `div` 4
 949                         in case regClass vreg of {
 950                               RcInteger -> MOV L (OpAddr (spRel off_w)) (OpReg dyn);
 951                               _         -> GLD F80 (spRel off_w) dyn} {- RcFloat/RcDouble -}
 952
 953         ,IF_ARCH_sparc(
 954                         let{off_w = 1 + (off `div` 4);
 955                             sz = case regClass vreg of {
 956                                    RcInteger -> W;
 957                                    RcFloat   -> F;
 958                                    RcDouble  -> DF}}
 959                         in LD sz (fpRel (- off_w)) dyn
 960         ,IF_ARCH_powerpc(
 961                         let{sz = case regClass vreg of {
 962                                     RcInteger -> W;
 963                                     RcFloat   -> F;
 964                                     RcDouble  -> DF}}
 965                         in LD sz dyn (AddrRegImm sp (ImmInt (off-delta)))
 966         ,))))
 967 \end{code}