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 MachMisc
  41 import MachRegs
  42 import Stix             ( DestInfo(..) )
  43 import CLabel           ( pprCLabel_asm, 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 \end{code}
  49
  50 %************************************************************************
  51 %*                                                                      *
  52 \subsection{Sets of registers}
  53 %*                                                                      *
  54 %************************************************************************
  55
  56 \begin{code}
  57
  58 -- Blargh.  Use ghc stuff soon!  Or: perhaps that's not such a good
  59 -- idea.  Most of these sets are either empty or very small, and it
  60 -- might be that the overheads of the FiniteMap based set implementation
  61 -- is a net loss.  The same might be true of FeSets.
  62
  63 newtype RegSet = MkRegSet [Reg]
  64
  65 regSetFromList xs
  66    = MkRegSet (nukeDups (sort xs))
  67      where nukeDups :: [Reg] -> [Reg]
  68            nukeDups []  = []
  69            nukeDups [x] = [x]
  70            nukeDups (x:y:xys)
  71               = if x == y then nukeDups (y:xys)
  72                           else x : nukeDups (y:xys)
  73
  74 regSetToList   (MkRegSet xs)                 = xs
  75 isEmptyRegSet  (MkRegSet xs)                 = null xs
  76 emptyRegSet                                  = MkRegSet []
  77 eqRegSets      (MkRegSet xs1) (MkRegSet xs2) = xs1 == xs2
  78 unitRegSet x                                 = MkRegSet [x]
  79 filterRegSet p (MkRegSet xs)                 = MkRegSet (filter p xs)
  80
  81 elemRegSet x (MkRegSet xs)
  82    = f xs
  83      where
  84         f []     = False
  85         f (y:ys) | x == y    = True
  86                  | x < y     = False
  87                  | otherwise = f ys
  88
  89 unionRegSets (MkRegSet xs1) (MkRegSet xs2)
  90    = MkRegSet (f xs1 xs2)
  91      where
  92         f [] bs = bs
  93         f as [] = as
  94         f (a:as) (b:bs)
  95            | a < b      = a : f as (b:bs)
  96            | a > b      = b : f (a:as) bs
  97            | otherwise  = a : f as bs
  98
  99 minusRegSets (MkRegSet xs1) (MkRegSet xs2)
 100    = MkRegSet (f xs1 xs2)
 101      where
 102         f [] bs = []
 103         f as [] = as
 104         f (a:as) (b:bs)
 105            | a < b      = a : f as (b:bs)
 106            | a > b      = f (a:as) bs
 107            | otherwise  = f as bs
 108
 109 intersectionRegSets (MkRegSet xs1) (MkRegSet xs2)
 110    = MkRegSet (f xs1 xs2)
 111      where
 112         f [] bs = []
 113         f as [] = []
 114         f (a:as) (b:bs)
 115            | a < b      = f as (b:bs)
 116            | a > b      = f (a:as) bs
 117            | otherwise  = a : f as bs
 118 \end{code}
 119
 120 %************************************************************************
 121 %*                                                                      *
 122 \subsection{@RegUsage@ type; @noUsage@, @endUsage@, @regUsage@ functions}
 123 %*                                                                      *
 124 %************************************************************************
 125
 126 @regUsage@ returns the sets of src and destination registers used by a
 127 particular instruction.  Machine registers that are pre-allocated to
 128 stgRegs are filtered out, because they are uninteresting from a
 129 register allocation standpoint.  (We wouldn't want them to end up on
 130 the free list!)  As far as we are concerned, the fixed registers
 131 simply don't exist (for allocation purposes, anyway).
 132
 133 regUsage doesn't need to do any trickery for jumps and such.  Just
 134 state precisely the regs read and written by that insn.  The
 135 consequences of control flow transfers, as far as register allocation
 136 goes, are taken care of by @insnFuture@.
 137
 138 \begin{code}
 139 data RegUsage = RU RegSet RegSet
 140
 141 noUsage :: RegUsage
 142 noUsage  = RU emptyRegSet emptyRegSet
 143
 144 regUsage :: Instr -> RegUsage
 145
 146 interesting (VirtualRegI _)  = True
 147 interesting (VirtualRegF _)  = True
 148 interesting (VirtualRegD _)  = True
 149 interesting (RealReg (I# i)) = _IS_TRUE_(freeReg i)
 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    dsts 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     -- Registers defd when an operand is written.
 313     def_W (OpReg reg)  = [reg]
 314     def_W (OpAddr ea)  = []
 315
 316     -- Registers used when an operand is read.
 317     use_R (OpReg reg)  = [reg]
 318     use_R (OpImm imm)  = []
 319     use_R (OpAddr ea)  = use_EA ea
 320
 321     -- Registers used to compute an effective address.
 322     use_EA (ImmAddr _ _)                           = []
 323     use_EA (AddrBaseIndex Nothing  Nothing      _) = []
 324     use_EA (AddrBaseIndex (Just b) Nothing      _) = [b]
 325     use_EA (AddrBaseIndex Nothing  (Just (i,_)) _) = [i]
 326     use_EA (AddrBaseIndex (Just b) (Just (i,_)) _) = [b,i]
 327
 328     mkRU src dst = RU (regSetFromList (filter interesting src))
 329                       (regSetFromList (filter interesting dst))
 330
 331 -- Allow the spiller to de\cide whether or not it can use
 332 -- %edx as a spill temporary.
 333 hasFixedEDX instr
 334    = case instr of
 335         IDIV _ _ -> True
 336         CLTD     -> True
 337         other    -> False
 338
 339 #endif {- i386_TARGET_ARCH -}
 340 -- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
 341 #if sparc_TARGET_ARCH
 342
 343 regUsage instr = case instr of
 344     LD    sz addr reg   -> usage (regAddr addr, [reg])
 345     ST    sz reg addr   -> usage (reg : regAddr addr, [])
 346     ADD   x cc r1 ar r2 -> usage (r1 : regRI ar, [r2])
 347     SUB   x cc r1 ar r2 -> usage (r1 : regRI ar, [r2])
 348     AND   b r1 ar r2    -> usage (r1 : regRI ar, [r2])
 349     ANDN  b r1 ar r2    -> usage (r1 : regRI ar, [r2])
 350     OR    b r1 ar r2    -> usage (r1 : regRI ar, [r2])
 351     ORN   b r1 ar r2    -> usage (r1 : regRI ar, [r2])
 352     XOR   b r1 ar r2    -> usage (r1 : regRI ar, [r2])
 353     XNOR  b r1 ar r2    -> usage (r1 : regRI ar, [r2])
 354     SLL   r1 ar r2      -> usage (r1 : regRI ar, [r2])
 355     SRL   r1 ar r2      -> usage (r1 : regRI ar, [r2])
 356     SRA   r1 ar r2      -> usage (r1 : regRI ar, [r2])
 357     SETHI imm reg       -> usage ([], [reg])
 358     FABS  s r1 r2       -> usage ([r1], [r2])
 359     FADD  s r1 r2 r3    -> usage ([r1, r2], [r3])
 360     FCMP  e s r1 r2     -> usage ([r1, r2], [])
 361     FDIV  s r1 r2 r3    -> usage ([r1, r2], [r3])
 362     FMOV  s r1 r2       -> usage ([r1], [r2])
 363     FMUL  s r1 r2 r3    -> usage ([r1, r2], [r3])
 364     FNEG  s r1 r2       -> usage ([r1], [r2])
 365     FSQRT s r1 r2       -> usage ([r1], [r2])
 366     FSUB  s r1 r2 r3    -> usage ([r1, r2], [r3])
 367     FxTOy s1 s2 r1 r2   -> usage ([r1], [r2])
 368
 369     -- We assume that all local jumps will be BI/BF.  JMP must be out-of-line.
 370     JMP   addr          -> usage (regAddr addr, [])
 371
 372     CALL  _ n True      -> noUsage
 373     CALL  _ n False     -> usage (argRegs n, callClobberedRegs)
 374
 375     _                   -> noUsage
 376   where
 377     usage (src, dst) = RU (regSetFromList (filter interesting src))
 378                           (regSetFromList (filter interesting dst))
 379
 380     regAddr (AddrRegReg r1 r2) = [r1, r2]
 381     regAddr (AddrRegImm r1 _)  = [r1]
 382
 383     regRI (RIReg r) = [r]
 384     regRI  _    = []
 385
 386 #endif {- sparc_TARGET_ARCH -}
 387 \end{code}
 388
 389
 390 %************************************************************************
 391 %*                                                                      *
 392 \subsection{Free, reserved, call-clobbered, and argument registers}
 393 %*                                                                      *
 394 %************************************************************************
 395
 396 @freeRegs@ is the list of registers we can use in register allocation.
 397 @freeReg@ (below) says if a particular register is free.
 398
 399 With a per-instruction clobber list, we might be able to get some of
 400 these back, but it's probably not worth the hassle.
 401
 402 @callClobberedRegs@ ... the obvious.
 403
 404 @argRegs@: assuming a call with N arguments, what registers will be
 405 used to hold arguments?  (NB: it doesn't know whether the arguments
 406 are integer or floating-point...)
 407
 408 findReservedRegs tells us which regs can be used as spill temporaries.
 409 The list of instructions for which we are attempting allocation is
 410 supplied.  This is so that we can (at least for x86) examine it to
 411 discover which registers are being used in a fixed way -- for example,
 412 %eax and %edx are used by integer division, so they can't be used as
 413 spill temporaries.  However, most instruction lists don't do integer
 414 division, so we don't want to rule them out altogether.
 415
 416 findReservedRegs returns not a list of spill temporaries, but a list
 417 of list of them.  This is so that the allocator can attempt allocating
 418 with at first no spill temps, then if that fails, increasing numbers.
 419 For x86 it is important that we minimise the number of regs reserved
 420 as spill temporaries, since there are so few.  For Alpha and Sparc
 421 this isn't a concern; we just ignore the supplied code list and return
 422 a singleton list which we know will satisfy all spill demands.
 423
 424 \begin{code}
 425 findReservedRegs :: [Instr] -> [[Reg]]
 426 findReservedRegs instrs
 427 #if alpha_TARGET_ARCH
 428   = --[[NCG_Reserved_I1, NCG_Reserved_I2,
 429     --  NCG_Reserved_F1, NCG_Reserved_F2]]
 430     error "findReservedRegs: alpha"
 431 #endif
 432 #if sparc_TARGET_ARCH
 433   = [[NCG_SpillTmp_I1, NCG_SpillTmp_I2,
 434       NCG_SpillTmp_D1, NCG_SpillTmp_D2,
 435       NCG_SpillTmp_F1, NCG_SpillTmp_F2]]
 436 #endif
 437 #if i386_TARGET_ARCH
 438   -- We can use %fake4 and %fake5 safely for float temps.
 439   -- Int regs are more troublesome.  Only %ecx is definitely
 440   -- available.  If there are no division insns, we can use %edx
 441   -- too.  At a pinch, we also could bag %eax if there are no
 442   -- divisions and no ccalls, but so far we've never encountered
 443   -- a situation where three integer temporaries are necessary.
 444   --
 445   -- Because registers are in short supply on x86, we give the
 446   -- allocator a whole bunch of possibilities, starting with zero
 447   -- temporaries and working up to all that are available.  This
 448   -- is inefficient, but spills are pretty rare, so we don't care
 449   -- if the register allocator has to try half a dozen or so possibilities
 450   -- before getting to one that works.
 451   = let f1 = fake5
 452         f2 = fake4
 453         intregs_avail
 454            = ecx : if any hasFixedEDX instrs then [] else [edx]
 455         possibilities
 456            = case intregs_avail of
 457                 [i1] -> [ [], [i1], [f1], [i1,f1], [f1,f2],
 458                           [i1,f1,f2] ]
 459
 460                 [i1,i2] -> [ [], [i1], [f1], [i1,i2], [i1,f1], [f1,f2],
 461                              [i1,i2,f1], [i1,f1,f2], [i1,i2,f1,f2] ]
 462     in
 463         possibilities
 464 #endif
 465 \end{code}
 466
 467 %************************************************************************
 468 %*                                                                      *
 469 \subsection{@InsnFuture@ type; @insnFuture@ function}
 470 %*                                                                      *
 471 %************************************************************************
 472
 473 @insnFuture@ indicates the places we could get to following the
 474 current instruction.  This is used by the register allocator to
 475 compute the flow edges between instructions.
 476
 477 \begin{code}
 478 data InsnFuture
 479    = NoFuture              -- makes a non-local jump; for the purposes of
 480                            -- register allocation, it exits our domain
 481    | Next                  -- falls through to next insn
 482    | Branch CLabel         -- unconditional branch to the label
 483    | NextOrBranch CLabel   -- conditional branch to the label
 484    | MultiFuture [CLabel]  -- multiple specific futures
 485
 486 --instance Outputable InsnFuture where
 487 --   ppr NoFuture            = text "NoFuture"
 488 --   ppr Next                = text "Next"
 489 --   ppr (Branch clbl)       = text "(Branch " <> ppr clbl <> char ')'
 490 --   ppr (NextOrBranch clbl) = text "(NextOrBranch " <> ppr clbl <> char ')'
 491
 492
 493 insnFuture insn
 494  = case insn of
 495
 496 #if alpha_TARGET_ARCH
 497
 498     -- We assume that all local jumps will be BI/BF.  JMP must be out-of-line.
 499
 500     BR (ImmCLbl lbl)     -> RL (lookup lbl) future
 501     BI _ _ (ImmCLbl lbl) -> RL (lookup lbl `unionRegSets` live) future
 502     BF _ _ (ImmCLbl lbl) -> RL (lookup lbl `unionRegSets` live) future
 503     JMP _ _ _            -> RL emptyRegSet future
 504     BSR _ _              -> RL live future
 505     JSR _ _ _            -> RL live future
 506     LABEL lbl            -> RL live (FL (all `unionRegSets` live) (addToFM env lbl live))
 507     _                    -> info
 508
 509 #endif {- alpha_TARGET_ARCH -}
 510 -- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
 511 #if i386_TARGET_ARCH
 512
 513     -- conditional jump
 514     JXX _ clbl | isAsmTemp clbl -> NextOrBranch clbl
 515     JXX _ _ -> panic "insnFuture: conditional jump to non-local label"
 516
 517     -- If the insn says what its dests are, use em!
 518     JMP (DestInfo dsts) _ -> MultiFuture dsts
 519
 520     -- unconditional jump to local label
 521     JMP NoDestInfo (OpImm (ImmCLbl clbl)) | isAsmTemp clbl -> Branch clbl
 522
 523     -- unconditional jump to non-local label
 524     JMP NoDestInfo lbl  -> NoFuture
 525
 526     -- be extra-paranoid
 527     JMP _ _ -> panic "insnFuture(x86): JMP wierdness"
 528
 529     boring      -> Next
 530
 531 #endif {- i386_TARGET_ARCH -}
 532 -- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
 533 #if sparc_TARGET_ARCH
 534
 535     -- We assume that all local jumps will be BI/BF.
 536     BI ALWAYS _ (ImmCLbl clbl) -> Branch clbl
 537     BI other  _ (ImmCLbl clbl) -> NextOrBranch clbl
 538     BI other  _ _ -> panic "nativeGen(sparc):insnFuture(BI)"
 539
 540     BF ALWAYS _ (ImmCLbl clbl) -> Branch clbl
 541     BF other  _ (ImmCLbl clbl) -> NextOrBranch clbl
 542     BF other  _ _ -> panic "nativeGen(sparc):insnFuture(BF)"
 543
 544     -- JMP and CALL(terminal) must be out-of-line.
 545     JMP _         -> NoFuture
 546     CALL _ _ True -> NoFuture
 547
 548     boring -> Next
 549
 550 #endif {- sparc_TARGET_ARCH -}
 551 \end{code}
 552
 553 %************************************************************************
 554 %*                                                                      *
 555 \subsection{@patchRegs@ function}
 556 %*                                                                      *
 557 %************************************************************************
 558
 559 @patchRegs@ takes an instruction (possibly with
 560 MemoryReg/UnmappedReg registers) and changes all register references
 561 according to the supplied environment.
 562
 563 \begin{code}
 564 patchRegs :: Instr -> (Reg -> Reg) -> Instr
 565
 566 #if alpha_TARGET_ARCH
 567
 568 patchRegs instr env = case instr of
 569     LD sz reg addr -> LD sz (env reg) (fixAddr addr)
 570     LDA reg addr -> LDA (env reg) (fixAddr addr)
 571     LDAH reg addr -> LDAH (env reg) (fixAddr addr)
 572     LDGP reg addr -> LDGP (env reg) (fixAddr addr)
 573     LDI sz reg imm -> LDI sz (env reg) imm
 574     ST sz reg addr -> ST sz (env reg) (fixAddr addr)
 575     CLR reg -> CLR (env reg)
 576     ABS sz ar reg -> ABS sz (fixRI ar) (env reg)
 577     NEG sz ov ar reg -> NEG sz ov (fixRI ar) (env reg)
 578     ADD sz ov r1 ar r2 -> ADD sz ov (env r1) (fixRI ar) (env r2)
 579     SADD sz sc r1 ar r2 -> SADD sz sc (env r1) (fixRI ar) (env r2)
 580     SUB sz ov r1 ar r2 -> SUB sz ov (env r1) (fixRI ar) (env r2)
 581     SSUB sz sc r1 ar r2 -> SSUB sz sc (env r1) (fixRI ar) (env r2)
 582     MUL sz ov r1 ar r2 -> MUL sz ov (env r1) (fixRI ar) (env r2)
 583     DIV sz un r1 ar r2 -> DIV sz un (env r1) (fixRI ar) (env r2)
 584     REM sz un r1 ar r2 -> REM sz un (env r1) (fixRI ar) (env r2)
 585     NOT ar reg -> NOT (fixRI ar) (env reg)
 586     AND r1 ar r2 -> AND (env r1) (fixRI ar) (env r2)
 587     ANDNOT r1 ar r2 -> ANDNOT (env r1) (fixRI ar) (env r2)
 588     OR r1 ar r2 -> OR (env r1) (fixRI ar) (env r2)
 589     ORNOT r1 ar r2 -> ORNOT (env r1) (fixRI ar) (env r2)
 590     XOR r1 ar r2 -> XOR (env r1) (fixRI ar) (env r2)
 591     XORNOT r1 ar r2 -> XORNOT (env r1) (fixRI ar) (env r2)
 592     SLL r1 ar r2 -> SLL (env r1) (fixRI ar) (env r2)
 593     SRL r1 ar r2 -> SRL (env r1) (fixRI ar) (env r2)
 594     SRA r1 ar r2 -> SRA (env r1) (fixRI ar) (env r2)
 595     ZAP r1 ar r2 -> ZAP (env r1) (fixRI ar) (env r2)
 596     ZAPNOT r1 ar r2 -> ZAPNOT (env r1) (fixRI ar) (env r2)
 597     CMP co r1 ar r2 -> CMP co (env r1) (fixRI ar) (env r2)
 598     FCLR reg -> FCLR (env reg)
 599     FABS r1 r2 -> FABS (env r1) (env r2)
 600     FNEG s r1 r2 -> FNEG s (env r1) (env r2)
 601     FADD s r1 r2 r3 -> FADD s (env r1) (env r2) (env r3)
 602     FDIV s r1 r2 r3 -> FDIV s (env r1) (env r2) (env r3)
 603     FMUL s r1 r2 r3 -> FMUL s (env r1) (env r2) (env r3)
 604     FSUB s r1 r2 r3 -> FSUB s (env r1) (env r2) (env r3)
 605     CVTxy s1 s2 r1 r2 -> CVTxy s1 s2 (env r1) (env r2)
 606     FCMP s co r1 r2 r3 -> FCMP s co (env r1) (env r2) (env r3)
 607     FMOV r1 r2 -> FMOV (env r1) (env r2)
 608     BI cond reg lbl -> BI cond (env reg) lbl
 609     BF cond reg lbl -> BF cond (env reg) lbl
 610     JMP reg addr hint -> JMP (env reg) (fixAddr addr) hint
 611     JSR reg addr i -> JSR (env reg) (fixAddr addr) i
 612     _ -> instr
 613   where
 614     fixAddr (AddrReg r1)       = AddrReg (env r1)
 615     fixAddr (AddrRegImm r1 i)  = AddrRegImm (env r1) i
 616     fixAddr other              = other
 617
 618     fixRI (RIReg r) = RIReg (env r)
 619     fixRI other = other
 620
 621 #endif {- alpha_TARGET_ARCH -}
 622 -- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
 623 #if i386_TARGET_ARCH
 624
 625 patchRegs instr env = case instr of
 626     MOV  sz src dst     -> patch2 (MOV  sz) src dst
 627     MOVZxL sz src dst   -> patch2 (MOVZxL sz) src dst
 628     MOVSxL sz src dst   -> patch2 (MOVSxL sz) src dst
 629     LEA  sz src dst     -> patch2 (LEA  sz) src dst
 630     ADD  sz src dst     -> patch2 (ADD  sz) src dst
 631     SUB  sz src dst     -> patch2 (SUB  sz) src dst
 632     IMUL sz src dst     -> patch2 (IMUL sz) src dst
 633     IDIV sz src         -> patch1 (IDIV sz) src
 634     AND  sz src dst     -> patch2 (AND  sz) src dst
 635     OR   sz src dst     -> patch2 (OR   sz) src dst
 636     XOR  sz src dst     -> patch2 (XOR  sz) src dst
 637     NOT  sz op          -> patch1 (NOT  sz) op
 638     NEGI sz op          -> patch1 (NEGI sz) op
 639     SHL  sz imm dst     -> patch1 (SHL sz imm) dst
 640     SAR  sz imm dst     -> patch1 (SAR sz imm) dst
 641     SHR  sz imm dst     -> patch1 (SHR sz imm) dst
 642     BT   sz imm src     -> patch1 (BT  sz imm) src
 643     TEST sz src dst     -> patch2 (TEST sz) src dst
 644     CMP  sz src dst     -> patch2 (CMP  sz) src dst
 645     PUSH sz op          -> patch1 (PUSH sz) op
 646     POP  sz op          -> patch1 (POP  sz) op
 647     SETCC cond op       -> patch1 (SETCC cond) op
 648     JMP dsts op         -> patch1 (JMP dsts) op
 649
 650     GMOV src dst        -> GMOV (env src) (env dst)
 651     GLD sz src dst      -> GLD sz (lookupAddr src) (env dst)
 652     GST sz src dst      -> GST sz (env src) (lookupAddr dst)
 653
 654     GLDZ dst            -> GLDZ (env dst)
 655     GLD1 dst            -> GLD1 (env dst)
 656
 657     GFTOD src dst       -> GFTOD (env src) (env dst)
 658     GFTOI src dst       -> GFTOI (env src) (env dst)
 659
 660     GDTOF src dst       -> GDTOF (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 "patchInstr(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 addr -> JMP (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, and eventually
 759 StixInteger) use this as a temp location.  Leave 8 words (ie, 64 bytes
 760 for a 64-bit arch) of slop.
 761
 762 \begin{code}
 763 spillSlotSize :: Int
 764 spillSlotSize = IF_ARCH_alpha( 8, IF_ARCH_sparc( 8, IF_ARCH_i386( 12, )))
 765
 766 maxSpillSlots :: Int
 767 maxSpillSlots = ((rESERVED_C_STACK_BYTES - 64) `div` spillSlotSize) - 1
 768
 769 -- convert a spill slot number to a *byte* offset, with no sign:
 770 -- decide on a per arch basis whether you are spilling above or below
 771 -- the C stack pointer.
 772 spillSlotToOffset :: Int -> Int
 773 spillSlotToOffset slot
 774    | slot >= 0 && slot < maxSpillSlots
 775    = 64 + spillSlotSize * slot
 776    | otherwise
 777    = pprPanic "spillSlotToOffset:"
 778               (text "invalid spill location: " <> int slot)
 779
 780 vregToSpillSlot :: FiniteMap Unique Int -> Unique -> Int
 781 vregToSpillSlot vreg_to_slot_map u
 782    = case lookupFM vreg_to_slot_map u of
 783         Just xx -> xx
 784         Nothing -> pprPanic "vregToSpillSlot: unmapped vreg" (ppr u)
 785
 786
 787 spillReg, loadReg :: FiniteMap Unique Int -> Int -> Reg -> Reg -> Instr
 788
 789 spillReg vreg_to_slot_map delta dyn vreg
 790   | isVirtualReg vreg
 791   = let slot_no = vregToSpillSlot vreg_to_slot_map (getUnique vreg)
 792         off     = spillSlotToOffset slot_no
 793     in
 794         {-Alpha: spill below the stack pointer (?)-}
 795          IF_ARCH_alpha( ST sz dyn (spRel (- (off `div` 8)))
 796
 797         {-I386: spill above stack pointer leaving 3 words/spill-}
 798         ,IF_ARCH_i386 ( let off_w = (off-delta) `div` 4
 799                         in case regClass vreg of
 800                               RcInteger -> MOV L (OpReg dyn) (OpAddr (spRel off_w))
 801                               _         -> GST F80 dyn (spRel off_w) -- RcFloat/RcDouble
 802
 803         {-SPARC: spill below frame pointer leaving 2 words/spill-}
 804         ,IF_ARCH_sparc(
 805                         let off_w = 1 + (off `div` 4)
 806                             sz = case regClass vreg of
 807                                     RcInteger -> W
 808                                     RcFloat   -> F
 809                                     RcDouble  -> DF
 810                         in ST sz dyn (fpRel (- off_w))
 811         ,)))
 812
 813
 814 loadReg vreg_to_slot_map delta vreg dyn
 815   | isVirtualReg vreg
 816   = let slot_no = vregToSpillSlot vreg_to_slot_map (getUnique vreg)
 817         off     = spillSlotToOffset slot_no
 818     in
 819          IF_ARCH_alpha( LD  sz dyn (spRel (- (off `div` 8)))
 820
 821         ,IF_ARCH_i386 ( let off_w = (off-delta) `div` 4
 822                         in case regClass vreg of
 823                               RcInteger -> MOV L (OpAddr (spRel off_w)) (OpReg dyn)
 824                               _         -> GLD F80 (spRel off_w) dyn -- RcFloat/RcDouble
 825
 826         ,IF_ARCH_sparc(
 827                         let off_w = 1 + (off `div` 4)
 828                             sz = case regClass vreg of
 829                                    RcInteger -> W
 830                                    RcFloat   -> F
 831                                    RcDouble  -> DF
 832                         in LD sz (fpRel (- off_w)) dyn
 833         ,)))
 834 \end{code}