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