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