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