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