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
  39         RegSet,
  40         elementOfRegSet,
  41         emptyRegSet,
  42         isEmptyRegSet,
  43         minusRegSet,
  44         mkRegSet,
  45         regSetToList,
  46         unionRegSets,
  47
  48         argRegSet,
  49         callClobberedRegSet,
  50         freeRegSet
  51     ) where
  52
  53 #include "HsVersions.h"
  54
  55 import List             ( partition )
  56 import MachMisc
  57 import MachRegs
  58 import MachCode         ( InstrList )
  59
  60 import BitSet           ( unitBS, mkBS, minusBS, unionBS, listBS, BitSet )
  61 import CLabel           ( pprCLabel_asm, CLabel{-instance Ord-} )
  62 import FiniteMap        ( addToFM, lookupFM, FiniteMap )
  63 import OrdList          ( mkUnitList )
  64 import PrimRep          ( PrimRep(..) )
  65 import UniqSet          -- quite a bit of it
  66 import Outputable
  67 \end{code}
  68
  69 %************************************************************************
  70 %*                                                                      *
  71 \subsection{Register allocation information}
  72 %*                                                                      *
  73 %************************************************************************
  74
  75 \begin{code}
  76 type RegSet = UniqSet Reg
  77
  78 mkRegSet :: [Reg] -> RegSet
  79 emptyRegSet :: RegSet
  80 unionRegSets, minusRegSet :: RegSet -> RegSet -> RegSet
  81 elementOfRegSet :: Reg -> RegSet -> Bool
  82 isEmptyRegSet :: RegSet -> Bool
  83 regSetToList :: RegSet -> [Reg]
  84
  85 mkRegSet        = mkUniqSet
  86 emptyRegSet     = emptyUniqSet
  87 unionRegSets    = unionUniqSets
  88 minusRegSet     = minusUniqSet
  89 elementOfRegSet = elementOfUniqSet
  90 isEmptyRegSet   = isEmptyUniqSet
  91 regSetToList    = uniqSetToList
  92
  93 freeRegSet, callClobberedRegSet :: RegSet
  94 argRegSet :: Int -> RegSet
  95
  96 freeRegSet          = mkRegSet freeRegs
  97 callClobberedRegSet = mkRegSet callClobberedRegs
  98 argRegSet n         = mkRegSet (argRegs n)
  99
 100 type RegAssignment = FiniteMap Reg Reg
 101 type RegConflicts  = FiniteMap Int RegSet
 102
 103 data FutureLive = FL RegSet (FiniteMap CLabel RegSet)
 104
 105 fstFL (FL a b)  = a
 106
 107 data RegHistory a
 108   = RH  a
 109         Int
 110         RegAssignment
 111
 112 data RegFuture
 113   = RF  RegSet          -- in use
 114         FutureLive      -- future
 115         RegConflicts
 116
 117 data RegInfo a
 118   = RI  RegSet          -- in use
 119         RegSet          -- sources
 120         RegSet          -- destinations
 121         [Reg]           -- last used
 122         RegConflicts
 123 \end{code}
 124
 125 %************************************************************************
 126 %*                                                                      *
 127 \subsection{Register allocation information}
 128 %*                                                                      *
 129 %************************************************************************
 130
 131 COMMENT ON THE EXTRA BitSet FOR SPARC MRegsState: Getting the conflicts
 132 right is a bit tedious for doubles.  We'd have to add a conflict
 133 function to the MachineRegisters class, and we'd have to put a PrimRep
 134 in the MappedReg datatype, or use some kludge (e.g. register 64 + n is
 135 really the same as 32 + n, except that it's used for a double, so it
 136 also conflicts with 33 + n) to deal with it.  It's just not worth the
 137 bother, so we just partition the free floating point registers into
 138 two sets: one for single precision and one for double precision.  We
 139 never seem to run out of floating point registers anyway.
 140
 141 \begin{code}
 142 data MRegsState
 143   = MRs BitSet  -- integer registers
 144         BitSet  -- floating-point registers
 145         IF_ARCH_sparc(BitSet,) -- double registers handled separately
 146 \end{code}
 147
 148 \begin{code}
 149 #if alpha_TARGET_ARCH
 150 # define INT_FLPT_CUTOFF 32
 151 #endif
 152 #if i386_TARGET_ARCH
 153 # define INT_FLPT_CUTOFF 8
 154 #endif
 155 #if sparc_TARGET_ARCH
 156 # define INT_FLPT_CUTOFF 32
 157 # define SNGL_DBL_CUTOFF 48
 158 #endif
 159
 160 mkMRegsState    :: [RegNo] -> MRegsState
 161 possibleMRegs   :: PrimRep -> MRegsState -> [RegNo]
 162 useMReg         :: MRegsState -> FAST_REG_NO -> MRegsState
 163 useMRegs        :: MRegsState -> [RegNo]     -> MRegsState
 164 freeMReg        :: MRegsState -> FAST_REG_NO -> MRegsState
 165 freeMRegs       :: MRegsState -> [RegNo]     -> MRegsState
 166
 167 mkMRegsState xs
 168   = MRs (mkBS is) (mkBS fs2) IF_ARCH_sparc((mkBS ds2),)
 169   where
 170     (is, fs) = partition (< INT_FLPT_CUTOFF) xs
 171 #if sparc_TARGET_ARCH
 172     (ss, ds) = partition (< SNGL_DBL_CUTOFF) fs
 173     fs2  = map (subtract INT_FLPT_CUTOFF) ss
 174     ds2  = map (subtract INT_FLPT_CUTOFF) (filter even ds)
 175 #else
 176     fs2      = map (subtract INT_FLPT_CUTOFF) fs
 177 #endif
 178
 179 ------------------------------------------------
 180 #if sparc_TARGET_ARCH
 181 possibleMRegs FloatRep  (MRs _ ss _) = [ x + INT_FLPT_CUTOFF | x <- listBS ss]
 182 possibleMRegs DoubleRep (MRs _ _ ds) = [ x + INT_FLPT_CUTOFF | x <- listBS ds]
 183 possibleMRegs _         (MRs is _ _) = listBS is
 184 #else
 185 possibleMRegs FloatRep  (MRs _ fs) = [ x + INT_FLPT_CUTOFF | x <- listBS fs]
 186 possibleMRegs DoubleRep (MRs _ fs) = [ x + INT_FLPT_CUTOFF | x <- listBS fs]
 187 possibleMRegs _     (MRs is _) = listBS is
 188 #endif
 189
 190 ------------------------------------------------
 191 #if sparc_TARGET_ARCH
 192 useMReg (MRs is ss ds) n
 193   = if (n _LT_ ILIT(INT_FLPT_CUTOFF)) then
 194         MRs (is `minusBS` unitBS IBOX(n)) ss ds
 195     else if (n _LT_ ILIT(SNGL_DBL_CUTOFF)) then
 196         MRs is (ss `minusBS` unitBS (IBOX(n _SUB_ ILIT(INT_FLPT_CUTOFF)))) ds
 197     else
 198         MRs is ss (ds `minusBS` unitBS (IBOX(n _SUB_ ILIT(INT_FLPT_CUTOFF))))
 199 #else
 200 useMReg (MRs is fs) n
 201   = if (n _LT_ ILIT(INT_FLPT_CUTOFF))
 202     then MRs (is `minusBS` unitBS IBOX(n)) fs
 203     else MRs is (fs `minusBS` unitBS (IBOX(n _SUB_ ILIT(INT_FLPT_CUTOFF))))
 204 #endif
 205
 206 ------------------------------------------------
 207 #if sparc_TARGET_ARCH
 208 useMRegs (MRs is ss ds) xs
 209   = MRs (is `minusBS` is2) (ss `minusBS` ss2) (ds `minusBS` ds2)
 210   where
 211     MRs is2 ss2 ds2 = mkMRegsState xs
 212 #else
 213 useMRegs (MRs is fs) xs
 214   = MRs (is `minusBS` is2) (fs `minusBS` fs2)
 215   where
 216     MRs is2 fs2 = mkMRegsState xs
 217 #endif
 218
 219 ------------------------------------------------
 220 #if sparc_TARGET_ARCH
 221 freeMReg (MRs is ss ds) n
 222   = if (n _LT_ ILIT(INT_FLPT_CUTOFF)) then
 223         MRs (is `unionBS` unitBS IBOX(n)) ss ds
 224     else if (n _LT_ ILIT(SNGL_DBL_CUTOFF)) then
 225         MRs is (ss `unionBS` unitBS (IBOX(n _SUB_ ILIT(INT_FLPT_CUTOFF)))) ds
 226     else
 227         MRs is ss (ds `unionBS` unitBS (IBOX(n _SUB_ ILIT(INT_FLPT_CUTOFF))))
 228 #else
 229 freeMReg (MRs is fs) n
 230   = if (n _LT_ ILIT(INT_FLPT_CUTOFF))
 231     then MRs (is `unionBS` unitBS IBOX(n)) fs
 232     else MRs is (fs `unionBS` unitBS (IBOX(n _SUB_ ILIT(INT_FLPT_CUTOFF))))
 233 #endif
 234
 235 ------------------------------------------------
 236 #if sparc_TARGET_ARCH
 237 freeMRegs (MRs is ss ds) xs
 238   = MRs (is `unionBS` is2) (ss `unionBS` ss2) (ds `unionBS` ds2)
 239   where
 240     MRs is2 ss2 ds2 = mkMRegsState xs
 241 #else
 242 freeMRegs (MRs is fs) xs
 243   = MRs (is `unionBS` is2) (fs `unionBS` fs2)
 244   where
 245     MRs is2 fs2 = mkMRegsState xs
 246 #endif
 247 \end{code}
 248
 249 %************************************************************************
 250 %*                                                                      *
 251 \subsection{@RegUsage@ type; @noUsage@, @endUsage@, @regUsage@ functions}
 252 %*                                                                      *
 253 %************************************************************************
 254
 255 @regUsage@ returns the sets of src and destination registers used by a
 256 particular instruction.  Machine registers that are pre-allocated to
 257 stgRegs are filtered out, because they are uninteresting from a
 258 register allocation standpoint.  (We wouldn't want them to end up on
 259 the free list!)
 260
 261 An important point: The @regUsage@ function for a particular
 262 assembly language must not refer to fixed registers, such as Hp, SpA,
 263 etc.  The source and destination MRegsStates should only refer to
 264 dynamically allocated registers or static registers from the free
 265 list.  As far as we are concerned, the fixed registers simply don't
 266 exist (for allocation purposes, anyway).
 267
 268 \begin{code}
 269 data RegUsage = RU RegSet RegSet
 270
 271 noUsage, endUsage :: RegUsage
 272 noUsage  = RU emptyRegSet emptyRegSet
 273 endUsage = RU emptyRegSet freeRegSet
 274
 275 regUsage :: Instr -> RegUsage
 276
 277 #if alpha_TARGET_ARCH
 278
 279 regUsage instr = case instr of
 280     LD B reg addr       -> usage (regAddr addr, [reg, t9])
 281     LD BU reg addr      -> usage (regAddr addr, [reg, t9])
 282 --  LD W reg addr       -> usage (regAddr addr, [reg, t9]) : UNUSED
 283 --  LD WU reg addr      -> usage (regAddr addr, [reg, t9]) : UNUSED
 284     LD sz reg addr      -> usage (regAddr addr, [reg])
 285     LDA reg addr        -> usage (regAddr addr, [reg])
 286     LDAH reg addr       -> usage (regAddr addr, [reg])
 287     LDGP reg addr       -> usage (regAddr addr, [reg])
 288     LDI sz reg imm      -> usage ([], [reg])
 289     ST B reg addr       -> usage (reg : regAddr addr, [t9, t10])
 290 --  ST W reg addr       -> usage (reg : regAddr addr, [t9, t10]) : UNUSED
 291     ST sz reg addr      -> usage (reg : regAddr addr, [])
 292     CLR reg             -> usage ([], [reg])
 293     ABS sz ri reg       -> usage (regRI ri, [reg])
 294     NEG sz ov ri reg    -> usage (regRI ri, [reg])
 295     ADD sz ov r1 ar r2  -> usage (r1 : regRI ar, [r2])
 296     SADD sz sc r1 ar r2 -> usage (r1 : regRI ar, [r2])
 297     SUB sz ov r1 ar r2  -> usage (r1 : regRI ar, [r2])
 298     SSUB sz sc r1 ar r2 -> usage (r1 : regRI ar, [r2])
 299     MUL sz ov r1 ar r2  -> usage (r1 : regRI ar, [r2])
 300     DIV sz un r1 ar r2  -> usage (r1 : regRI ar, [r2, t9, t10, t11, t12])
 301     REM sz un r1 ar r2  -> usage (r1 : regRI ar, [r2, t9, t10, t11, t12])
 302     NOT ri reg          -> usage (regRI ri, [reg])
 303     AND r1 ar r2        -> usage (r1 : regRI ar, [r2])
 304     ANDNOT r1 ar r2     -> usage (r1 : regRI ar, [r2])
 305     OR r1 ar r2         -> usage (r1 : regRI ar, [r2])
 306     ORNOT r1 ar r2      -> usage (r1 : regRI ar, [r2])
 307     XOR r1 ar r2        -> usage (r1 : regRI ar, [r2])
 308     XORNOT r1 ar r2     -> usage (r1 : regRI ar, [r2])
 309     SLL r1 ar r2        -> usage (r1 : regRI ar, [r2])
 310     SRL r1 ar r2        -> usage (r1 : regRI ar, [r2])
 311     SRA r1 ar r2        -> usage (r1 : regRI ar, [r2])
 312     ZAP r1 ar r2        -> usage (r1 : regRI ar, [r2])
 313     ZAPNOT r1 ar r2     -> usage (r1 : regRI ar, [r2])
 314     CMP co r1 ar r2     -> usage (r1 : regRI ar, [r2])
 315     FCLR reg            -> usage ([], [reg])
 316     FABS r1 r2          -> usage ([r1], [r2])
 317     FNEG sz r1 r2       -> usage ([r1], [r2])
 318     FADD sz r1 r2 r3    -> usage ([r1, r2], [r3])
 319     FDIV sz r1 r2 r3    -> usage ([r1, r2], [r3])
 320     FMUL sz r1 r2 r3    -> usage ([r1, r2], [r3])
 321     FSUB sz r1 r2 r3    -> usage ([r1, r2], [r3])
 322     CVTxy sz1 sz2 r1 r2 -> usage ([r1], [r2])
 323     FCMP sz co r1 r2 r3 -> usage ([r1, r2], [r3])
 324     FMOV r1 r2          -> usage ([r1], [r2])
 325
 326
 327     -- We assume that all local jumps will be BI/BF/BR.  JMP must be out-of-line.
 328     BI cond reg lbl     -> usage ([reg], [])
 329     BF cond reg lbl     -> usage ([reg], [])
 330     JMP reg addr hint   -> RU (mkRegSet (filter interesting (regAddr addr))) freeRegSet
 331
 332     BSR _ n             -> RU (argRegSet n) callClobberedRegSet
 333     JSR reg addr n      -> RU (argRegSet n) callClobberedRegSet
 334
 335     _                   -> noUsage
 336
 337   where
 338     usage (src, dst) = RU (mkRegSet (filter interesting src))
 339                           (mkRegSet (filter interesting dst))
 340
 341     interesting (FixedReg _) = False
 342     interesting _ = True
 343
 344     regAddr (AddrReg r1)      = [r1]
 345     regAddr (AddrRegImm r1 _) = [r1]
 346     regAddr (AddrImm _)       = []
 347
 348     regRI (RIReg r) = [r]
 349     regRI  _    = []
 350
 351 #endif {- alpha_TARGET_ARCH -}
 352 -- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
 353 #if i386_TARGET_ARCH
 354
 355 regUsage instr = case instr of
 356     MOV  sz src dst     -> usage2 src dst
 357     MOVZX sz src dst    -> usage2 src dst
 358     MOVSX sz src dst    -> usage2 src dst
 359     LEA  sz src dst     -> usage2 src dst
 360     ADD  sz src dst     -> usage2 src dst
 361     SUB  sz src dst     -> usage2 src dst
 362     IMUL sz src dst     -> usage2 src dst
 363     IDIV sz src         -> usage (eax:edx:opToReg src) [eax,edx]
 364     AND  sz src dst     -> usage2 src dst
 365     OR   sz src dst     -> usage2 src dst
 366     XOR  sz src dst     -> usage2 src dst
 367     NOT  sz op          -> usage1 op
 368     NEGI sz op          -> usage1 op
 369     SHL  sz dst len     -> usage2 dst len -- len is either an Imm or ecx.
 370     SAR  sz dst len     -> usage2 dst len -- len is either an Imm or ecx.
 371     SHR  sz len dst     -> usage2 dst len -- len is either an Imm or ecx.
 372     PUSH sz op          -> usage (opToReg op) []
 373     POP  sz op          -> usage [] (opToReg op)
 374     TEST sz src dst     -> usage (opToReg src ++ opToReg dst) []
 375     CMP  sz src dst     -> usage (opToReg src ++ opToReg dst) []
 376     SETCC cond op       -> usage [] (opToReg op)
 377     JXX cond label      -> usage [] []
 378     JMP op              -> usage (opToReg op) freeRegs
 379     CALL imm            -> usage [] callClobberedRegs
 380     CLTD                -> usage [eax] [edx]
 381     NOP                 -> usage [] []
 382     SAHF                -> usage [eax] []
 383     FABS                -> usage [st0] [st0]
 384     FADD sz src         -> usage (st0:opToReg src) [st0] -- allFPRegs
 385     FADDP               -> usage [st0,st1] [st0] -- allFPRegs
 386     FIADD sz asrc       -> usage (addrToRegs asrc) [st0]
 387     FCHS                -> usage [st0] [st0]
 388     FCOM sz src         -> usage (st0:opToReg src) []
 389     FCOS                -> usage [st0] [st0]
 390     FDIV sz src         -> usage (st0:opToReg src) [st0]
 391     FDIVP               -> usage [st0,st1] [st0]
 392     FDIVRP              -> usage [st0,st1] [st0]
 393     FIDIV sz asrc       -> usage (addrToRegs asrc) [st0]
 394     FDIVR sz src        -> usage (st0:opToReg src) [st0]
 395     FIDIVR sz asrc      -> usage (addrToRegs asrc) [st0]
 396     FICOM sz asrc       -> usage (addrToRegs asrc) []
 397     FILD sz asrc dst    -> usage (addrToRegs asrc) [dst] -- allFPRegs
 398     FIST sz adst        -> usage (st0:addrToRegs adst) []
 399     FLD  sz src         -> usage (opToReg src) [st0] -- allFPRegs
 400     FLD1                -> usage [] [st0] -- allFPRegs
 401     FLDZ                -> usage [] [st0] -- allFPRegs
 402     FMUL sz src         -> usage (st0:opToReg src) [st0]
 403     FMULP               -> usage [st0,st1] [st0]
 404     FIMUL sz asrc       -> usage (addrToRegs asrc) [st0]
 405     FRNDINT             -> usage [st0] [st0]
 406     FSIN                -> usage [st0] [st0]
 407     FSQRT               -> usage [st0] [st0]
 408     FST sz (OpReg r)    -> usage [st0] [r]
 409     FST sz dst          -> usage (st0:opToReg dst) []
 410     FSTP sz (OpReg r)   -> usage [st0] [r] -- allFPRegs
 411     FSTP sz dst         -> usage (st0:opToReg dst) [] -- allFPRegs
 412     FSUB sz src         -> usage (st0:opToReg src) [st0] -- allFPRegs
 413     FSUBR sz src        -> usage (st0:opToReg src) [st0] -- allFPRegs
 414     FISUB sz asrc       -> usage (addrToRegs asrc) [st0]
 415     FSUBP               -> usage [st0,st1] [st0] -- allFPRegs
 416     FSUBRP              -> usage [st0,st1] [st0] -- allFPRegs
 417     FISUBR sz asrc      -> usage (addrToRegs asrc) [st0]
 418     FTST                -> usage [st0] []
 419     FCOMP sz op         -> usage (st0:opToReg op) [st0] -- allFPRegs
 420     FUCOMPP             -> usage [st0, st1] [st0, st1] --  allFPRegs
 421     FXCH                -> usage [st0, st1] [st0, st1]
 422     FNSTSW              -> usage [] [eax]
 423     _                   -> noUsage
 424  where
 425     usage2 :: Operand -> Operand -> RegUsage
 426     usage2 op (OpReg reg) = usage (opToReg op) [reg]
 427     usage2 op (OpAddr ea) = usage (opToReg op ++ addrToRegs ea) []
 428     usage2 op (OpImm imm) = usage (opToReg op) []
 429     usage1 :: Operand -> RegUsage
 430     usage1 (OpReg reg)    = usage [reg] [reg]
 431     usage1 (OpAddr ea)    = usage (addrToRegs ea) []
 432     allFPRegs = [st0,st1,st2,st3,st4,st5,st6,st7]
 433
 434     --callClobberedRegs = [ eax, ecx, edx ] -- according to gcc, anyway.
 435     callClobberedRegs = [eax]
 436
 437 -- General purpose register collecting functions.
 438
 439     opToReg (OpReg reg)   = [reg]
 440     opToReg (OpImm imm)   = []
 441     opToReg (OpAddr  ea)  = addrToRegs ea
 442
 443     addrToRegs (AddrBaseIndex base index _) = baseToReg base ++ indexToReg index
 444       where  baseToReg Nothing       = []
 445              baseToReg (Just r)      = [r]
 446              indexToReg Nothing      = []
 447              indexToReg (Just (r,_)) = [r]
 448     addrToRegs (ImmAddr _ _) = []
 449
 450     usage src dst = RU (mkRegSet (filter interesting src))
 451                        (mkRegSet (filter interesting dst))
 452
 453     interesting (FixedReg _) = False
 454     interesting _ = True
 455
 456 #endif {- i386_TARGET_ARCH -}
 457 -- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
 458 #if sparc_TARGET_ARCH
 459
 460 regUsage instr = case instr of
 461     LD sz addr reg      -> usage (regAddr addr, [reg])
 462     ST sz reg addr      -> usage (reg : regAddr addr, [])
 463     ADD x cc r1 ar r2   -> usage (r1 : regRI ar, [r2])
 464     SUB x cc r1 ar r2   -> usage (r1 : regRI ar, [r2])
 465     AND b r1 ar r2      -> usage (r1 : regRI ar, [r2])
 466     ANDN b r1 ar r2     -> usage (r1 : regRI ar, [r2])
 467     OR b r1 ar r2       -> usage (r1 : regRI ar, [r2])
 468     ORN b r1 ar r2      -> usage (r1 : regRI ar, [r2])
 469     XOR b r1 ar r2      -> usage (r1 : regRI ar, [r2])
 470     XNOR b r1 ar r2     -> usage (r1 : regRI ar, [r2])
 471     SLL r1 ar r2        -> usage (r1 : regRI ar, [r2])
 472     SRL r1 ar r2        -> usage (r1 : regRI ar, [r2])
 473     SRA r1 ar r2        -> usage (r1 : regRI ar, [r2])
 474     SETHI imm reg       -> usage ([], [reg])
 475     FABS s r1 r2        -> usage ([r1], [r2])
 476     FADD s r1 r2 r3     -> usage ([r1, r2], [r3])
 477     FCMP e s r1 r2      -> usage ([r1, r2], [])
 478     FDIV s r1 r2 r3     -> usage ([r1, r2], [r3])
 479     FMOV s r1 r2        -> usage ([r1], [r2])
 480     FMUL s r1 r2 r3     -> usage ([r1, r2], [r3])
 481     FNEG s r1 r2        -> usage ([r1], [r2])
 482     FSQRT s r1 r2       -> usage ([r1], [r2])
 483     FSUB s r1 r2 r3     -> usage ([r1, r2], [r3])
 484     FxTOy s1 s2 r1 r2   -> usage ([r1], [r2])
 485
 486     -- We assume that all local jumps will be BI/BF.  JMP must be out-of-line.
 487     JMP addr            -> RU (mkRegSet (filter interesting (regAddr addr))) freeRegSet
 488
 489     CALL _ n True       -> endUsage
 490     CALL _ n False      -> RU (argRegSet n) callClobberedRegSet
 491
 492     _                   -> noUsage
 493   where
 494     usage (src, dst) = RU (mkRegSet (filter interesting src))
 495                           (mkRegSet (filter interesting dst))
 496
 497     interesting (FixedReg _) = False
 498     interesting _ = True
 499
 500     regAddr (AddrRegReg r1 r2) = [r1, r2]
 501     regAddr (AddrRegImm r1 _)  = [r1]
 502
 503     regRI (RIReg r) = [r]
 504     regRI  _    = []
 505
 506 #endif {- sparc_TARGET_ARCH -}
 507 \end{code}
 508
 509 %************************************************************************
 510 %*                                                                      *
 511 \subsection{@RegLiveness@ type; @regLiveness@ function}
 512 %*                                                                      *
 513 %************************************************************************
 514
 515 @regLiveness@ takes future liveness information and modifies it
 516 according to the semantics of branches and labels.  (An out-of-line
 517 branch clobbers the liveness passed back by the following instruction;
 518 a forward local branch passes back the liveness from the target label;
 519 a conditional branch merges the liveness from the target and the
 520 liveness from its successor; a label stashes away the current liveness
 521 in the future liveness environment).
 522
 523 \begin{code}
 524 data RegLiveness = RL RegSet FutureLive
 525
 526 regLiveness :: Instr -> RegLiveness -> RegLiveness
 527
 528 regLiveness instr info@(RL live future@(FL all env))
 529   = let
 530         lookup lbl
 531           = case (lookupFM env lbl) of
 532             Just rs -> rs
 533             Nothing -> pprTrace "Missing" (pprCLabel_asm lbl <+> text "in future?")
 534                        emptyRegSet
 535     in
 536     case instr of -- the rest is machine-specific...
 537
 538 #if alpha_TARGET_ARCH
 539
 540     -- We assume that all local jumps will be BI/BF.  JMP must be out-of-line.
 541
 542     BR (ImmCLbl lbl)     -> RL (lookup lbl) future
 543     BI _ _ (ImmCLbl lbl) -> RL (lookup lbl `unionRegSets` live) future
 544     BF _ _ (ImmCLbl lbl) -> RL (lookup lbl `unionRegSets` live) future
 545     JMP _ _ _            -> RL emptyRegSet future
 546     BSR _ _              -> RL live future
 547     JSR _ _ _            -> RL live future
 548     LABEL lbl            -> RL live (FL (all `unionRegSets` live) (addToFM env lbl live))
 549     _                    -> info
 550
 551 #endif {- alpha_TARGET_ARCH -}
 552 -- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
 553 #if i386_TARGET_ARCH
 554
 555     JXX _ lbl   -> RL (lookup lbl `unionRegSets` live) future
 556     JMP _       -> RL emptyRegSet future
 557     CALL _      -> RL live future
 558     LABEL lbl   -> RL live (FL (all `unionRegSets` live) (addToFM env lbl live))
 559     _               -> info
 560
 561 #endif {- i386_TARGET_ARCH -}
 562 -- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
 563 #if sparc_TARGET_ARCH
 564
 565     -- We assume that all local jumps will be BI/BF.  JMP must be out-of-line.
 566
 567     BI ALWAYS _ (ImmCLbl lbl)   -> RL (lookup lbl) future
 568     BI _ _ (ImmCLbl lbl)        -> RL (lookup lbl `unionRegSets` live) future
 569     BF ALWAYS _ (ImmCLbl lbl)   -> RL (lookup lbl) future
 570     BF _ _ (ImmCLbl lbl)        -> RL (lookup lbl `unionRegSets` live) future
 571     JMP _                       -> RL emptyRegSet future
 572     CALL _ i True   -> RL emptyRegSet future
 573     CALL _ i False  -> RL live future
 574     LABEL lbl       -> RL live (FL (all `unionRegSets` live) (addToFM env lbl live))
 575     _               -> info
 576
 577 #endif {- sparc_TARGET_ARCH -}
 578 \end{code}
 579
 580 %************************************************************************
 581 %*                                                                      *
 582 \subsection{@patchRegs@ function}
 583 %*                                                                      *
 584 %************************************************************************
 585
 586 @patchRegs@ takes an instruction (possibly with
 587 MemoryReg/UnmappedReg registers) and changes all register references
 588 according to the supplied environment.
 589
 590 \begin{code}
 591 patchRegs :: Instr -> (Reg -> Reg) -> Instr
 592
 593 #if alpha_TARGET_ARCH
 594
 595 patchRegs instr env = case instr of
 596     LD sz reg addr -> LD sz (env reg) (fixAddr addr)
 597     LDA reg addr -> LDA (env reg) (fixAddr addr)
 598     LDAH reg addr -> LDAH (env reg) (fixAddr addr)
 599     LDGP reg addr -> LDGP (env reg) (fixAddr addr)
 600     LDI sz reg imm -> LDI sz (env reg) imm
 601     ST sz reg addr -> ST sz (env reg) (fixAddr addr)
 602     CLR reg -> CLR (env reg)
 603     ABS sz ar reg -> ABS sz (fixRI ar) (env reg)
 604     NEG sz ov ar reg -> NEG sz ov (fixRI ar) (env reg)
 605     ADD sz ov r1 ar r2 -> ADD sz ov (env r1) (fixRI ar) (env r2)
 606     SADD sz sc r1 ar r2 -> SADD sz sc (env r1) (fixRI ar) (env r2)
 607     SUB sz ov r1 ar r2 -> SUB sz ov (env r1) (fixRI ar) (env r2)
 608     SSUB sz sc r1 ar r2 -> SSUB sz sc (env r1) (fixRI ar) (env r2)
 609     MUL sz ov r1 ar r2 -> MUL sz ov (env r1) (fixRI ar) (env r2)
 610     DIV sz un r1 ar r2 -> DIV sz un (env r1) (fixRI ar) (env r2)
 611     REM sz un r1 ar r2 -> REM sz un (env r1) (fixRI ar) (env r2)
 612     NOT ar reg -> NOT (fixRI ar) (env reg)
 613     AND r1 ar r2 -> AND (env r1) (fixRI ar) (env r2)
 614     ANDNOT r1 ar r2 -> ANDNOT (env r1) (fixRI ar) (env r2)
 615     OR r1 ar r2 -> OR (env r1) (fixRI ar) (env r2)
 616     ORNOT r1 ar r2 -> ORNOT (env r1) (fixRI ar) (env r2)
 617     XOR r1 ar r2 -> XOR (env r1) (fixRI ar) (env r2)
 618     XORNOT r1 ar r2 -> XORNOT (env r1) (fixRI ar) (env r2)
 619     SLL r1 ar r2 -> SLL (env r1) (fixRI ar) (env r2)
 620     SRL r1 ar r2 -> SRL (env r1) (fixRI ar) (env r2)
 621     SRA r1 ar r2 -> SRA (env r1) (fixRI ar) (env r2)
 622     ZAP r1 ar r2 -> ZAP (env r1) (fixRI ar) (env r2)
 623     ZAPNOT r1 ar r2 -> ZAPNOT (env r1) (fixRI ar) (env r2)
 624     CMP co r1 ar r2 -> CMP co (env r1) (fixRI ar) (env r2)
 625     FCLR reg -> FCLR (env reg)
 626     FABS r1 r2 -> FABS (env r1) (env r2)
 627     FNEG s r1 r2 -> FNEG s (env r1) (env r2)
 628     FADD s r1 r2 r3 -> FADD s (env r1) (env r2) (env r3)
 629     FDIV s r1 r2 r3 -> FDIV s (env r1) (env r2) (env r3)
 630     FMUL s r1 r2 r3 -> FMUL s (env r1) (env r2) (env r3)
 631     FSUB s r1 r2 r3 -> FSUB s (env r1) (env r2) (env r3)
 632     CVTxy s1 s2 r1 r2 -> CVTxy s1 s2 (env r1) (env r2)
 633     FCMP s co r1 r2 r3 -> FCMP s co (env r1) (env r2) (env r3)
 634     FMOV r1 r2 -> FMOV (env r1) (env r2)
 635     BI cond reg lbl -> BI cond (env reg) lbl
 636     BF cond reg lbl -> BF cond (env reg) lbl
 637     JMP reg addr hint -> JMP (env reg) (fixAddr addr) hint
 638     JSR reg addr i -> JSR (env reg) (fixAddr addr) i
 639     _ -> instr
 640   where
 641     fixAddr (AddrReg r1)       = AddrReg (env r1)
 642     fixAddr (AddrRegImm r1 i)  = AddrRegImm (env r1) i
 643     fixAddr other              = other
 644
 645     fixRI (RIReg r) = RIReg (env r)
 646     fixRI other = other
 647
 648 #endif {- alpha_TARGET_ARCH -}
 649 -- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
 650 #if i386_TARGET_ARCH
 651
 652 patchRegs instr env = case instr of
 653     MOV  sz src dst     -> patch2 (MOV  sz) src dst
 654     MOVZX sz src dst    -> patch2 (MOVZX sz) src dst
 655     MOVSX sz src dst    -> patch2 (MOVSX sz) src dst
 656     LEA  sz src dst     -> patch2 (LEA  sz) src dst
 657     ADD  sz src dst     -> patch2 (ADD  sz) src dst
 658     SUB  sz src dst     -> patch2 (SUB  sz) src dst
 659     IMUL sz src dst     -> patch2 (IMUL sz) src dst
 660     IDIV sz src         -> patch1 (IDIV sz) src
 661     AND  sz src dst     -> patch2 (AND  sz) src dst
 662     OR   sz src dst     -> patch2 (OR   sz) src dst
 663     XOR  sz src dst     -> patch2 (XOR  sz) src dst
 664     NOT  sz op          -> patch1 (NOT  sz) op
 665     NEGI sz op          -> patch1 (NEGI sz) op
 666     SHL  sz imm dst     -> patch2 (SHL  sz) imm dst
 667     SAR  sz imm dst     -> patch2 (SAR  sz) imm dst
 668     SHR  sz imm dst     -> patch2 (SHR  sz) imm dst
 669     TEST sz src dst     -> patch2 (TEST sz) src dst
 670     CMP  sz src dst     -> patch2 (CMP  sz) src dst
 671     PUSH sz op          -> patch1 (PUSH sz) op
 672     POP  sz op          -> patch1 (POP  sz) op
 673     SETCC cond op       -> patch1 (SETCC cond) op
 674     JMP op              -> patch1 JMP op
 675     FADD sz src         -> FADD sz (patchOp src)
 676     FIADD sz asrc       -> FIADD sz (lookupAddr asrc)
 677     FCOM sz src         -> patch1 (FCOM sz) src
 678     FDIV sz src         -> FDIV sz (patchOp src)
 679     --FDIVP sz src      -> FDIVP sz (patchOp src)
 680     FIDIV sz asrc       -> FIDIV sz (lookupAddr asrc)
 681     FDIVR sz src        -> FDIVR sz (patchOp src)
 682     --FDIVRP sz src     -> FDIVRP sz (patchOp src)
 683     FIDIVR sz asrc      -> FIDIVR sz (lookupAddr asrc)
 684     FICOM sz asrc       -> FICOM sz (lookupAddr asrc)
 685     FILD sz asrc dst    -> FILD sz (lookupAddr asrc) (env dst)
 686     FIST sz adst        -> FIST sz (lookupAddr adst)
 687     FLD sz src          -> patch1 (FLD sz) (patchOp src)
 688     FMUL sz src         -> FMUL sz (patchOp src)
 689     --FMULP sz src      -> FMULP sz (patchOp src)
 690     FIMUL sz asrc       -> FIMUL sz (lookupAddr asrc)
 691     FST sz dst          -> FST sz (patchOp dst)
 692     FSTP sz dst         -> FSTP sz (patchOp dst)
 693     FSUB sz src         -> FSUB sz (patchOp src)
 694     --FSUBP sz src      -> FSUBP sz (patchOp src)
 695     FISUB sz asrc       -> FISUB sz (lookupAddr asrc)
 696     FSUBR sz src        -> FSUBR sz (patchOp src)
 697     --FSUBRP sz src     -> FSUBRP sz (patchOp src)
 698     FISUBR sz asrc      -> FISUBR sz (lookupAddr asrc)
 699     FCOMP sz src        -> FCOMP sz (patchOp src)
 700     _                   -> instr
 701   where
 702     patch1 insn op      = insn (patchOp op)
 703     patch2 insn src dst = insn (patchOp src) (patchOp dst)
 704
 705     patchOp (OpReg  reg) = OpReg (env reg)
 706     patchOp (OpImm  imm) = OpImm imm
 707     patchOp (OpAddr ea)  = OpAddr (lookupAddr ea)
 708
 709     lookupAddr (ImmAddr imm off) = ImmAddr imm off
 710     lookupAddr (AddrBaseIndex base index disp)
 711       = AddrBaseIndex (lookupBase base) (lookupIndex index) disp
 712       where
 713         lookupBase Nothing       = Nothing
 714         lookupBase (Just r)      = Just (env r)
 715
 716         lookupIndex Nothing      = Nothing
 717         lookupIndex (Just (r,i)) = Just (env r, i)
 718
 719 #endif {- i386_TARGET_ARCH -}
 720 -- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
 721 #if sparc_TARGET_ARCH
 722
 723 patchRegs instr env = case instr of
 724     LD sz addr reg -> LD sz (fixAddr addr) (env reg)
 725     ST sz reg addr -> ST sz (env reg) (fixAddr addr)
 726     ADD x cc r1 ar r2 -> ADD x cc (env r1) (fixRI ar) (env r2)
 727     SUB x cc r1 ar r2 -> SUB x cc (env r1) (fixRI ar) (env r2)
 728     AND b r1 ar r2 -> AND b (env r1) (fixRI ar) (env r2)
 729     ANDN b r1 ar r2 -> ANDN b (env r1) (fixRI ar) (env r2)
 730     OR b r1 ar r2 -> OR b (env r1) (fixRI ar) (env r2)
 731     ORN b r1 ar r2 -> ORN b (env r1) (fixRI ar) (env r2)
 732     XOR b r1 ar r2 -> XOR b (env r1) (fixRI ar) (env r2)
 733     XNOR b r1 ar r2 -> XNOR b (env r1) (fixRI ar) (env r2)
 734     SLL r1 ar r2 -> SLL (env r1) (fixRI ar) (env r2)
 735     SRL r1 ar r2 -> SRL (env r1) (fixRI ar) (env r2)
 736     SRA r1 ar r2 -> SRA (env r1) (fixRI ar) (env r2)
 737     SETHI imm reg -> SETHI imm (env reg)
 738     FABS s r1 r2 -> FABS s (env r1) (env r2)
 739     FADD s r1 r2 r3 -> FADD s (env r1) (env r2) (env r3)
 740     FCMP e s r1 r2 -> FCMP e s (env r1) (env r2)
 741     FDIV s r1 r2 r3 -> FDIV s (env r1) (env r2) (env r3)
 742     FMOV s r1 r2 -> FMOV s (env r1) (env r2)
 743     FMUL s r1 r2 r3 -> FMUL s (env r1) (env r2) (env r3)
 744     FNEG s r1 r2 -> FNEG s (env r1) (env r2)
 745     FSQRT s r1 r2 -> FSQRT s (env r1) (env r2)
 746     FSUB s r1 r2 r3 -> FSUB s (env r1) (env r2) (env r3)
 747     FxTOy s1 s2 r1 r2 -> FxTOy s1 s2 (env r1) (env r2)
 748     JMP addr -> JMP (fixAddr addr)
 749     _ -> instr
 750   where
 751     fixAddr (AddrRegReg r1 r2) = AddrRegReg (env r1) (env r2)
 752     fixAddr (AddrRegImm r1 i)  = AddrRegImm (env r1) i
 753
 754     fixRI (RIReg r) = RIReg (env r)
 755     fixRI other = other
 756
 757 #endif {- sparc_TARGET_ARCH -}
 758 \end{code}
 759
 760 %************************************************************************
 761 %*                                                                      *
 762 \subsection{@spillReg@ and @loadReg@ functions}
 763 %*                                                                      *
 764 %************************************************************************
 765
 766 Spill to memory, and load it back...
 767
 768 \begin{code}
 769 spillReg, loadReg :: Reg -> Reg -> InstrList
 770
 771 spillReg dyn (MemoryReg i pk)
 772   = let
 773         sz = primRepToSize pk
 774     in
 775     mkUnitList (
 776         {-Alpha: spill below the stack pointer (?)-}
 777          IF_ARCH_alpha( ST sz dyn (spRel i)
 778
 779         {-I386: spill below stack pointer leaving 2 words/spill-}
 780         ,IF_ARCH_i386 ( MOV sz (OpReg dyn) (OpAddr (spRel (-2 * i)))
 781
 782         {-SPARC: spill below frame pointer leaving 2 words/spill-}
 783         ,IF_ARCH_sparc( ST sz dyn (fpRel (-2 * i))
 784         ,)))
 785     )
 786
 787 ----------------------------
 788 loadReg (MemoryReg i pk) dyn
 789   = let
 790         sz = primRepToSize pk
 791     in
 792     mkUnitList (
 793          IF_ARCH_alpha( LD  sz dyn (spRel i)
 794         ,IF_ARCH_i386 ( MOV sz (OpAddr (spRel (-2 * i))) (OpReg dyn)
 795         ,IF_ARCH_sparc( LD  sz (fpRel (-2 * i)) dyn
 796         ,)))
 797     )
 798 \end{code}