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@, @endUsage@, @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   imm          -> mkRU [] callClobberedRegs
 263     CLTD                -> mkRU [eax] [edx]
 264     NOP                 -> mkRU [] []
 265
 266     GMOV   src dst      -> mkRU [src] [dst]
 267     GLD    sz src dst   -> mkRU (use_EA src) [dst]
 268     GST    sz src dst   -> mkRU (src : use_EA dst) []
 269
 270     GLDZ   dst          -> mkRU [] [dst]
 271     GLD1   dst          -> mkRU [] [dst]
 272
 273     GFTOI  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     -- Registers defd when an operand is written.
 317     def_W (OpReg reg)  = [reg]
 318     def_W (OpAddr ea)  = []
 319
 320     -- Registers used when an operand is read.
 321     use_R (OpReg reg)  = [reg]
 322     use_R (OpImm imm)  = []
 323     use_R (OpAddr ea)  = use_EA ea
 324
 325     -- Registers used to compute an effective address.
 326     use_EA (ImmAddr _ _)                           = []
 327     use_EA (AddrBaseIndex Nothing  Nothing      _) = []
 328     use_EA (AddrBaseIndex (Just b) Nothing      _) = [b]
 329     use_EA (AddrBaseIndex Nothing  (Just (i,_)) _) = [i]
 330     use_EA (AddrBaseIndex (Just b) (Just (i,_)) _) = [b,i]
 331
 332     mkRU src dst = RU (regSetFromList (filter interesting src))
 333                       (regSetFromList (filter interesting dst))
 334
 335 #endif {- i386_TARGET_ARCH -}
 336 -- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
 337 #if sparc_TARGET_ARCH
 338
 339 regUsage instr = case instr of
 340     LD    sz addr reg   -> usage (regAddr addr, [reg])
 341     ST    sz reg addr   -> usage (reg : regAddr addr, [])
 342     ADD   x cc r1 ar r2 -> usage (r1 : regRI ar, [r2])
 343     SUB   x cc r1 ar r2 -> usage (r1 : regRI ar, [r2])
 344     AND   b r1 ar r2    -> usage (r1 : regRI ar, [r2])
 345     ANDN  b r1 ar r2    -> usage (r1 : regRI ar, [r2])
 346     OR    b r1 ar r2    -> usage (r1 : regRI ar, [r2])
 347     ORN   b r1 ar r2    -> usage (r1 : regRI ar, [r2])
 348     XOR   b r1 ar r2    -> usage (r1 : regRI ar, [r2])
 349     XNOR  b r1 ar r2    -> usage (r1 : regRI ar, [r2])
 350     SLL   r1 ar r2      -> usage (r1 : regRI ar, [r2])
 351     SRL   r1 ar r2      -> usage (r1 : regRI ar, [r2])
 352     SRA   r1 ar r2      -> usage (r1 : regRI ar, [r2])
 353     SETHI imm reg       -> usage ([], [reg])
 354     FABS  s r1 r2       -> usage ([r1], [r2])
 355     FADD  s r1 r2 r3    -> usage ([r1, r2], [r3])
 356     FCMP  e s r1 r2     -> usage ([r1, r2], [])
 357     FDIV  s r1 r2 r3    -> usage ([r1, r2], [r3])
 358     FMOV  s r1 r2       -> usage ([r1], [r2])
 359     FMUL  s r1 r2 r3    -> usage ([r1, r2], [r3])
 360     FNEG  s r1 r2       -> usage ([r1], [r2])
 361     FSQRT s r1 r2       -> usage ([r1], [r2])
 362     FSUB  s r1 r2 r3    -> usage ([r1, r2], [r3])
 363     FxTOy s1 s2 r1 r2   -> usage ([r1], [r2])
 364
 365     -- We assume that all local jumps will be BI/BF.  JMP must be out-of-line.
 366     JMP   dst addr      -> usage (regAddr addr, [])
 367
 368     CALL  _ n True      -> noUsage
 369     CALL  _ n False     -> usage (argRegs n, callClobberedRegs)
 370
 371     _                   -> noUsage
 372   where
 373     usage (src, dst) = RU (regSetFromList (filter interesting src))
 374                           (regSetFromList (filter interesting dst))
 375
 376     regAddr (AddrRegReg r1 r2) = [r1, r2]
 377     regAddr (AddrRegImm r1 _)  = [r1]
 378
 379     regRI (RIReg r) = [r]
 380     regRI  _    = []
 381
 382 #endif {- sparc_TARGET_ARCH -}
 383 \end{code}
 384
 385
 386 %************************************************************************
 387 %*                                                                      *
 388 \subsection{Free, reserved, call-clobbered, and argument registers}
 389 %*                                                                      *
 390 %************************************************************************
 391
 392 @freeRegs@ is the list of registers we can use in register allocation.
 393 @freeReg@ (below) says if a particular register is free.
 394
 395 With a per-instruction clobber list, we might be able to get some of
 396 these back, but it's probably not worth the hassle.
 397
 398 @callClobberedRegs@ ... the obvious.
 399
 400 @argRegs@: assuming a call with N arguments, what registers will be
 401 used to hold arguments?  (NB: it doesn't know whether the arguments
 402 are integer or floating-point...)
 403
 404 findReservedRegs tells us which regs can be used as spill temporaries.
 405 The list of instructions for which we are attempting allocation is
 406 supplied.  This is so that we can (at least for x86) examine it to
 407 discover which registers are being used in a fixed way -- for example,
 408 %eax and %edx are used by integer division, so they can't be used as
 409 spill temporaries.  However, most instruction lists don't do integer
 410 division, so we don't want to rule them out altogether.
 411
 412 findReservedRegs returns not a list of spill temporaries, but a list
 413 of list of them.  This is so that the allocator can attempt allocating
 414 with at first no spill temps, then if that fails, increasing numbers.
 415 For x86 it is important that we minimise the number of regs reserved
 416 as spill temporaries, since there are so few.  For Alpha and Sparc
 417 this isn't a concern; we just ignore the supplied code list and return
 418 a singleton list which we know will satisfy all spill demands.
 419
 420 \begin{code}
 421 findReservedRegs :: [Instr] -> [[Reg]]
 422 findReservedRegs instrs
 423 #if alpha_TARGET_ARCH
 424   = --[[NCG_Reserved_I1, NCG_Reserved_I2,
 425     --  NCG_Reserved_F1, NCG_Reserved_F2]]
 426     error "findReservedRegs: alpha"
 427 #endif
 428 #if sparc_TARGET_ARCH
 429   = [[NCG_SpillTmp_I1, NCG_SpillTmp_I2,
 430       NCG_SpillTmp_D1, NCG_SpillTmp_D2,
 431       NCG_SpillTmp_F1, NCG_SpillTmp_F2]]
 432 #endif
 433 #if i386_TARGET_ARCH
 434   -- We can use %fake4 and %fake5 safely for float temps.
 435   -- Int regs are more troublesome.  Only %ecx and %edx are
 436   -- definitely.  At a pinch, we also could bag %eax if there
 437   -- are no ccalls, but so far we've never encountered
 438   -- a situation where three integer temporaries are necessary.
 439   --
 440   -- Because registers are in short supply on x86, we give the
 441   -- allocator a whole bunch of possibilities, starting with zero
 442   -- temporaries and working up to all that are available.  This
 443   -- is inefficient, but spills are pretty rare, so we don't care
 444   -- if the register allocator has to try half a dozen or so possibilities
 445   -- before getting to one that works.
 446   = let f1 = fake5
 447         f2 = fake4
 448         intregs_avail
 449            = [ecx, edx]
 450         possibilities
 451            = case intregs_avail of
 452                 [i1] -> [ [], [i1], [f1], [i1,f1], [f1,f2],
 453                           [i1,f1,f2] ]
 454
 455                 [i1,i2] -> [ [], [i1], [f1], [i1,i2], [i1,f1], [f1,f2],
 456                              [i1,i2,f1], [i1,f1,f2], [i1,i2,f1,f2] ]
 457     in
 458         possibilities
 459 #endif
 460 \end{code}
 461
 462 %************************************************************************
 463 %*                                                                      *
 464 \subsection{@InsnFuture@ type; @insnFuture@ function}
 465 %*                                                                      *
 466 %************************************************************************
 467
 468 @insnFuture@ indicates the places we could get to following the
 469 current instruction.  This is used by the register allocator to
 470 compute the flow edges between instructions.
 471
 472 \begin{code}
 473 data InsnFuture
 474    = NoFuture              -- makes a non-local jump; for the purposes of
 475                            -- register allocation, it exits our domain
 476    | Next                  -- falls through to next insn
 477    | Branch CLabel         -- unconditional branch to the label
 478    | NextOrBranch CLabel   -- conditional branch to the label
 479    | MultiFuture [CLabel]  -- multiple specific futures
 480
 481 --instance Outputable InsnFuture where
 482 --   ppr NoFuture            = text "NoFuture"
 483 --   ppr Next                = text "Next"
 484 --   ppr (Branch clbl)       = text "(Branch " <> ppr clbl <> char ')'
 485 --   ppr (NextOrBranch clbl) = text "(NextOrBranch " <> ppr clbl <> char ')'
 486
 487
 488 insnFuture insn
 489  = case insn of
 490
 491 #if alpha_TARGET_ARCH
 492
 493     -- We assume that all local jumps will be BI/BF.  JMP must be out-of-line.
 494
 495     BR (ImmCLbl lbl)     -> RL (lookup lbl) future
 496     BI _ _ (ImmCLbl lbl) -> RL (lookup lbl `unionRegSets` live) future
 497     BF _ _ (ImmCLbl lbl) -> RL (lookup lbl `unionRegSets` live) future
 498     JMP _ _ _            -> RL emptyRegSet future
 499     BSR _ _              -> RL live future
 500     JSR _ _ _            -> RL live future
 501     LABEL lbl            -> RL live (FL (all `unionRegSets` live) (addToFM env lbl live))
 502     _                    -> info
 503
 504 #endif {- alpha_TARGET_ARCH -}
 505 -- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
 506 #if i386_TARGET_ARCH
 507
 508     -- conditional jump
 509     JXX _ clbl | isAsmTemp clbl -> NextOrBranch clbl
 510     JXX _ _ -> panic "insnFuture: conditional jump to non-local label"
 511
 512     -- If the insn says what its dests are, use em!
 513     JMP (DestInfo dsts) _ -> MultiFuture dsts
 514
 515     -- unconditional jump to local label
 516     JMP NoDestInfo (OpImm (ImmCLbl clbl)) | isAsmTemp clbl -> Branch clbl
 517
 518     -- unconditional jump to non-local label
 519     JMP NoDestInfo lbl  -> NoFuture
 520
 521     -- be extra-paranoid
 522     JMP _ _ -> panic "insnFuture(x86): JMP wierdness"
 523
 524     boring      -> Next
 525
 526 #endif {- i386_TARGET_ARCH -}
 527 -- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
 528 #if sparc_TARGET_ARCH
 529
 530     -- We assume that all local jumps will be BI/BF.
 531     BI ALWAYS _ (ImmCLbl clbl) -> Branch clbl
 532     BI other  _ (ImmCLbl clbl) -> NextOrBranch clbl
 533     BI other  _ _ -> panic "nativeGen(sparc):insnFuture(BI)"
 534
 535     BF ALWAYS _ (ImmCLbl clbl) -> Branch clbl
 536     BF other  _ (ImmCLbl clbl) -> NextOrBranch clbl
 537     BF other  _ _ -> panic "nativeGen(sparc):insnFuture(BF)"
 538
 539     -- CALL(terminal) must be out-of-line.  JMP is not out-of-line
 540     -- iff it specifies its destinations.
 541     JMP NoDestInfo _      -> NoFuture  -- n.b. NoFuture == MultiFuture []
 542     JMP (DestInfo dsts) _ -> MultiFuture dsts
 543
 544     CALL _ _ True         -> NoFuture
 545
 546     boring -> Next
 547
 548 #endif {- sparc_TARGET_ARCH -}
 549 \end{code}
 550
 551 %************************************************************************
 552 %*                                                                      *
 553 \subsection{@patchRegs@ function}
 554 %*                                                                      *
 555 %************************************************************************
 556
 557 @patchRegs@ takes an instruction (possibly with
 558 MemoryReg/UnmappedReg registers) and changes all register references
 559 according to the supplied environment.
 560
 561 \begin{code}
 562 patchRegs :: Instr -> (Reg -> Reg) -> Instr
 563
 564 #if alpha_TARGET_ARCH
 565
 566 patchRegs instr env = case instr of
 567     LD sz reg addr -> LD sz (env reg) (fixAddr addr)
 568     LDA reg addr -> LDA (env reg) (fixAddr addr)
 569     LDAH reg addr -> LDAH (env reg) (fixAddr addr)
 570     LDGP reg addr -> LDGP (env reg) (fixAddr addr)
 571     LDI sz reg imm -> LDI sz (env reg) imm
 572     ST sz reg addr -> ST sz (env reg) (fixAddr addr)
 573     CLR reg -> CLR (env reg)
 574     ABS sz ar reg -> ABS sz (fixRI ar) (env reg)
 575     NEG sz ov ar reg -> NEG sz ov (fixRI ar) (env reg)
 576     ADD sz ov r1 ar r2 -> ADD sz ov (env r1) (fixRI ar) (env r2)
 577     SADD sz sc r1 ar r2 -> SADD sz sc (env r1) (fixRI ar) (env r2)
 578     SUB sz ov r1 ar r2 -> SUB sz ov (env r1) (fixRI ar) (env r2)
 579     SSUB sz sc r1 ar r2 -> SSUB sz sc (env r1) (fixRI ar) (env r2)
 580     MUL sz ov r1 ar r2 -> MUL sz ov (env r1) (fixRI ar) (env r2)
 581     DIV sz un r1 ar r2 -> DIV sz un (env r1) (fixRI ar) (env r2)
 582     REM sz un r1 ar r2 -> REM sz un (env r1) (fixRI ar) (env r2)
 583     NOT ar reg -> NOT (fixRI ar) (env reg)
 584     AND r1 ar r2 -> AND (env r1) (fixRI ar) (env r2)
 585     ANDNOT r1 ar r2 -> ANDNOT (env r1) (fixRI ar) (env r2)
 586     OR r1 ar r2 -> OR (env r1) (fixRI ar) (env r2)
 587     ORNOT r1 ar r2 -> ORNOT (env r1) (fixRI ar) (env r2)
 588     XOR r1 ar r2 -> XOR (env r1) (fixRI ar) (env r2)
 589     XORNOT r1 ar r2 -> XORNOT (env r1) (fixRI ar) (env r2)
 590     SLL r1 ar r2 -> SLL (env r1) (fixRI ar) (env r2)
 591     SRL r1 ar r2 -> SRL (env r1) (fixRI ar) (env r2)
 592     SRA r1 ar r2 -> SRA (env r1) (fixRI ar) (env r2)
 593     ZAP r1 ar r2 -> ZAP (env r1) (fixRI ar) (env r2)
 594     ZAPNOT r1 ar r2 -> ZAPNOT (env r1) (fixRI ar) (env r2)
 595     CMP co r1 ar r2 -> CMP co (env r1) (fixRI ar) (env r2)
 596     FCLR reg -> FCLR (env reg)
 597     FABS r1 r2 -> FABS (env r1) (env r2)
 598     FNEG s r1 r2 -> FNEG s (env r1) (env r2)
 599     FADD s r1 r2 r3 -> FADD s (env r1) (env r2) (env r3)
 600     FDIV s r1 r2 r3 -> FDIV s (env r1) (env r2) (env r3)
 601     FMUL s r1 r2 r3 -> FMUL s (env r1) (env r2) (env r3)
 602     FSUB s r1 r2 r3 -> FSUB s (env r1) (env r2) (env r3)
 603     CVTxy s1 s2 r1 r2 -> CVTxy s1 s2 (env r1) (env r2)
 604     FCMP s co r1 r2 r3 -> FCMP s co (env r1) (env r2) (env r3)
 605     FMOV r1 r2 -> FMOV (env r1) (env r2)
 606     BI cond reg lbl -> BI cond (env reg) lbl
 607     BF cond reg lbl -> BF cond (env reg) lbl
 608     JMP reg addr hint -> JMP (env reg) (fixAddr addr) hint
 609     JSR reg addr i -> JSR (env reg) (fixAddr addr) i
 610     _ -> instr
 611   where
 612     fixAddr (AddrReg r1)       = AddrReg (env r1)
 613     fixAddr (AddrRegImm r1 i)  = AddrRegImm (env r1) i
 614     fixAddr other              = other
 615
 616     fixRI (RIReg r) = RIReg (env r)
 617     fixRI other = other
 618
 619 #endif {- alpha_TARGET_ARCH -}
 620 -- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
 621 #if i386_TARGET_ARCH
 622
 623 patchRegs instr env = case instr of
 624     MOV  sz src dst     -> patch2 (MOV  sz) src dst
 625     MOVZxL sz src dst   -> patch2 (MOVZxL sz) src dst
 626     MOVSxL sz src dst   -> patch2 (MOVSxL sz) src dst
 627     LEA  sz src dst     -> patch2 (LEA  sz) src dst
 628     ADD  sz src dst     -> patch2 (ADD  sz) src dst
 629     SUB  sz src dst     -> patch2 (SUB  sz) src dst
 630     IMUL sz src dst     -> patch2 (IMUL sz) src dst
 631     IMUL64  sd1 sd2     -> IMUL64 (env sd1) (env sd2)
 632     MUL sz src dst      -> patch2 (MUL sz) src dst
 633     IQUOT sz src dst    -> patch2 (IQUOT sz) src dst
 634     IREM sz src dst     -> patch2 (IREM sz) src dst
 635     QUOT sz src dst     -> patch2 (QUOT sz) src dst
 636     REM sz src dst      -> patch2 (REM sz) src dst
 637     AND  sz src dst     -> patch2 (AND  sz) src dst
 638     OR   sz src dst     -> patch2 (OR   sz) src dst
 639     XOR  sz src dst     -> patch2 (XOR  sz) src dst
 640     NOT  sz op          -> patch1 (NOT  sz) op
 641     NEGI sz op          -> patch1 (NEGI sz) op
 642     SHL  sz imm dst     -> patch1 (SHL sz imm) dst
 643     SAR  sz imm dst     -> patch1 (SAR sz imm) dst
 644     SHR  sz imm dst     -> patch1 (SHR sz imm) dst
 645     BT   sz imm src     -> patch1 (BT  sz imm) src
 646     TEST sz src dst     -> patch2 (TEST sz) src dst
 647     CMP  sz src dst     -> patch2 (CMP  sz) src dst
 648     PUSH sz op          -> patch1 (PUSH sz) op
 649     POP  sz op          -> patch1 (POP  sz) op
 650     SETCC cond op       -> patch1 (SETCC cond) op
 651     JMP dsts op         -> patch1 (JMP dsts) op
 652
 653     GMOV src dst        -> GMOV (env src) (env dst)
 654     GLD sz src dst      -> GLD sz (lookupAddr src) (env dst)
 655     GST sz src dst      -> GST sz (env src) (lookupAddr dst)
 656
 657     GLDZ dst            -> GLDZ (env dst)
 658     GLD1 dst            -> GLD1 (env dst)
 659
 660     GFTOI src dst       -> GFTOI (env src) (env dst)
 661     GDTOI src dst       -> GDTOI (env src) (env dst)
 662
 663     GITOF src dst       -> GITOF (env src) (env dst)
 664     GITOD src dst       -> GITOD (env src) (env dst)
 665
 666     GADD sz s1 s2 dst   -> GADD sz (env s1) (env s2) (env dst)
 667     GSUB sz s1 s2 dst   -> GSUB sz (env s1) (env s2) (env dst)
 668     GMUL sz s1 s2 dst   -> GMUL sz (env s1) (env s2) (env dst)
 669     GDIV sz s1 s2 dst   -> GDIV sz (env s1) (env s2) (env dst)
 670
 671     GCMP sz src1 src2   -> GCMP sz (env src1) (env src2)
 672     GABS sz src dst     -> GABS sz (env src) (env dst)
 673     GNEG sz src dst     -> GNEG sz (env src) (env dst)
 674     GSQRT sz src dst    -> GSQRT sz (env src) (env dst)
 675     GSIN sz src dst     -> GSIN sz (env src) (env dst)
 676     GCOS sz src dst     -> GCOS sz (env src) (env dst)
 677     GTAN sz src dst     -> GTAN sz (env src) (env dst)
 678
 679     COMMENT _           -> instr
 680     SEGMENT _           -> instr
 681     LABEL _             -> instr
 682     ASCII _ _           -> instr
 683     DATA _ _            -> instr
 684     DELTA _             -> instr
 685     JXX _ _             -> instr
 686     CALL _              -> instr
 687     CLTD                -> instr
 688     _                   -> pprPanic "patchRegs(x86)" empty
 689
 690   where
 691     patch1 insn op      = insn (patchOp op)
 692     patch2 insn src dst = insn (patchOp src) (patchOp dst)
 693
 694     patchOp (OpReg  reg) = OpReg (env reg)
 695     patchOp (OpImm  imm) = OpImm imm
 696     patchOp (OpAddr ea)  = OpAddr (lookupAddr ea)
 697
 698     lookupAddr (ImmAddr imm off) = ImmAddr imm off
 699     lookupAddr (AddrBaseIndex base index disp)
 700       = AddrBaseIndex (lookupBase base) (lookupIndex index) disp
 701       where
 702         lookupBase Nothing       = Nothing
 703         lookupBase (Just r)      = Just (env r)
 704
 705         lookupIndex Nothing      = Nothing
 706         lookupIndex (Just (r,i)) = Just (env r, i)
 707
 708 #endif {- i386_TARGET_ARCH -}
 709 -- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
 710 #if sparc_TARGET_ARCH
 711
 712 patchRegs instr env = case instr of
 713     LD    sz addr reg   -> LD sz (fixAddr addr) (env reg)
 714     ST    sz reg addr   -> ST sz (env reg) (fixAddr addr)
 715     ADD   x cc r1 ar r2 -> ADD x cc (env r1) (fixRI ar) (env r2)
 716     SUB   x cc r1 ar r2 -> SUB x cc (env r1) (fixRI ar) (env r2)
 717     AND   b r1 ar r2    -> AND b (env r1) (fixRI ar) (env r2)
 718     ANDN  b r1 ar r2    -> ANDN b (env r1) (fixRI ar) (env r2)
 719     OR    b r1 ar r2    -> OR b (env r1) (fixRI ar) (env r2)
 720     ORN   b r1 ar r2    -> ORN b (env r1) (fixRI ar) (env r2)
 721     XOR   b r1 ar r2    -> XOR b (env r1) (fixRI ar) (env r2)
 722     XNOR  b r1 ar r2    -> XNOR b (env r1) (fixRI ar) (env r2)
 723     SLL   r1 ar r2      -> SLL (env r1) (fixRI ar) (env r2)
 724     SRL   r1 ar r2      -> SRL (env r1) (fixRI ar) (env r2)
 725     SRA   r1 ar r2      -> SRA (env r1) (fixRI ar) (env r2)
 726     SETHI imm reg       -> SETHI imm (env reg)
 727     FABS  s r1 r2       -> FABS s (env r1) (env r2)
 728     FADD  s r1 r2 r3    -> FADD s (env r1) (env r2) (env r3)
 729     FCMP  e s r1 r2     -> FCMP e s (env r1) (env r2)
 730     FDIV  s r1 r2 r3    -> FDIV s (env r1) (env r2) (env r3)
 731     FMOV  s r1 r2       -> FMOV s (env r1) (env r2)
 732     FMUL  s r1 r2 r3    -> FMUL s (env r1) (env r2) (env r3)
 733     FNEG  s r1 r2       -> FNEG s (env r1) (env r2)
 734     FSQRT s r1 r2       -> FSQRT s (env r1) (env r2)
 735     FSUB  s r1 r2 r3    -> FSUB s (env r1) (env r2) (env r3)
 736     FxTOy s1 s2 r1 r2   -> FxTOy s1 s2 (env r1) (env r2)
 737     JMP   dsts addr     -> JMP dsts (fixAddr addr)
 738     _ -> instr
 739   where
 740     fixAddr (AddrRegReg r1 r2) = AddrRegReg (env r1) (env r2)
 741     fixAddr (AddrRegImm r1 i)  = AddrRegImm (env r1) i
 742
 743     fixRI (RIReg r) = RIReg (env r)
 744     fixRI other = other
 745
 746 #endif {- sparc_TARGET_ARCH -}
 747 \end{code}
 748
 749 %************************************************************************
 750 %*                                                                      *
 751 \subsection{@spillReg@ and @loadReg@ functions}
 752 %*                                                                      *
 753 %************************************************************************
 754
 755 Spill to memory, and load it back...
 756
 757 JRS, 000122: on x86, don't spill directly above the stack pointer,
 758 since some insn sequences (int <-> conversions) use this as a temp
 759 location.  Leave 8 words (ie, 64 bytes for a 64-bit arch) of slop.
 760
 761 \begin{code}
 762 spillSlotSize :: Int
 763 spillSlotSize = IF_ARCH_alpha( 8, IF_ARCH_sparc( 8, IF_ARCH_i386( 12, )))
 764
 765 maxSpillSlots :: Int
 766 maxSpillSlots = ((rESERVED_C_STACK_BYTES - 64) `div` spillSlotSize) - 1
 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 + spillSlotSize * slot
 775    | otherwise
 776    = pprPanic "spillSlotToOffset:"
 777               (text "invalid spill location: " <> int slot)
 778
 779 vregToSpillSlot :: FiniteMap VRegUnique Int -> VRegUnique -> 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" (pprVRegUnique u)
 784
 785
 786 spillReg, loadReg :: FiniteMap VRegUnique 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 (getVRegUnique 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 case regClass vreg of
 799                               RcInteger -> MOV L (OpReg dyn) (OpAddr (spRel off_w))
 800                               _         -> GST F80 dyn (spRel off_w) -- RcFloat/RcDouble
 801
 802         {-SPARC: spill below frame pointer leaving 2 words/spill-}
 803         ,IF_ARCH_sparc(
 804                         let off_w = 1 + (off `div` 4)
 805                             sz = case regClass vreg of
 806                                     RcInteger -> W
 807                                     RcFloat   -> F
 808                                     RcDouble  -> DF
 809                         in ST sz dyn (fpRel (- off_w))
 810         ,)))
 811
 812
 813 loadReg vreg_to_slot_map delta vreg dyn
 814   | isVirtualReg vreg
 815   = let slot_no = vregToSpillSlot vreg_to_slot_map (getVRegUnique vreg)
 816         off     = spillSlotToOffset slot_no
 817     in
 818          IF_ARCH_alpha( LD  sz dyn (spRel (- (off `div` 8)))
 819
 820         ,IF_ARCH_i386 ( let off_w = (off-delta) `div` 4
 821                         in case regClass vreg of
 822                               RcInteger -> MOV L (OpAddr (spRel off_w)) (OpReg dyn)
 823                               _         -> GLD F80 (spRel off_w) dyn -- RcFloat/RcDouble
 824
 825         ,IF_ARCH_sparc(
 826                         let off_w = 1 + (off `div` 4)
 827                             sz = case regClass vreg of
 828                                    RcInteger -> W
 829                                    RcFloat   -> F
 830                                    RcDouble  -> DF
 831                         in LD sz (fpRel (- off_w)) dyn
 832         ,)))
 833 \end{code}