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         MRegsState(..),
  13         mkMRegsState,
  14         freeMReg,
  15         freeMRegs,
  16         possibleMRegs,
  17         useMReg,
  18         useMRegs,
  19
  20         RegUsage(..),
  21         noUsage,
  22         endUsage,
  23         regUsage,
  24
  25         FutureLive(..),
  26         RegAssignment,
  27         RegConflicts,
  28         RegFuture(..),
  29         RegHistory(..),
  30         RegInfo(..),
  31         RegLiveness(..),
  32
  33         fstFL,
  34         loadReg,
  35         patchRegs,
  36         regLiveness,
  37         spillReg,
  38         findReservedRegs,
  39
  40         RegSet,
  41         elementOfRegSet,
  42         emptyRegSet,
  43         isEmptyRegSet,
  44         minusRegSet,
  45         mkRegSet,
  46         regSetToList,
  47         unionRegSets,
  48
  49         argRegSet,
  50         callClobberedRegSet,
  51         freeRegSet
  52     ) where
  53
  54 #include "HsVersions.h"
  55
  56 import List             ( partition )
  57 import MachMisc
  58 import MachRegs
  59 import MachCode         ( InstrList )
  60
  61 import BitSet           ( unitBS, mkBS, minusBS, unionBS, listBS, BitSet )
  62 import CLabel           ( pprCLabel_asm, CLabel{-instance Ord-} )
  63 import FiniteMap        ( addToFM, lookupFM, FiniteMap )
  64 import OrdList          ( mkUnitList )
  65 import PrimRep          ( PrimRep(..) )
  66 import UniqSet          -- quite a bit of it
  67 import Outputable
  68 import Constants        ( rESERVED_C_STACK_BYTES )
  69 \end{code}
  70
  71 %************************************************************************
  72 %*                                                                      *
  73 \subsection{Register allocation information}
  74 %*                                                                      *
  75 %************************************************************************
  76
  77 \begin{code}
  78 type RegSet = UniqSet Reg
  79
  80 mkRegSet :: [Reg] -> RegSet
  81 emptyRegSet :: RegSet
  82 unionRegSets, minusRegSet :: RegSet -> RegSet -> RegSet
  83 elementOfRegSet :: Reg -> RegSet -> Bool
  84 isEmptyRegSet :: RegSet -> Bool
  85 regSetToList :: RegSet -> [Reg]
  86
  87 mkRegSet        = mkUniqSet
  88 emptyRegSet     = emptyUniqSet
  89 unionRegSets    = unionUniqSets
  90 minusRegSet     = minusUniqSet
  91 elementOfRegSet = elementOfUniqSet
  92 isEmptyRegSet   = isEmptyUniqSet
  93 regSetToList    = uniqSetToList
  94
  95 freeRegSet, callClobberedRegSet :: RegSet
  96 argRegSet :: Int -> RegSet
  97
  98 freeRegSet          = mkRegSet freeRegs
  99 callClobberedRegSet = mkRegSet callClobberedRegs
 100 argRegSet n         = mkRegSet (argRegs n)
 101
 102 type RegAssignment = FiniteMap Reg Reg
 103 type RegConflicts  = FiniteMap Int RegSet
 104
 105 data FutureLive = FL RegSet (FiniteMap CLabel RegSet)
 106
 107 fstFL (FL a b)  = a
 108
 109 data RegHistory a
 110   = RH  a
 111         Int
 112         RegAssignment
 113
 114 data RegFuture
 115   = RF  RegSet          -- in use
 116         FutureLive      -- future
 117         RegConflicts
 118
 119 data RegInfo a
 120   = RI  RegSet          -- in use
 121         RegSet          -- sources
 122         RegSet          -- destinations
 123         [Reg]           -- last used
 124         RegConflicts
 125 \end{code}
 126
 127 %************************************************************************
 128 %*                                                                      *
 129 \subsection{Register allocation information}
 130 %*                                                                      *
 131 %************************************************************************
 132
 133 COMMENT ON THE EXTRA BitSet FOR SPARC MRegsState: Getting the conflicts
 134 right is a bit tedious for doubles.  We'd have to add a conflict
 135 function to the MachineRegisters class, and we'd have to put a PrimRep
 136 in the MappedReg datatype, or use some kludge (e.g. register 64 + n is
 137 really the same as 32 + n, except that it's used for a double, so it
 138 also conflicts with 33 + n) to deal with it.  It's just not worth the
 139 bother, so we just partition the free floating point registers into
 140 two sets: one for single precision and one for double precision.  We
 141 never seem to run out of floating point registers anyway.
 142
 143 \begin{code}
 144 data MRegsState
 145   = MRs BitSet  -- integer registers
 146         BitSet  -- floating-point registers
 147         IF_ARCH_sparc(BitSet,) -- double registers handled separately
 148 \end{code}
 149
 150 \begin{code}
 151 #if alpha_TARGET_ARCH
 152 # define INT_FLPT_CUTOFF 32
 153 #endif
 154 #if i386_TARGET_ARCH
 155 # define INT_FLPT_CUTOFF 8
 156 #endif
 157 #if sparc_TARGET_ARCH
 158 # define INT_FLPT_CUTOFF 32
 159 # define SNGL_DBL_CUTOFF 48
 160 #endif
 161
 162 mkMRegsState    :: [RegNo] -> MRegsState
 163 possibleMRegs   :: PrimRep -> MRegsState -> [RegNo]
 164 useMReg         :: MRegsState -> FAST_REG_NO -> MRegsState
 165 useMRegs        :: MRegsState -> [RegNo]     -> MRegsState
 166 freeMReg        :: MRegsState -> FAST_REG_NO -> MRegsState
 167 freeMRegs       :: MRegsState -> [RegNo]     -> MRegsState
 168
 169 mkMRegsState xs
 170   = MRs (mkBS is) (mkBS fs2) IF_ARCH_sparc((mkBS ds2),)
 171   where
 172     (is, fs) = partition (< INT_FLPT_CUTOFF) xs
 173 #if sparc_TARGET_ARCH
 174     (ss, ds) = partition (< SNGL_DBL_CUTOFF) fs
 175     fs2  = map (subtract INT_FLPT_CUTOFF) ss
 176     ds2  = map (subtract INT_FLPT_CUTOFF) (filter even ds)
 177 #else
 178     fs2      = map (subtract INT_FLPT_CUTOFF) fs
 179 #endif
 180
 181 ------------------------------------------------
 182 #if sparc_TARGET_ARCH
 183 possibleMRegs FloatRep  (MRs _ ss _) = [ x + INT_FLPT_CUTOFF | x <- listBS ss]
 184 possibleMRegs DoubleRep (MRs _ _ ds) = [ x + INT_FLPT_CUTOFF | x <- listBS ds]
 185 possibleMRegs _         (MRs is _ _) = listBS is
 186 #else
 187 possibleMRegs FloatRep  (MRs _ fs) = [ x + INT_FLPT_CUTOFF | x <- listBS fs]
 188 possibleMRegs DoubleRep (MRs _ fs) = [ x + INT_FLPT_CUTOFF | x <- listBS fs]
 189 possibleMRegs _     (MRs is _) = listBS is
 190 #endif
 191
 192 ------------------------------------------------
 193 #if sparc_TARGET_ARCH
 194 useMReg (MRs is ss ds) n
 195   = if (n _LT_ ILIT(INT_FLPT_CUTOFF)) then
 196         MRs (is `minusBS` unitBS IBOX(n)) ss ds
 197     else if (n _LT_ ILIT(SNGL_DBL_CUTOFF)) then
 198         MRs is (ss `minusBS` unitBS (IBOX(n _SUB_ ILIT(INT_FLPT_CUTOFF)))) ds
 199     else
 200         MRs is ss (ds `minusBS` unitBS (IBOX(n _SUB_ ILIT(INT_FLPT_CUTOFF))))
 201 #else
 202 useMReg (MRs is fs) n
 203   = if (n _LT_ ILIT(INT_FLPT_CUTOFF))
 204     then MRs (is `minusBS` unitBS IBOX(n)) fs
 205     else MRs is (fs `minusBS` unitBS (IBOX(n _SUB_ ILIT(INT_FLPT_CUTOFF))))
 206 #endif
 207
 208 ------------------------------------------------
 209 #if sparc_TARGET_ARCH
 210 useMRegs (MRs is ss ds) xs
 211   = MRs (is `minusBS` is2) (ss `minusBS` ss2) (ds `minusBS` ds2)
 212   where
 213     MRs is2 ss2 ds2 = mkMRegsState xs
 214 #else
 215 useMRegs (MRs is fs) xs
 216   = MRs (is `minusBS` is2) (fs `minusBS` fs2)
 217   where
 218     MRs is2 fs2 = mkMRegsState xs
 219 #endif
 220
 221 ------------------------------------------------
 222 #if sparc_TARGET_ARCH
 223 freeMReg (MRs is ss ds) n
 224   = if (n _LT_ ILIT(INT_FLPT_CUTOFF)) then
 225         MRs (is `unionBS` unitBS IBOX(n)) ss ds
 226     else if (n _LT_ ILIT(SNGL_DBL_CUTOFF)) then
 227         MRs is (ss `unionBS` unitBS (IBOX(n _SUB_ ILIT(INT_FLPT_CUTOFF)))) ds
 228     else
 229         MRs is ss (ds `unionBS` unitBS (IBOX(n _SUB_ ILIT(INT_FLPT_CUTOFF))))
 230 #else
 231 freeMReg (MRs is fs) n
 232   = if (n _LT_ ILIT(INT_FLPT_CUTOFF))
 233     then MRs (is `unionBS` unitBS IBOX(n)) fs
 234     else MRs is (fs `unionBS` unitBS (IBOX(n _SUB_ ILIT(INT_FLPT_CUTOFF))))
 235 #endif
 236
 237 ------------------------------------------------
 238 #if sparc_TARGET_ARCH
 239 freeMRegs (MRs is ss ds) xs
 240   = MRs (is `unionBS` is2) (ss `unionBS` ss2) (ds `unionBS` ds2)
 241   where
 242     MRs is2 ss2 ds2 = mkMRegsState xs
 243 #else
 244 freeMRegs (MRs is fs) xs
 245   = MRs (is `unionBS` is2) (fs `unionBS` fs2)
 246   where
 247     MRs is2 fs2 = mkMRegsState xs
 248 #endif
 249 \end{code}
 250
 251 %************************************************************************
 252 %*                                                                      *
 253 \subsection{@RegUsage@ type; @noUsage@, @endUsage@, @regUsage@ functions}
 254 %*                                                                      *
 255 %************************************************************************
 256
 257 @regUsage@ returns the sets of src and destination registers used by a
 258 particular instruction.  Machine registers that are pre-allocated to
 259 stgRegs are filtered out, because they are uninteresting from a
 260 register allocation standpoint.  (We wouldn't want them to end up on
 261 the free list!)
 262
 263 An important point: The @regUsage@ function for a particular
 264 assembly language must not refer to fixed registers, such as Hp, SpA,
 265 etc.  The source and destination MRegsStates should only refer to
 266 dynamically allocated registers or static registers from the free
 267 list.  As far as we are concerned, the fixed registers simply don't
 268 exist (for allocation purposes, anyway).
 269
 270 \begin{code}
 271 data RegUsage = RU RegSet RegSet
 272
 273 noUsage, endUsage :: RegUsage
 274 noUsage  = RU emptyRegSet emptyRegSet
 275 endUsage = RU emptyRegSet freeRegSet
 276
 277 regUsage :: Instr -> RegUsage
 278
 279 #if alpha_TARGET_ARCH
 280
 281 regUsage instr = case instr of
 282     LD B reg addr       -> usage (regAddr addr, [reg, t9])
 283     LD BU reg addr      -> usage (regAddr addr, [reg, t9])
 284 --  LD W reg addr       -> usage (regAddr addr, [reg, t9]) : UNUSED
 285 --  LD WU reg addr      -> usage (regAddr addr, [reg, t9]) : UNUSED
 286     LD sz reg addr      -> usage (regAddr addr, [reg])
 287     LDA reg addr        -> usage (regAddr addr, [reg])
 288     LDAH reg addr       -> usage (regAddr addr, [reg])
 289     LDGP reg addr       -> usage (regAddr addr, [reg])
 290     LDI sz reg imm      -> usage ([], [reg])
 291     ST B reg addr       -> usage (reg : regAddr addr, [t9, t10])
 292 --  ST W reg addr       -> usage (reg : regAddr addr, [t9, t10]) : UNUSED
 293     ST sz reg addr      -> usage (reg : regAddr addr, [])
 294     CLR reg             -> usage ([], [reg])
 295     ABS sz ri reg       -> usage (regRI ri, [reg])
 296     NEG sz ov ri reg    -> usage (regRI ri, [reg])
 297     ADD sz ov r1 ar r2  -> usage (r1 : regRI ar, [r2])
 298     SADD sz sc r1 ar r2 -> usage (r1 : regRI ar, [r2])
 299     SUB sz ov r1 ar r2  -> usage (r1 : regRI ar, [r2])
 300     SSUB sz sc r1 ar r2 -> usage (r1 : regRI ar, [r2])
 301     MUL sz ov r1 ar r2  -> usage (r1 : regRI ar, [r2])
 302     DIV sz un r1 ar r2  -> usage (r1 : regRI ar, [r2, t9, t10, t11, t12])
 303     REM sz un r1 ar r2  -> usage (r1 : regRI ar, [r2, t9, t10, t11, t12])
 304     NOT ri reg          -> usage (regRI ri, [reg])
 305     AND r1 ar r2        -> usage (r1 : regRI ar, [r2])
 306     ANDNOT r1 ar r2     -> usage (r1 : regRI ar, [r2])
 307     OR r1 ar r2         -> usage (r1 : regRI ar, [r2])
 308     ORNOT r1 ar r2      -> usage (r1 : regRI ar, [r2])
 309     XOR r1 ar r2        -> usage (r1 : regRI ar, [r2])
 310     XORNOT r1 ar r2     -> usage (r1 : regRI ar, [r2])
 311     SLL r1 ar r2        -> usage (r1 : regRI ar, [r2])
 312     SRL r1 ar r2        -> usage (r1 : regRI ar, [r2])
 313     SRA r1 ar r2        -> usage (r1 : regRI ar, [r2])
 314     ZAP r1 ar r2        -> usage (r1 : regRI ar, [r2])
 315     ZAPNOT r1 ar r2     -> usage (r1 : regRI ar, [r2])
 316     CMP co r1 ar r2     -> usage (r1 : regRI ar, [r2])
 317     FCLR reg            -> usage ([], [reg])
 318     FABS r1 r2          -> usage ([r1], [r2])
 319     FNEG sz r1 r2       -> usage ([r1], [r2])
 320     FADD sz r1 r2 r3    -> usage ([r1, r2], [r3])
 321     FDIV sz r1 r2 r3    -> usage ([r1, r2], [r3])
 322     FMUL sz r1 r2 r3    -> usage ([r1, r2], [r3])
 323     FSUB sz r1 r2 r3    -> usage ([r1, r2], [r3])
 324     CVTxy sz1 sz2 r1 r2 -> usage ([r1], [r2])
 325     FCMP sz co r1 r2 r3 -> usage ([r1, r2], [r3])
 326     FMOV r1 r2          -> usage ([r1], [r2])
 327
 328
 329     -- We assume that all local jumps will be BI/BF/BR.  JMP must be out-of-line.
 330     BI cond reg lbl     -> usage ([reg], [])
 331     BF cond reg lbl     -> usage ([reg], [])
 332     JMP reg addr hint   -> RU (mkRegSet (filter interesting (regAddr addr))) freeRegSet
 333
 334     BSR _ n             -> RU (argRegSet n) callClobberedRegSet
 335     JSR reg addr n      -> RU (argRegSet n) callClobberedRegSet
 336
 337     _                   -> noUsage
 338
 339   where
 340     usage (src, dst) = RU (mkRegSet (filter interesting src))
 341                           (mkRegSet (filter interesting dst))
 342
 343     interesting (FixedReg _) = False
 344     interesting _ = True
 345
 346     regAddr (AddrReg r1)      = [r1]
 347     regAddr (AddrRegImm r1 _) = [r1]
 348     regAddr (AddrImm _)       = []
 349
 350     regRI (RIReg r) = [r]
 351     regRI  _    = []
 352
 353 #endif {- alpha_TARGET_ARCH -}
 354 -- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
 355 #if i386_TARGET_ARCH
 356
 357 regUsage instr = case instr of
 358     MOV  sz src dst     -> usage2  src dst
 359     MOVZxL sz src dst   -> usage2  src dst
 360     MOVSxL sz src dst   -> usage2  src dst
 361     LEA  sz src dst     -> usage2  src dst
 362     ADD  sz src dst     -> usage2s src dst
 363     SUB  sz src dst     -> usage2s src dst
 364     IMUL sz src dst     -> usage2s src dst
 365     IDIV sz src         -> usage (eax:edx:opToReg src) [eax,edx]
 366     AND  sz src dst     -> usage2s src dst
 367     OR   sz src dst     -> usage2s src dst
 368     XOR  sz src dst     -> usage2s src dst
 369     NOT  sz op          -> usage1 op
 370     NEGI sz op          -> usage1 op
 371     SHL  sz imm dst     -> usage1 dst
 372     SAR  sz imm dst     -> usage1 dst
 373     SHR  sz imm dst     -> usage1 dst
 374     BT   sz imm src     -> usage (opToReg src) []
 375
 376     PUSH sz op          -> usage (opToReg op) []
 377     POP  sz op          -> usage [] (opToReg op)
 378     TEST sz src dst     -> usage (opToReg src ++ opToReg dst) []
 379     CMP  sz src dst     -> usage (opToReg src ++ opToReg dst) []
 380     SETCC cond op       -> usage [] (opToReg op)
 381     JXX cond lbl        -> usage [] []
 382     JMP op              -> usage (opToReg op) freeRegs
 383     CALL imm            -> usage [] callClobberedRegs
 384     CLTD                -> usage [eax] [edx]
 385     NOP                 -> usage [] []
 386
 387     GMOV src dst        -> usage [src] [dst]
 388     GLD sz src dst      -> usage (addrToRegs src) [dst]
 389     GST sz src dst      -> usage [src] (addrToRegs dst)
 390
 391     GFTOD src dst       -> usage [src] [dst]
 392     GFTOI src dst       -> usage [src] [dst]
 393
 394     GDTOF src dst       -> usage [src] [dst]
 395     GDTOI src dst       -> usage [src] [dst]
 396
 397     GITOF src dst       -> usage [src] [dst]
 398     GITOD src dst       -> usage [src] [dst]
 399
 400     GADD sz s1 s2 dst   -> usage [s1,s2] [dst]
 401     GSUB sz s1 s2 dst   -> usage [s1,s2] [dst]
 402     GMUL sz s1 s2 dst   -> usage [s1,s2] [dst]
 403     GDIV sz s1 s2 dst   -> usage [s1,s2] [dst]
 404
 405     GCMP sz src1 src2   -> usage [src1,src2] []
 406     GABS sz src dst     -> usage [src] [dst]
 407     GNEG sz src dst     -> usage [src] [dst]
 408     GSQRT sz src dst    -> usage [src] [dst]
 409     GSIN sz src dst     -> usage [src] [dst]
 410     GCOS sz src dst     -> usage [src] [dst]
 411     GTAN sz src dst     -> usage [src] [dst]
 412
 413     COMMENT _           -> noUsage
 414     SEGMENT _           -> noUsage
 415     LABEL _             -> noUsage
 416     ASCII _ _           -> noUsage
 417     DATA _ _            -> noUsage
 418     _                   -> pprPanic "regUsage(x86)" empty
 419
 420  where
 421     -- 2 operand form in which the second operand is purely a destination
 422     usage2 :: Operand -> Operand -> RegUsage
 423     usage2 op (OpReg reg) = usage (opToReg op) [reg]
 424     usage2 op (OpAddr ea) = usage (opToReg op ++ addrToRegs ea) []
 425     usage2 op (OpImm imm) = usage (opToReg op) []
 426
 427     -- 2 operand form in which the second operand is also an input
 428     usage2s :: Operand -> Operand -> RegUsage
 429     usage2s op (OpReg reg) = usage (opToReg op ++ [reg]) [reg]
 430     usage2s op (OpAddr ea) = usage (opToReg op ++ addrToRegs ea) []
 431     usage2s op (OpImm imm) = usage (opToReg op) []
 432
 433     -- 1 operand form in which the operand is both used and written
 434     usage1 :: Operand -> RegUsage
 435     usage1 (OpReg reg)    = usage [reg] [reg]
 436     usage1 (OpAddr ea)    = usage (addrToRegs ea) []
 437
 438     allFPRegs = [fake0,fake1,fake2,fake3,fake4,fake5]
 439
 440     --callClobberedRegs = [ eax, ecx, edx ] -- according to gcc, anyway.
 441     callClobberedRegs = [eax,fake0,fake1,fake2,fake3,fake4,fake5]
 442
 443 -- General purpose register collecting functions.
 444
 445     opToReg (OpReg reg)   = [reg]
 446     opToReg (OpImm imm)   = []
 447     opToReg (OpAddr  ea)  = addrToRegs ea
 448
 449     addrToRegs (AddrBaseIndex base index _) = baseToReg base ++ indexToReg index
 450       where  baseToReg Nothing       = []
 451              baseToReg (Just r)      = [r]
 452              indexToReg Nothing      = []
 453              indexToReg (Just (r,_)) = [r]
 454     addrToRegs (ImmAddr _ _) = []
 455
 456     usage src dst = RU (mkRegSet (filter interesting src))
 457                        (mkRegSet (filter interesting dst))
 458
 459     interesting (FixedReg _) = False
 460     interesting _ = True
 461
 462
 463 -- Allow the spiller to decide whether or not it can use
 464 -- %eax and %edx as spill temporaries.
 465 hasFixedEAXorEDX instr = case instr of
 466     IDIV _ _ -> True
 467     CLTD     -> True
 468     other    -> False
 469
 470 #endif {- i386_TARGET_ARCH -}
 471 -- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
 472 #if sparc_TARGET_ARCH
 473
 474 regUsage instr = case instr of
 475     LD sz addr reg      -> usage (regAddr addr, [reg])
 476     ST sz reg addr      -> usage (reg : regAddr addr, [])
 477     ADD x cc r1 ar r2   -> usage (r1 : regRI ar, [r2])
 478     SUB x cc r1 ar r2   -> usage (r1 : regRI ar, [r2])
 479     AND b r1 ar r2      -> usage (r1 : regRI ar, [r2])
 480     ANDN b r1 ar r2     -> usage (r1 : regRI ar, [r2])
 481     OR b r1 ar r2       -> usage (r1 : regRI ar, [r2])
 482     ORN b r1 ar r2      -> usage (r1 : regRI ar, [r2])
 483     XOR b r1 ar r2      -> usage (r1 : regRI ar, [r2])
 484     XNOR b r1 ar r2     -> usage (r1 : regRI ar, [r2])
 485     SLL r1 ar r2        -> usage (r1 : regRI ar, [r2])
 486     SRL r1 ar r2        -> usage (r1 : regRI ar, [r2])
 487     SRA r1 ar r2        -> usage (r1 : regRI ar, [r2])
 488     SETHI imm reg       -> usage ([], [reg])
 489     FABS s r1 r2        -> usage ([r1], [r2])
 490     FADD s r1 r2 r3     -> usage ([r1, r2], [r3])
 491     FCMP e s r1 r2      -> usage ([r1, r2], [])
 492     FDIV s r1 r2 r3     -> usage ([r1, r2], [r3])
 493     FMOV s r1 r2        -> usage ([r1], [r2])
 494     FMUL s r1 r2 r3     -> usage ([r1, r2], [r3])
 495     FNEG s r1 r2        -> usage ([r1], [r2])
 496     FSQRT s r1 r2       -> usage ([r1], [r2])
 497     FSUB s r1 r2 r3     -> usage ([r1, r2], [r3])
 498     FxTOy s1 s2 r1 r2   -> usage ([r1], [r2])
 499
 500     -- We assume that all local jumps will be BI/BF.  JMP must be out-of-line.
 501     JMP addr            -> RU (mkRegSet (filter interesting (regAddr addr))) freeRegSet
 502
 503     CALL _ n True       -> endUsage
 504     CALL _ n False      -> RU (argRegSet n) callClobberedRegSet
 505
 506     _                   -> noUsage
 507   where
 508     usage (src, dst) = RU (mkRegSet (filter interesting src))
 509                           (mkRegSet (filter interesting dst))
 510
 511     interesting (FixedReg _) = False
 512     interesting _ = True
 513
 514     regAddr (AddrRegReg r1 r2) = [r1, r2]
 515     regAddr (AddrRegImm r1 _)  = [r1]
 516
 517     regRI (RIReg r) = [r]
 518     regRI  _    = []
 519
 520 #endif {- sparc_TARGET_ARCH -}
 521 \end{code}
 522
 523
 524 %************************************************************************
 525 %*                                                                      *
 526 \subsection{Free, reserved, call-clobbered, and argument registers}
 527 %*                                                                      *
 528 %************************************************************************
 529
 530 @freeRegs@ is the list of registers we can use in register allocation.
 531 @freeReg@ (below) says if a particular register is free.
 532
 533 With a per-instruction clobber list, we might be able to get some of
 534 these back, but it's probably not worth the hassle.
 535
 536 @callClobberedRegs@ ... the obvious.
 537
 538 @argRegs@: assuming a call with N arguments, what registers will be
 539 used to hold arguments?  (NB: it doesn't know whether the arguments
 540 are integer or floating-point...)
 541
 542 findReservedRegs tells us which regs can be used as spill temporaries.
 543 The list of instructions for which we are attempting allocation is
 544 supplied.  This is so that we can (at least for x86) examine it to
 545 discover which registers are being used in a fixed way -- for example,
 546 %eax and %edx are used by integer division, so they can't be used as
 547 spill temporaries.  However, most instruction lists don't do integer
 548 division, so we don't want to rule them out altogether.
 549
 550 findReservedRegs returns not a list of spill temporaries, but a list
 551 of list of them.  This is so that the allocator can attempt allocating
 552 with at first no spill temps, then if that fails, increasing numbers.
 553 For x86 it is important that we minimise the number of regs reserved
 554 as spill temporaries, since there are so few.  For Alpha and Sparc
 555 this isn't a concern; we just ignore the supplied code list and return
 556 a singleton list which we know will satisfy all spill demands.
 557
 558 \begin{code}
 559 findReservedRegs :: [Instr] -> [[RegNo]]
 560 findReservedRegs instrs
 561 #if alpha_TARGET_ARCH
 562   = --[[NCG_Reserved_I1, NCG_Reserved_I2,
 563     --  NCG_Reserved_F1, NCG_Reserved_F2]]
 564     error "findReservedRegs: alpha"
 565 #endif
 566 #if sparc_TARGET_ARCH
 567   = --[[NCG_Reserved_I1, NCG_Reserved_I2,
 568     --  NCG_Reserved_F1, NCG_Reserved_F2,
 569     --  NCG_Reserved_D1, NCG_Reserved_D2]]
 570     error "findReservedRegs: sparc"
 571 #endif
 572 #if i386_TARGET_ARCH
 573     -- Sigh.  This is where it gets complicated.
 574   = -- first of all, try without any at all.
 575     map (map mappedRegNo) (
 576     [ [],
 577     -- if that doesn't work, try one integer reg (which might fail)
 578     -- and two float regs (which will always fix any float insns)
 579       [ecx, fake4,fake5]
 580     ]
 581     -- dire straits (but still correct): see if we can bag %eax and %edx
 582     ++ if   any hasFixedEAXorEDX instrs
 583        then []  -- bummer
 584        else [ [ecx,edx,fake4,fake5],
 585               [ecx,edx,eax,fake4,fake5] ]
 586     )
 587 #endif
 588 \end{code}
 589
 590 %************************************************************************
 591 %*                                                                      *
 592 \subsection{@RegLiveness@ type; @regLiveness@ function}
 593 %*                                                                      *
 594 %************************************************************************
 595
 596 @regLiveness@ takes future liveness information and modifies it
 597 according to the semantics of branches and labels.  (An out-of-line
 598 branch clobbers the liveness passed back by the following instruction;
 599 a forward local branch passes back the liveness from the target label;
 600 a conditional branch merges the liveness from the target and the
 601 liveness from its successor; a label stashes away the current liveness
 602 in the future liveness environment).
 603
 604 \begin{code}
 605 data RegLiveness = RL RegSet FutureLive
 606
 607 regLiveness :: Instr -> RegLiveness -> RegLiveness
 608
 609 regLiveness instr info@(RL live future@(FL all env))
 610   = let
 611         lookup lbl
 612           = case (lookupFM env lbl) of
 613             Just rs -> rs
 614             Nothing -> pprTrace "Missing" (pprCLabel_asm lbl <+> text "in future?")
 615                        emptyRegSet
 616     in
 617     case instr of -- the rest is machine-specific...
 618
 619 #if alpha_TARGET_ARCH
 620
 621     -- We assume that all local jumps will be BI/BF.  JMP must be out-of-line.
 622
 623     BR (ImmCLbl lbl)     -> RL (lookup lbl) future
 624     BI _ _ (ImmCLbl lbl) -> RL (lookup lbl `unionRegSets` live) future
 625     BF _ _ (ImmCLbl lbl) -> RL (lookup lbl `unionRegSets` live) future
 626     JMP _ _ _            -> RL emptyRegSet future
 627     BSR _ _              -> RL live future
 628     JSR _ _ _            -> RL live future
 629     LABEL lbl            -> RL live (FL (all `unionRegSets` live) (addToFM env lbl live))
 630     _                    -> info
 631
 632 #endif {- alpha_TARGET_ARCH -}
 633 -- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
 634 #if i386_TARGET_ARCH
 635
 636     JXX _ lbl   -> RL (lookup lbl `unionRegSets` live) future
 637     JMP _       -> RL emptyRegSet future
 638     CALL _      -> RL live future
 639     LABEL lbl   -> RL live (FL (all `unionRegSets` live) (addToFM env lbl live))
 640     _               -> info
 641
 642 #endif {- i386_TARGET_ARCH -}
 643 -- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
 644 #if sparc_TARGET_ARCH
 645
 646     -- We assume that all local jumps will be BI/BF.  JMP must be out-of-line.
 647
 648     BI ALWAYS _ (ImmCLbl lbl)   -> RL (lookup lbl) future
 649     BI _ _ (ImmCLbl lbl)        -> RL (lookup lbl `unionRegSets` live) future
 650     BF ALWAYS _ (ImmCLbl lbl)   -> RL (lookup lbl) future
 651     BF _ _ (ImmCLbl lbl)        -> RL (lookup lbl `unionRegSets` live) future
 652     JMP _                       -> RL emptyRegSet future
 653     CALL _ i True   -> RL emptyRegSet future
 654     CALL _ i False  -> RL live future
 655     LABEL lbl       -> RL live (FL (all `unionRegSets` live) (addToFM env lbl live))
 656     _               -> info
 657
 658 #endif {- sparc_TARGET_ARCH -}
 659 \end{code}
 660
 661 %************************************************************************
 662 %*                                                                      *
 663 \subsection{@patchRegs@ function}
 664 %*                                                                      *
 665 %************************************************************************
 666
 667 @patchRegs@ takes an instruction (possibly with
 668 MemoryReg/UnmappedReg registers) and changes all register references
 669 according to the supplied environment.
 670
 671 \begin{code}
 672 patchRegs :: Instr -> (Reg -> Reg) -> Instr
 673
 674 #if alpha_TARGET_ARCH
 675
 676 patchRegs instr env = case instr of
 677     LD sz reg addr -> LD sz (env reg) (fixAddr addr)
 678     LDA reg addr -> LDA (env reg) (fixAddr addr)
 679     LDAH reg addr -> LDAH (env reg) (fixAddr addr)
 680     LDGP reg addr -> LDGP (env reg) (fixAddr addr)
 681     LDI sz reg imm -> LDI sz (env reg) imm
 682     ST sz reg addr -> ST sz (env reg) (fixAddr addr)
 683     CLR reg -> CLR (env reg)
 684     ABS sz ar reg -> ABS sz (fixRI ar) (env reg)
 685     NEG sz ov ar reg -> NEG sz ov (fixRI ar) (env reg)
 686     ADD sz ov r1 ar r2 -> ADD sz ov (env r1) (fixRI ar) (env r2)
 687     SADD sz sc r1 ar r2 -> SADD sz sc (env r1) (fixRI ar) (env r2)
 688     SUB sz ov r1 ar r2 -> SUB sz ov (env r1) (fixRI ar) (env r2)
 689     SSUB sz sc r1 ar r2 -> SSUB sz sc (env r1) (fixRI ar) (env r2)
 690     MUL sz ov r1 ar r2 -> MUL sz ov (env r1) (fixRI ar) (env r2)
 691     DIV sz un r1 ar r2 -> DIV sz un (env r1) (fixRI ar) (env r2)
 692     REM sz un r1 ar r2 -> REM sz un (env r1) (fixRI ar) (env r2)
 693     NOT ar reg -> NOT (fixRI ar) (env reg)
 694     AND r1 ar r2 -> AND (env r1) (fixRI ar) (env r2)
 695     ANDNOT r1 ar r2 -> ANDNOT (env r1) (fixRI ar) (env r2)
 696     OR r1 ar r2 -> OR (env r1) (fixRI ar) (env r2)
 697     ORNOT r1 ar r2 -> ORNOT (env r1) (fixRI ar) (env r2)
 698     XOR r1 ar r2 -> XOR (env r1) (fixRI ar) (env r2)
 699     XORNOT r1 ar r2 -> XORNOT (env r1) (fixRI ar) (env r2)
 700     SLL r1 ar r2 -> SLL (env r1) (fixRI ar) (env r2)
 701     SRL r1 ar r2 -> SRL (env r1) (fixRI ar) (env r2)
 702     SRA r1 ar r2 -> SRA (env r1) (fixRI ar) (env r2)
 703     ZAP r1 ar r2 -> ZAP (env r1) (fixRI ar) (env r2)
 704     ZAPNOT r1 ar r2 -> ZAPNOT (env r1) (fixRI ar) (env r2)
 705     CMP co r1 ar r2 -> CMP co (env r1) (fixRI ar) (env r2)
 706     FCLR reg -> FCLR (env reg)
 707     FABS r1 r2 -> FABS (env r1) (env r2)
 708     FNEG s r1 r2 -> FNEG s (env r1) (env r2)
 709     FADD s r1 r2 r3 -> FADD s (env r1) (env r2) (env r3)
 710     FDIV s r1 r2 r3 -> FDIV s (env r1) (env r2) (env r3)
 711     FMUL s r1 r2 r3 -> FMUL s (env r1) (env r2) (env r3)
 712     FSUB s r1 r2 r3 -> FSUB s (env r1) (env r2) (env r3)
 713     CVTxy s1 s2 r1 r2 -> CVTxy s1 s2 (env r1) (env r2)
 714     FCMP s co r1 r2 r3 -> FCMP s co (env r1) (env r2) (env r3)
 715     FMOV r1 r2 -> FMOV (env r1) (env r2)
 716     BI cond reg lbl -> BI cond (env reg) lbl
 717     BF cond reg lbl -> BF cond (env reg) lbl
 718     JMP reg addr hint -> JMP (env reg) (fixAddr addr) hint
 719     JSR reg addr i -> JSR (env reg) (fixAddr addr) i
 720     _ -> instr
 721   where
 722     fixAddr (AddrReg r1)       = AddrReg (env r1)
 723     fixAddr (AddrRegImm r1 i)  = AddrRegImm (env r1) i
 724     fixAddr other              = other
 725
 726     fixRI (RIReg r) = RIReg (env r)
 727     fixRI other = other
 728
 729 #endif {- alpha_TARGET_ARCH -}
 730 -- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
 731 #if i386_TARGET_ARCH
 732
 733 patchRegs instr env = case instr of
 734     MOV  sz src dst     -> patch2 (MOV  sz) src dst
 735     MOVZxL sz src dst   -> patch2 (MOVZxL sz) src dst
 736     MOVSxL sz src dst   -> patch2 (MOVSxL sz) src dst
 737     LEA  sz src dst     -> patch2 (LEA  sz) src dst
 738     ADD  sz src dst     -> patch2 (ADD  sz) src dst
 739     SUB  sz src dst     -> patch2 (SUB  sz) src dst
 740     IMUL sz src dst     -> patch2 (IMUL sz) src dst
 741     IDIV sz src         -> patch1 (IDIV sz) src
 742     AND  sz src dst     -> patch2 (AND  sz) src dst
 743     OR   sz src dst     -> patch2 (OR   sz) src dst
 744     XOR  sz src dst     -> patch2 (XOR  sz) src dst
 745     NOT  sz op          -> patch1 (NOT  sz) op
 746     NEGI sz op          -> patch1 (NEGI sz) op
 747     SHL  sz imm dst     -> patch1 (SHL sz imm) dst
 748     SAR  sz imm dst     -> patch1 (SAR sz imm) dst
 749     SHR  sz imm dst     -> patch1 (SHR sz imm) dst
 750     BT   sz imm src     -> patch1 (BT  sz imm) src
 751     TEST sz src dst     -> patch2 (TEST sz) src dst
 752     CMP  sz src dst     -> patch2 (CMP  sz) src dst
 753     PUSH sz op          -> patch1 (PUSH sz) op
 754     POP  sz op          -> patch1 (POP  sz) op
 755     SETCC cond op       -> patch1 (SETCC cond) op
 756     JMP op              -> patch1 JMP op
 757
 758     GMOV src dst        -> GMOV (env src) (env dst)
 759     GLD sz src dst      -> GLD sz (lookupAddr src) (env dst)
 760     GST sz src dst      -> GST sz (env src) (lookupAddr dst)
 761
 762     GFTOD src dst       -> GFTOD (env src) (env dst)
 763     GFTOI src dst       -> GFTOI (env src) (env dst)
 764
 765     GDTOF src dst       -> GDTOF (env src) (env dst)
 766     GDTOI src dst       -> GDTOI (env src) (env dst)
 767
 768     GITOF src dst       -> GITOF (env src) (env dst)
 769     GITOD src dst       -> GITOD (env src) (env dst)
 770
 771     GADD sz s1 s2 dst   -> GADD sz (env s1) (env s2) (env dst)
 772     GSUB sz s1 s2 dst   -> GSUB sz (env s1) (env s2) (env dst)
 773     GMUL sz s1 s2 dst   -> GMUL sz (env s1) (env s2) (env dst)
 774     GDIV sz s1 s2 dst   -> GDIV sz (env s1) (env s2) (env dst)
 775
 776     GCMP sz src1 src2   -> GCMP sz (env src1) (env src2)
 777     GABS sz src dst     -> GABS sz (env src) (env dst)
 778     GNEG sz src dst     -> GNEG sz (env src) (env dst)
 779     GSQRT sz src dst    -> GSQRT sz (env src) (env dst)
 780     GSIN sz src dst     -> GSIN sz (env src) (env dst)
 781     GCOS sz src dst     -> GCOS sz (env src) (env dst)
 782     GTAN sz src dst     -> GTAN sz (env src) (env dst)
 783
 784     COMMENT _           -> instr
 785     SEGMENT _           -> instr
 786     LABEL _             -> instr
 787     ASCII _ _           -> instr
 788     DATA _ _            -> instr
 789     JXX _ _             -> instr
 790     CALL _              -> instr
 791     CLTD                -> instr
 792     _                   -> pprPanic "patchInstr(x86)" empty
 793
 794   where
 795     patch1 insn op      = insn (patchOp op)
 796     patch2 insn src dst = insn (patchOp src) (patchOp dst)
 797
 798     patchOp (OpReg  reg) = OpReg (env reg)
 799     patchOp (OpImm  imm) = OpImm imm
 800     patchOp (OpAddr ea)  = OpAddr (lookupAddr ea)
 801
 802     lookupAddr (ImmAddr imm off) = ImmAddr imm off
 803     lookupAddr (AddrBaseIndex base index disp)
 804       = AddrBaseIndex (lookupBase base) (lookupIndex index) disp
 805       where
 806         lookupBase Nothing       = Nothing
 807         lookupBase (Just r)      = Just (env r)
 808
 809         lookupIndex Nothing      = Nothing
 810         lookupIndex (Just (r,i)) = Just (env r, i)
 811
 812 #endif {- i386_TARGET_ARCH -}
 813 -- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
 814 #if sparc_TARGET_ARCH
 815
 816 patchRegs instr env = case instr of
 817     LD sz addr reg -> LD sz (fixAddr addr) (env reg)
 818     ST sz reg addr -> ST sz (env reg) (fixAddr addr)
 819     ADD x cc r1 ar r2 -> ADD x cc (env r1) (fixRI ar) (env r2)
 820     SUB x cc r1 ar r2 -> SUB x cc (env r1) (fixRI ar) (env r2)
 821     AND b r1 ar r2 -> AND b (env r1) (fixRI ar) (env r2)
 822     ANDN b r1 ar r2 -> ANDN b (env r1) (fixRI ar) (env r2)
 823     OR b r1 ar r2 -> OR b (env r1) (fixRI ar) (env r2)
 824     ORN b r1 ar r2 -> ORN b (env r1) (fixRI ar) (env r2)
 825     XOR b r1 ar r2 -> XOR b (env r1) (fixRI ar) (env r2)
 826     XNOR b r1 ar r2 -> XNOR b (env r1) (fixRI ar) (env r2)
 827     SLL r1 ar r2 -> SLL (env r1) (fixRI ar) (env r2)
 828     SRL r1 ar r2 -> SRL (env r1) (fixRI ar) (env r2)
 829     SRA r1 ar r2 -> SRA (env r1) (fixRI ar) (env r2)
 830     SETHI imm reg -> SETHI imm (env reg)
 831     FABS s r1 r2 -> FABS s (env r1) (env r2)
 832     FADD s r1 r2 r3 -> FADD s (env r1) (env r2) (env r3)
 833     FCMP e s r1 r2 -> FCMP e s (env r1) (env r2)
 834     FDIV s r1 r2 r3 -> FDIV s (env r1) (env r2) (env r3)
 835     FMOV s r1 r2 -> FMOV s (env r1) (env r2)
 836     FMUL s r1 r2 r3 -> FMUL s (env r1) (env r2) (env r3)
 837     FNEG s r1 r2 -> FNEG s (env r1) (env r2)
 838     FSQRT s r1 r2 -> FSQRT s (env r1) (env r2)
 839     FSUB s r1 r2 r3 -> FSUB s (env r1) (env r2) (env r3)
 840     FxTOy s1 s2 r1 r2 -> FxTOy s1 s2 (env r1) (env r2)
 841     JMP addr -> JMP (fixAddr addr)
 842     _ -> instr
 843   where
 844     fixAddr (AddrRegReg r1 r2) = AddrRegReg (env r1) (env r2)
 845     fixAddr (AddrRegImm r1 i)  = AddrRegImm (env r1) i
 846
 847     fixRI (RIReg r) = RIReg (env r)
 848     fixRI other = other
 849
 850 #endif {- sparc_TARGET_ARCH -}
 851 \end{code}
 852
 853 %************************************************************************
 854 %*                                                                      *
 855 \subsection{@spillReg@ and @loadReg@ functions}
 856 %*                                                                      *
 857 %************************************************************************
 858
 859 Spill to memory, and load it back...
 860
 861 JRS, 000122: on x86, don't spill directly above the stack pointer,
 862 since some insn sequences (int <-> conversions, and eventually
 863 StixInteger) use this as a temp location.  Leave 8 words (ie, 64 bytes
 864 for a 64-bit arch) of slop.
 865
 866 \begin{code}
 867 maxSpillSlots :: Int
 868 maxSpillSlots = (rESERVED_C_STACK_BYTES - 64) `div` 8
 869
 870 -- convert a spill slot number to a *byte* offset, with no sign:
 871 -- decide on a per arch basis whether you are spilling above or below
 872 -- the C stack pointer.
 873 spillSlotToOffset :: Int -> Int
 874 spillSlotToOffset slot
 875    | slot >= 0 && slot < maxSpillSlots
 876    = 64 + 8 * slot
 877    | otherwise
 878    = pprPanic "spillSlotToOffset:"
 879               (text "invalid spill location: " <> int slot)
 880
 881 spillReg, loadReg :: Reg -> Reg -> InstrList
 882
 883 spillReg dyn (MemoryReg i pk)
 884   = let sz  = primRepToSize pk
 885         off = spillSlotToOffset i
 886     in
 887     mkUnitList (
 888         {-Alpha: spill below the stack pointer (?)-}
 889          IF_ARCH_alpha( ST sz dyn (spRel (- (off `div` 8)))
 890
 891         {-I386: spill above stack pointer leaving 2 words/spill-}
 892         ,IF_ARCH_i386 ( let off_w = off `div` 4
 893                         in
 894                         if pk == FloatRep || pk == DoubleRep
 895                         then GST DF dyn (spRel off_w)
 896                         else MOV sz (OpReg dyn) (OpAddr (spRel off_w))
 897
 898         {-SPARC: spill below frame pointer leaving 2 words/spill-}
 899         ,IF_ARCH_sparc( ST sz dyn (fpRel (- (off `div` 4)))
 900         ,)))
 901     )
 902
 903 loadReg (MemoryReg i pk) dyn
 904   = let sz  = primRepToSize pk
 905         off = spillSlotToOffset i
 906     in
 907     mkUnitList (
 908          IF_ARCH_alpha( LD  sz dyn (spRel (- (off `div` 8)))
 909         ,IF_ARCH_i386 ( let off_w = off `div` 4
 910                         in
 911                         if   pk == FloatRep || pk == DoubleRep
 912                         then GLD DF (spRel off_w) dyn
 913                         else MOV sz (OpAddr (spRel off_w)) (OpReg dyn)
 914         ,IF_ARCH_sparc( LD  sz (fpRel (- (off `div` 4))) dyn
 915         ,)))
 916     )
 917 \end{code}