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