ghc/compiler/nativeGen/RegAllocInfo.lhs

   1 %
   2 % (c) The AQUA Project, Glasgow University, 1996-1998
   3 %
   4 \section[RegAllocInfo]{Machine-specific info used for register allocation}
   5
   6 The (machine-independent) allocator itself is in @AsmRegAlloc@.
   7
   8 \begin{code}
   9 #include "nativeGen/NCG.h"
  10
  11 module RegAllocInfo (
  12         RegUsage(..),
  13         noUsage,
  14         regUsage,
  15         InsnFuture(..),
  16         insnFuture,
  17
  18         loadReg,
  19         patchRegs,
  20         spillReg,
  21         findReservedRegs,
  22
  23         RegSet,
  24         regSetFromList,
  25         regSetToList,
  26         isEmptyRegSet,
  27         emptyRegSet,
  28         eqRegSets,
  29         filterRegSet,
  30         unitRegSet,
  31         elemRegSet,
  32         unionRegSets,
  33         minusRegSets,
  34         intersectionRegSets
  35     ) where
  36
  37 #include "HsVersions.h"
  38
  39 import List             ( partition, sort )
  40 import OrdList          ( unitOL )
  41 import MachMisc
  42 import MachRegs
  43 import MachCode         ( InstrBlock )
  44
  45 import BitSet           ( unitBS, mkBS, minusBS, unionBS, listBS, BitSet )
  46 import CLabel           ( pprCLabel_asm, isAsmTemp, CLabel{-instance Ord-} )
  47 import FiniteMap        ( addToFM, lookupFM, FiniteMap )
  48 import PrimRep          ( PrimRep(..) )
  49 import UniqSet          -- quite a bit of it
  50 import Outputable
  51 import Constants        ( rESERVED_C_STACK_BYTES )
  52 import Unique           ( Unique, Uniquable(..) )
  53 \end{code}
  54
  55 %************************************************************************
  56 %*                                                                      *
  57 \subsection{Sets of registers}
  58 %*                                                                      *
  59 %************************************************************************
  60
  61 \begin{code}
  62
  63 -- Blargh.  Use ghc stuff soon!  Or: perhaps that's not such a good
  64 -- idea.  Most of these sets are either empty or very small, and it
  65 -- might be that the overheads of the FiniteMap based set implementation
  66 -- is a net loss.  The same might be true of FeSets.
  67
  68 newtype RegSet = MkRegSet [Reg]
  69
  70 regSetFromList xs
  71    = MkRegSet (nukeDups (sort xs))
  72      where nukeDups :: [Reg] -> [Reg]
  73            nukeDups []  = []
  74            nukeDups [x] = [x]
  75            nukeDups (x:y:xys)
  76               = if x == y then nukeDups (y:xys)
  77                           else x : nukeDups (y:xys)
  78
  79 regSetToList   (MkRegSet xs)                 = xs
  80 isEmptyRegSet  (MkRegSet xs)                 = null xs
  81 emptyRegSet                                  = MkRegSet []
  82 eqRegSets      (MkRegSet xs1) (MkRegSet xs2) = xs1 == xs2
  83 unitRegSet x                                 = MkRegSet [x]
  84 filterRegSet p (MkRegSet xs)                 = MkRegSet (filter p xs)
  85
  86 elemRegSet x (MkRegSet xs)
  87    = f xs
  88      where
  89         f []     = False
  90         f (y:ys) | x == y    = True
  91                  | x < y     = False
  92                  | otherwise = f ys
  93
  94 unionRegSets (MkRegSet xs1) (MkRegSet xs2)
  95    = MkRegSet (f xs1 xs2)
  96      where
  97         f [] bs = bs
  98         f as [] = as
  99         f (a:as) (b:bs)
 100            | a < b      = a : f as (b:bs)
 101            | a > b      = b : f (a:as) bs
 102            | otherwise  = a : f as bs
 103
 104 minusRegSets (MkRegSet xs1) (MkRegSet xs2)
 105    = MkRegSet (f xs1 xs2)
 106      where
 107         f [] bs = []
 108         f as [] = as
 109         f (a:as) (b:bs)
 110            | a < b      = a : f as (b:bs)
 111            | a > b      = f (a:as) bs
 112            | otherwise  = f as bs
 113
 114 intersectionRegSets (MkRegSet xs1) (MkRegSet xs2)
 115    = MkRegSet (f xs1 xs2)
 116      where
 117         f [] bs = []
 118         f as [] = []
 119         f (a:as) (b:bs)
 120            | a < b      = f as (b:bs)
 121            | a > b      = f (a:as) bs
 122            | otherwise  = a : f as bs
 123 \end{code}
 124
 125 %************************************************************************
 126 %*                                                                      *
 127 \subsection{@RegUsage@ type; @noUsage@, @endUsage@, @regUsage@ functions}
 128 %*                                                                      *
 129 %************************************************************************
 130
 131 @regUsage@ returns the sets of src and destination registers used by a
 132 particular instruction.  Machine registers that are pre-allocated to
 133 stgRegs are filtered out, because they are uninteresting from a
 134 register allocation standpoint.  (We wouldn't want them to end up on
 135 the free list!)  As far as we are concerned, the fixed registers
 136 simply don't exist (for allocation purposes, anyway).
 137
 138 regUsage doesn't need to do any trickery for jumps and such.  Just
 139 state precisely the regs read and written by that insn.  The
 140 consequences of control flow transfers, as far as register allocation
 141 goes, are taken care of by @insnFuture@.
 142
 143 \begin{code}
 144 data RegUsage = RU RegSet RegSet
 145
 146 noUsage :: RegUsage
 147 noUsage  = RU emptyRegSet emptyRegSet
 148
 149 regUsage :: Instr -> RegUsage
 150
 151 interesting (VirtualRegI _)  = True
 152 interesting (VirtualRegF _)  = True
 153 interesting (VirtualRegD _)  = True
 154 interesting (RealReg (I# i)) = _IS_TRUE_(freeReg i)
 155
 156 #if alpha_TARGET_ARCH
 157
 158 regUsage instr = case instr of
 159     LD B reg addr       -> usage (regAddr addr, [reg, t9])
 160     LD BU reg addr      -> usage (regAddr addr, [reg, t9])
 161 --  LD W reg addr       -> usage (regAddr addr, [reg, t9]) : UNUSED
 162 --  LD WU reg addr      -> usage (regAddr addr, [reg, t9]) : UNUSED
 163     LD sz reg addr      -> usage (regAddr addr, [reg])
 164     LDA reg addr        -> usage (regAddr addr, [reg])
 165     LDAH reg addr       -> usage (regAddr addr, [reg])
 166     LDGP reg addr       -> usage (regAddr addr, [reg])
 167     LDI sz reg imm      -> usage ([], [reg])
 168     ST B reg addr       -> usage (reg : regAddr addr, [t9, t10])
 169 --  ST W reg addr       -> usage (reg : regAddr addr, [t9, t10]) : UNUSED
 170     ST sz reg addr      -> usage (reg : regAddr addr, [])
 171     CLR reg             -> usage ([], [reg])
 172     ABS sz ri reg       -> usage (regRI ri, [reg])
 173     NEG sz ov ri reg    -> usage (regRI ri, [reg])
 174     ADD sz ov r1 ar r2  -> usage (r1 : regRI ar, [r2])
 175     SADD sz sc r1 ar r2 -> usage (r1 : regRI ar, [r2])
 176     SUB sz ov r1 ar r2  -> usage (r1 : regRI ar, [r2])
 177     SSUB sz sc r1 ar r2 -> usage (r1 : regRI ar, [r2])
 178     MUL sz ov r1 ar r2  -> usage (r1 : regRI ar, [r2])
 179     DIV sz un r1 ar r2  -> usage (r1 : regRI ar, [r2, t9, t10, t11, t12])
 180     REM sz un r1 ar r2  -> usage (r1 : regRI ar, [r2, t9, t10, t11, t12])
 181     NOT ri reg          -> usage (regRI ri, [reg])
 182     AND r1 ar r2        -> usage (r1 : regRI ar, [r2])
 183     ANDNOT r1 ar r2     -> usage (r1 : regRI ar, [r2])
 184     OR r1 ar r2         -> usage (r1 : regRI ar, [r2])
 185     ORNOT r1 ar r2      -> usage (r1 : regRI ar, [r2])
 186     XOR r1 ar r2        -> usage (r1 : regRI ar, [r2])
 187     XORNOT r1 ar r2     -> usage (r1 : regRI ar, [r2])
 188     SLL r1 ar r2        -> usage (r1 : regRI ar, [r2])
 189     SRL r1 ar r2        -> usage (r1 : regRI ar, [r2])
 190     SRA r1 ar r2        -> usage (r1 : regRI ar, [r2])
 191     ZAP r1 ar r2        -> usage (r1 : regRI ar, [r2])
 192     ZAPNOT r1 ar r2     -> usage (r1 : regRI ar, [r2])
 193     CMP co r1 ar r2     -> usage (r1 : regRI ar, [r2])
 194     FCLR reg            -> usage ([], [reg])
 195     FABS r1 r2          -> usage ([r1], [r2])
 196     FNEG sz r1 r2       -> usage ([r1], [r2])
 197     FADD sz r1 r2 r3    -> usage ([r1, r2], [r3])
 198     FDIV sz r1 r2 r3    -> usage ([r1, r2], [r3])
 199     FMUL sz r1 r2 r3    -> usage ([r1, r2], [r3])
 200     FSUB sz r1 r2 r3    -> usage ([r1, r2], [r3])
 201     CVTxy sz1 sz2 r1 r2 -> usage ([r1], [r2])
 202     FCMP sz co r1 r2 r3 -> usage ([r1, r2], [r3])
 203     FMOV r1 r2          -> usage ([r1], [r2])
 204
 205
 206     -- We assume that all local jumps will be BI/BF/BR.  JMP must be out-of-line.
 207     BI cond reg lbl     -> usage ([reg], [])
 208     BF cond reg lbl     -> usage ([reg], [])
 209     JMP reg addr hint   -> RU (mkRegSet (filter interesting (regAddr addr))) freeRegSet
 210
 211     BSR _ n             -> RU (argRegSet n) callClobberedRegSet
 212     JSR reg addr n      -> RU (argRegSet n) callClobberedRegSet
 213
 214     _                   -> noUsage
 215
 216   where
 217     usage (src, dst) = RU (mkRegSet (filter interesting src))
 218                           (mkRegSet (filter interesting dst))
 219
 220     interesting (FixedReg _) = False
 221     interesting _ = True
 222
 223     regAddr (AddrReg r1)      = [r1]
 224     regAddr (AddrRegImm r1 _) = [r1]
 225     regAddr (AddrImm _)       = []
 226
 227     regRI (RIReg r) = [r]
 228     regRI  _    = []
 229
 230 #endif {- alpha_TARGET_ARCH -}
 231 -- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
 232 #if i386_TARGET_ARCH
 233
 234 regUsage instr = case instr of
 235     MOV    sz src dst   -> usageRW src dst
 236     MOVZxL sz src dst   -> usageRW src dst
 237     MOVSxL sz src dst   -> usageRW src dst
 238     LEA    sz src dst   -> usageRW src dst
 239     ADD    sz src dst   -> usageRM src dst
 240     SUB    sz src dst   -> usageRM src dst
 241     IMUL   sz src dst   -> usageRM src dst
 242     IDIV   sz src       -> mkRU (eax:edx:use_R src) [eax,edx]
 243     AND    sz src dst   -> usageRM src dst
 244     OR     sz src dst   -> usageRM src dst
 245     XOR    sz src dst   -> usageRM src dst
 246     NOT    sz op        -> usageM op
 247     NEGI   sz op        -> usageM op
 248     SHL    sz imm dst   -> usageM dst
 249     SAR    sz imm dst   -> usageM dst
 250     SHR    sz imm dst   -> usageM dst
 251     BT     sz imm src   -> mkRU (use_R src) []
 252
 253     PUSH   sz op        -> mkRU (use_R op) []
 254     POP    sz op        -> mkRU [] (def_W op)
 255     TEST   sz src dst   -> mkRU (use_R src ++ use_R dst) []
 256     CMP    sz src dst   -> mkRU (use_R src ++ use_R dst) []
 257     SETCC  cond op      -> mkRU [] (def_W op)
 258     JXX    cond lbl     -> mkRU [] []
 259     JMP    op           -> mkRU (use_R op) []
 260     CALL   imm          -> mkRU [] callClobberedRegs
 261     CLTD                -> mkRU [eax] [edx]
 262     NOP                 -> mkRU [] []
 263
 264     GMOV   src dst      -> mkRU [src] [dst]
 265     GLD    sz src dst   -> mkRU (use_EA src) [dst]
 266     GST    sz src dst   -> mkRU (src : use_EA dst) []
 267
 268     GLDZ   dst          -> mkRU [] [dst]
 269     GLD1   dst          -> mkRU [] [dst]
 270
 271     GFTOD  src dst      -> mkRU [src] [dst]
 272     GFTOI  src dst      -> mkRU [src] [dst]
 273
 274     GDTOF  src dst      -> mkRU [src] [dst]
 275     GDTOI  src dst      -> mkRU [src] [dst]
 276
 277     GITOF  src dst      -> mkRU [src] [dst]
 278     GITOD  src dst      -> mkRU [src] [dst]
 279
 280     GADD   sz s1 s2 dst -> mkRU [s1,s2] [dst]
 281     GSUB   sz s1 s2 dst -> mkRU [s1,s2] [dst]
 282     GMUL   sz s1 s2 dst -> mkRU [s1,s2] [dst]
 283     GDIV   sz s1 s2 dst -> mkRU [s1,s2] [dst]
 284
 285     GCMP   sz src1 src2 -> mkRU [src1,src2] []
 286     GABS   sz src dst   -> mkRU [src] [dst]
 287     GNEG   sz src dst   -> mkRU [src] [dst]
 288     GSQRT  sz src dst   -> mkRU [src] [dst]
 289     GSIN   sz src dst   -> mkRU [src] [dst]
 290     GCOS   sz src dst   -> mkRU [src] [dst]
 291     GTAN   sz src dst   -> mkRU [src] [dst]
 292
 293     COMMENT _           -> noUsage
 294     SEGMENT _           -> noUsage
 295     LABEL   _           -> noUsage
 296     ASCII   _ _         -> noUsage
 297     DATA    _ _         -> noUsage
 298     DELTA   _           -> noUsage
 299     _                   -> pprPanic "regUsage(x86)" empty
 300
 301  where
 302     -- 2 operand form; first operand Read; second Written
 303     usageRW :: Operand -> Operand -> RegUsage
 304     usageRW op (OpReg reg) = mkRU (use_R op) [reg]
 305     usageRW op (OpAddr ea) = mkRU (use_R op ++ use_EA ea) []
 306
 307     -- 2 operand form; first operand Read; second Modified
 308     usageRM :: Operand -> Operand -> RegUsage
 309     usageRM op (OpReg reg) = mkRU (use_R op ++ [reg]) [reg]
 310     usageRM op (OpAddr ea) = mkRU (use_R op ++ use_EA ea) []
 311
 312     -- 1 operand form; operand Modified
 313     usageM :: Operand -> RegUsage
 314     usageM (OpReg reg)    = mkRU [reg] [reg]
 315     usageM (OpAddr ea)    = mkRU (use_EA ea) []
 316
 317     -- Registers defd when an operand is written.
 318     def_W (OpReg reg)  = [reg]
 319     def_W (OpAddr ea)  = []
 320
 321     -- Registers used when an operand is read.
 322     use_R (OpReg reg)  = [reg]
 323     use_R (OpImm imm)  = []
 324     use_R (OpAddr ea)  = use_EA ea
 325
 326     -- Registers used to compute an effective address.
 327     use_EA (ImmAddr _ _)                           = []
 328     use_EA (AddrBaseIndex Nothing  Nothing      _) = []
 329     use_EA (AddrBaseIndex (Just b) Nothing      _) = [b]
 330     use_EA (AddrBaseIndex Nothing  (Just (i,_)) _) = [i]
 331     use_EA (AddrBaseIndex (Just b) (Just (i,_)) _) = [b,i]
 332
 333     mkRU src dst = RU (regSetFromList (filter interesting src))
 334                       (regSetFromList (filter interesting dst))
 335
 336 -- Allow the spiller to de\cide whether or not it can use
 337 -- %edx as a spill temporary.
 338 hasFixedEDX instr
 339    = case instr of
 340         IDIV _ _ -> True
 341         CLTD     -> True
 342         other    -> False
 343
 344 #endif {- i386_TARGET_ARCH -}
 345 -- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
 346 #if sparc_TARGET_ARCH
 347
 348 regUsage instr = case instr of
 349     LD    sz addr reg   -> usage (regAddr addr, [reg])
 350     ST    sz reg addr   -> usage (reg : regAddr addr, [])
 351     ADD   x cc r1 ar r2 -> usage (r1 : regRI ar, [r2])
 352     SUB   x cc r1 ar r2 -> usage (r1 : regRI ar, [r2])
 353     AND   b r1 ar r2    -> usage (r1 : regRI ar, [r2])
 354     ANDN  b r1 ar r2    -> usage (r1 : regRI ar, [r2])
 355     OR    b r1 ar r2    -> usage (r1 : regRI ar, [r2])
 356     ORN   b r1 ar r2    -> usage (r1 : regRI ar, [r2])
 357     XOR   b r1 ar r2    -> usage (r1 : regRI ar, [r2])
 358     XNOR  b r1 ar r2    -> usage (r1 : regRI ar, [r2])
 359     SLL   r1 ar r2      -> usage (r1 : regRI ar, [r2])
 360     SRL   r1 ar r2      -> usage (r1 : regRI ar, [r2])
 361     SRA   r1 ar r2      -> usage (r1 : regRI ar, [r2])
 362     SETHI imm reg       -> usage ([], [reg])
 363     FABS  s r1 r2       -> usage ([r1], [r2])
 364     FADD  s r1 r2 r3    -> usage ([r1, r2], [r3])
 365     FCMP  e s r1 r2     -> usage ([r1, r2], [])
 366     FDIV  s r1 r2 r3    -> usage ([r1, r2], [r3])
 367     FMOV  s r1 r2       -> usage ([r1], [r2])
 368     FMUL  s r1 r2 r3    -> usage ([r1, r2], [r3])
 369     FNEG  s r1 r2       -> usage ([r1], [r2])
 370     FSQRT s r1 r2       -> usage ([r1], [r2])
 371     FSUB  s r1 r2 r3    -> usage ([r1, r2], [r3])
 372     FxTOy s1 s2 r1 r2   -> usage ([r1], [r2])
 373
 374     -- We assume that all local jumps will be BI/BF.  JMP must be out-of-line.
 375     JMP   addr          -> usage (regAddr addr, [])
 376
 377     CALL  _ n True      -> noUsage
 378     CALL  _ n False     -> usage (argRegs n, callClobberedRegs)
 379
 380     _                   -> noUsage
 381   where
 382     usage (src, dst) = RU (regSetFromList (filter interesting src))
 383                           (regSetFromList (filter interesting dst))
 384
 385     regAddr (AddrRegReg r1 r2) = [r1, r2]
 386     regAddr (AddrRegImm r1 _)  = [r1]
 387
 388     regRI (RIReg r) = [r]
 389     regRI  _    = []
 390
 391 #endif {- sparc_TARGET_ARCH -}
 392 \end{code}
 393
 394
 395 %************************************************************************
 396 %*                                                                      *
 397 \subsection{Free, reserved, call-clobbered, and argument registers}
 398 %*                                                                      *
 399 %************************************************************************
 400
 401 @freeRegs@ is the list of registers we can use in register allocation.
 402 @freeReg@ (below) says if a particular register is free.
 403
 404 With a per-instruction clobber list, we might be able to get some of
 405 these back, but it's probably not worth the hassle.
 406
 407 @callClobberedRegs@ ... the obvious.
 408
 409 @argRegs@: assuming a call with N arguments, what registers will be
 410 used to hold arguments?  (NB: it doesn't know whether the arguments
 411 are integer or floating-point...)
 412
 413 findReservedRegs tells us which regs can be used as spill temporaries.
 414 The list of instructions for which we are attempting allocation is
 415 supplied.  This is so that we can (at least for x86) examine it to
 416 discover which registers are being used in a fixed way -- for example,
 417 %eax and %edx are used by integer division, so they can't be used as
 418 spill temporaries.  However, most instruction lists don't do integer
 419 division, so we don't want to rule them out altogether.
 420
 421 findReservedRegs returns not a list of spill temporaries, but a list
 422 of list of them.  This is so that the allocator can attempt allocating
 423 with at first no spill temps, then if that fails, increasing numbers.
 424 For x86 it is important that we minimise the number of regs reserved
 425 as spill temporaries, since there are so few.  For Alpha and Sparc
 426 this isn't a concern; we just ignore the supplied code list and return
 427 a singleton list which we know will satisfy all spill demands.
 428
 429 \begin{code}
 430 findReservedRegs :: [Instr] -> [[Reg]]
 431 findReservedRegs instrs
 432 #if alpha_TARGET_ARCH
 433   = --[[NCG_Reserved_I1, NCG_Reserved_I2,
 434     --  NCG_Reserved_F1, NCG_Reserved_F2]]
 435     error "findReservedRegs: alpha"
 436 #endif
 437 #if sparc_TARGET_ARCH
 438   = [[NCG_SpillTmp_I1, NCG_SpillTmp_I2,
 439       NCG_SpillTmp_D1, NCG_SpillTmp_D2,
 440       NCG_SpillTmp_F1, NCG_SpillTmp_F2]]
 441 #endif
 442 #if i386_TARGET_ARCH
 443   -- We can use %fake4 and %fake5 safely for float temps.
 444   -- Int regs are more troublesome.  Only %ecx is definitely
 445   -- available.  If there are no division insns, we can use %edx
 446   -- too.  At a pinch, we also could bag %eax if there are no
 447   -- divisions and no ccalls, but so far we've never encountered
 448   -- a situation where three integer temporaries are necessary.
 449   --
 450   -- Because registers are in short supply on x86, we give the
 451   -- allocator a whole bunch of possibilities, starting with zero
 452   -- temporaries and working up to all that are available.  This
 453   -- is inefficient, but spills are pretty rare, so we don't care
 454   -- if the register allocator has to try half a dozen or so possibilities
 455   -- before getting to one that works.
 456   = let f1 = fake5
 457         f2 = fake4
 458         intregs_avail
 459            = ecx : if any hasFixedEDX instrs then [] else [edx]
 460         possibilities
 461            = case intregs_avail of
 462                 [i1] -> [ [], [i1], [f1], [i1,f1], [f1,f2],
 463                           [i1,f1,f2] ]
 464
 465                 [i1,i2] -> [ [], [i1], [f1], [i1,i2], [i1,f1], [f1,f2],
 466                              [i1,i2,f1], [i1,f1,f2], [i1,i2,f1,f2] ]
 467     in
 468         possibilities
 469 #endif
 470 \end{code}
 471
 472 %************************************************************************
 473 %*                                                                      *
 474 \subsection{@InsnFuture@ type; @insnFuture@ function}
 475 %*                                                                      *
 476 %************************************************************************
 477
 478 @insnFuture@ indicates the places we could get to following the
 479 current instruction.  This is used by the register allocator to
 480 compute the flow edges between instructions.
 481
 482 \begin{code}
 483 data InsnFuture
 484    = NoFuture              -- makes a non-local jump; for the purposes of
 485                            -- register allocation, it exits our domain
 486    | Next                  -- falls through to next insn
 487    | Branch CLabel         -- unconditional branch to the label
 488    | NextOrBranch CLabel   -- conditional branch to the label
 489
 490 --instance Outputable InsnFuture where
 491 --   ppr NoFuture            = text "NoFuture"
 492 --   ppr Next                = text "Next"
 493 --   ppr (Branch clbl)       = text "(Branch " <> ppr clbl <> char ')'
 494 --   ppr (NextOrBranch clbl) = text "(NextOrBranch " <> ppr clbl <> char ')'
 495
 496
 497 insnFuture insn
 498  = case insn of
 499
 500 #if alpha_TARGET_ARCH
 501
 502     -- We assume that all local jumps will be BI/BF.  JMP must be out-of-line.
 503
 504     BR (ImmCLbl lbl)     -> RL (lookup lbl) future
 505     BI _ _ (ImmCLbl lbl) -> RL (lookup lbl `unionRegSets` live) future
 506     BF _ _ (ImmCLbl lbl) -> RL (lookup lbl `unionRegSets` live) future
 507     JMP _ _ _            -> RL emptyRegSet future
 508     BSR _ _              -> RL live future
 509     JSR _ _ _            -> RL live future
 510     LABEL lbl            -> RL live (FL (all `unionRegSets` live) (addToFM env lbl live))
 511     _                    -> info
 512
 513 #endif {- alpha_TARGET_ARCH -}
 514 -- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
 515 #if i386_TARGET_ARCH
 516
 517     -- conditional jump
 518     JXX _ clbl | isAsmTemp clbl -> NextOrBranch clbl
 519     JXX _ _ -> panic "insnFuture: conditional jump to non-local label"
 520
 521     -- unconditional jump to local label
 522     JMP (OpImm (ImmCLbl clbl)) | isAsmTemp clbl -> Branch clbl
 523
 524     -- unconditional jump to non-local label
 525     JMP lbl     -> NoFuture
 526
 527     boring      -> Next
 528
 529 #endif {- i386_TARGET_ARCH -}
 530 -- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
 531 #if sparc_TARGET_ARCH
 532
 533     -- We assume that all local jumps will be BI/BF.
 534     BI ALWAYS _ (ImmCLbl clbl) -> Branch clbl
 535     BI other  _ (ImmCLbl clbl) -> NextOrBranch clbl
 536     BI other  _ _ -> panic "nativeGen(sparc):insnFuture(BI)"
 537
 538     BF ALWAYS _ (ImmCLbl clbl) -> Branch clbl
 539     BF other  _ (ImmCLbl clbl) -> NextOrBranch clbl
 540     BF other  _ _ -> panic "nativeGen(sparc):insnFuture(BF)"
 541
 542     -- JMP and CALL(terminal) must be out-of-line.
 543     JMP _         -> NoFuture
 544     CALL _ _ True -> NoFuture
 545
 546     boring -> Next
 547
 548 #endif {- sparc_TARGET_ARCH -}
 549 \end{code}
 550
 551 %************************************************************************
 552 %*                                                                      *
 553 \subsection{@patchRegs@ function}
 554 %*                                                                      *
 555 %************************************************************************
 556
 557 @patchRegs@ takes an instruction (possibly with
 558 MemoryReg/UnmappedReg registers) and changes all register references
 559 according to the supplied environment.
 560
 561 \begin{code}
 562 patchRegs :: Instr -> (Reg -> Reg) -> Instr
 563
 564 #if alpha_TARGET_ARCH
 565
 566 patchRegs instr env = case instr of
 567     LD sz reg addr -> LD sz (env reg) (fixAddr addr)
 568     LDA reg addr -> LDA (env reg) (fixAddr addr)
 569     LDAH reg addr -> LDAH (env reg) (fixAddr addr)
 570     LDGP reg addr -> LDGP (env reg) (fixAddr addr)
 571     LDI sz reg imm -> LDI sz (env reg) imm
 572     ST sz reg addr -> ST sz (env reg) (fixAddr addr)
 573     CLR reg -> CLR (env reg)
 574     ABS sz ar reg -> ABS sz (fixRI ar) (env reg)
 575     NEG sz ov ar reg -> NEG sz ov (fixRI ar) (env reg)
 576     ADD sz ov r1 ar r2 -> ADD sz ov (env r1) (fixRI ar) (env r2)
 577     SADD sz sc r1 ar r2 -> SADD sz sc (env r1) (fixRI ar) (env r2)
 578     SUB sz ov r1 ar r2 -> SUB sz ov (env r1) (fixRI ar) (env r2)
 579     SSUB sz sc r1 ar r2 -> SSUB sz sc (env r1) (fixRI ar) (env r2)
 580     MUL sz ov r1 ar r2 -> MUL sz ov (env r1) (fixRI ar) (env r2)
 581     DIV sz un r1 ar r2 -> DIV sz un (env r1) (fixRI ar) (env r2)
 582     REM sz un r1 ar r2 -> REM sz un (env r1) (fixRI ar) (env r2)
 583     NOT ar reg -> NOT (fixRI ar) (env reg)
 584     AND r1 ar r2 -> AND (env r1) (fixRI ar) (env r2)
 585     ANDNOT r1 ar r2 -> ANDNOT (env r1) (fixRI ar) (env r2)
 586     OR r1 ar r2 -> OR (env r1) (fixRI ar) (env r2)
 587     ORNOT r1 ar r2 -> ORNOT (env r1) (fixRI ar) (env r2)
 588     XOR r1 ar r2 -> XOR (env r1) (fixRI ar) (env r2)
 589     XORNOT r1 ar r2 -> XORNOT (env r1) (fixRI ar) (env r2)
 590     SLL r1 ar r2 -> SLL (env r1) (fixRI ar) (env r2)
 591     SRL r1 ar r2 -> SRL (env r1) (fixRI ar) (env r2)
 592     SRA r1 ar r2 -> SRA (env r1) (fixRI ar) (env r2)
 593     ZAP r1 ar r2 -> ZAP (env r1) (fixRI ar) (env r2)
 594     ZAPNOT r1 ar r2 -> ZAPNOT (env r1) (fixRI ar) (env r2)
 595     CMP co r1 ar r2 -> CMP co (env r1) (fixRI ar) (env r2)
 596     FCLR reg -> FCLR (env reg)
 597     FABS r1 r2 -> FABS (env r1) (env r2)
 598     FNEG s r1 r2 -> FNEG s (env r1) (env r2)
 599     FADD s r1 r2 r3 -> FADD s (env r1) (env r2) (env r3)
 600     FDIV s r1 r2 r3 -> FDIV s (env r1) (env r2) (env r3)
 601     FMUL s r1 r2 r3 -> FMUL s (env r1) (env r2) (env r3)
 602     FSUB s r1 r2 r3 -> FSUB s (env r1) (env r2) (env r3)
 603     CVTxy s1 s2 r1 r2 -> CVTxy s1 s2 (env r1) (env r2)
 604     FCMP s co r1 r2 r3 -> FCMP s co (env r1) (env r2) (env r3)
 605     FMOV r1 r2 -> FMOV (env r1) (env r2)
 606     BI cond reg lbl -> BI cond (env reg) lbl
 607     BF cond reg lbl -> BF cond (env reg) lbl
 608     JMP reg addr hint -> JMP (env reg) (fixAddr addr) hint
 609     JSR reg addr i -> JSR (env reg) (fixAddr addr) i
 610     _ -> instr
 611   where
 612     fixAddr (AddrReg r1)       = AddrReg (env r1)
 613     fixAddr (AddrRegImm r1 i)  = AddrRegImm (env r1) i
 614     fixAddr other              = other
 615
 616     fixRI (RIReg r) = RIReg (env r)
 617     fixRI other = other
 618
 619 #endif {- alpha_TARGET_ARCH -}
 620 -- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
 621 #if i386_TARGET_ARCH
 622
 623 patchRegs instr env = case instr of
 624     MOV  sz src dst     -> patch2 (MOV  sz) src dst
 625     MOVZxL sz src dst   -> patch2 (MOVZxL sz) src dst
 626     MOVSxL sz src dst   -> patch2 (MOVSxL sz) src dst
 627     LEA  sz src dst     -> patch2 (LEA  sz) src dst
 628     ADD  sz src dst     -> patch2 (ADD  sz) src dst
 629     SUB  sz src dst     -> patch2 (SUB  sz) src dst
 630     IMUL sz src dst     -> patch2 (IMUL sz) src dst
 631     IDIV sz src         -> patch1 (IDIV sz) src
 632     AND  sz src dst     -> patch2 (AND  sz) src dst
 633     OR   sz src dst     -> patch2 (OR   sz) src dst
 634     XOR  sz src dst     -> patch2 (XOR  sz) src dst
 635     NOT  sz op          -> patch1 (NOT  sz) op
 636     NEGI sz op          -> patch1 (NEGI sz) op
 637     SHL  sz imm dst     -> patch1 (SHL sz imm) dst
 638     SAR  sz imm dst     -> patch1 (SAR sz imm) dst
 639     SHR  sz imm dst     -> patch1 (SHR sz imm) dst
 640     BT   sz imm src     -> patch1 (BT  sz imm) src
 641     TEST sz src dst     -> patch2 (TEST sz) src dst
 642     CMP  sz src dst     -> patch2 (CMP  sz) src dst
 643     PUSH sz op          -> patch1 (PUSH sz) op
 644     POP  sz op          -> patch1 (POP  sz) op
 645     SETCC cond op       -> patch1 (SETCC cond) op
 646     JMP op              -> patch1 JMP op
 647
 648     GMOV src dst        -> GMOV (env src) (env dst)
 649     GLD sz src dst      -> GLD sz (lookupAddr src) (env dst)
 650     GST sz src dst      -> GST sz (env src) (lookupAddr dst)
 651
 652     GLDZ dst            -> GLDZ (env dst)
 653     GLD1 dst            -> GLD1 (env dst)
 654
 655     GFTOD src dst       -> GFTOD (env src) (env dst)
 656     GFTOI src dst       -> GFTOI (env src) (env dst)
 657
 658     GDTOF src dst       -> GDTOF (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 "patchInstr(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 addr -> JMP (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, and eventually
 757 StixInteger) use this as a temp location.  Leave 8 words (ie, 64 bytes
 758 for a 64-bit arch) of slop.
 759
 760 \begin{code}
 761 spillSlotSize :: Int
 762 spillSlotSize = IF_ARCH_alpha( 8, IF_ARCH_sparc( 8, IF_ARCH_i386( 12, )))
 763
 764 maxSpillSlots :: Int
 765 maxSpillSlots = ((rESERVED_C_STACK_BYTES - 64) `div` spillSlotSize) - 1
 766
 767 -- convert a spill slot number to a *byte* offset, with no sign:
 768 -- decide on a per arch basis whether you are spilling above or below
 769 -- the C stack pointer.
 770 spillSlotToOffset :: Int -> Int
 771 spillSlotToOffset slot
 772    | slot >= 0 && slot < maxSpillSlots
 773    = 64 + spillSlotSize * slot
 774    | otherwise
 775    = pprPanic "spillSlotToOffset:"
 776               (text "invalid spill location: " <> int slot)
 777
 778 vregToSpillSlot :: FiniteMap Unique Int -> Unique -> Int
 779 vregToSpillSlot vreg_to_slot_map u
 780    = case lookupFM vreg_to_slot_map u of
 781         Just xx -> xx
 782         Nothing -> pprPanic "vregToSpillSlot: unmapped vreg" (ppr u)
 783
 784
 785 spillReg, loadReg :: FiniteMap Unique Int -> Int -> Reg -> Reg -> Instr
 786
 787 spillReg vreg_to_slot_map delta dyn vreg
 788   | isVirtualReg vreg
 789   = let slot_no = vregToSpillSlot vreg_to_slot_map (getUnique vreg)
 790         off     = spillSlotToOffset slot_no
 791     in
 792         {-Alpha: spill below the stack pointer (?)-}
 793          IF_ARCH_alpha( ST sz dyn (spRel (- (off `div` 8)))
 794
 795         {-I386: spill above stack pointer leaving 3 words/spill-}
 796         ,IF_ARCH_i386 ( let off_w = (off-delta) `div` 4
 797                         in
 798                         if   regClass vreg == RcFloating
 799                         then GST F80 dyn (spRel off_w)
 800                         else MOV L (OpReg dyn) (OpAddr (spRel off_w))
 801
 802         {-SPARC: spill below frame pointer leaving 2 words/spill-}
 803         ,IF_ARCH_sparc(
 804                         let off_w = 1 + (off `div` 4)
 805                             sz = case regClass vreg of
 806                                     RcInteger -> W
 807                                     RcFloat   -> F
 808                                     RcDouble  -> DF
 809                         in ST sz dyn (fpRel (- off_w))
 810         ,)))
 811
 812
 813 loadReg vreg_to_slot_map delta vreg dyn
 814   | isVirtualReg vreg
 815   = let slot_no = vregToSpillSlot vreg_to_slot_map (getUnique vreg)
 816         off     = spillSlotToOffset slot_no
 817     in
 818          IF_ARCH_alpha( LD  sz dyn (spRel (- (off `div` 8)))
 819
 820         ,IF_ARCH_i386 ( let off_w = (off-delta) `div` 4
 821                         in
 822                         if   regClass vreg == RcFloating
 823                         then GLD F80 (spRel off_w) dyn
 824                         else MOV L (OpAddr (spRel off_w)) (OpReg dyn)
 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}