ghc/compiler/nativeGen/RegAllocInfo.lhs

   1 %
   2 % (c) The AQUA Project, Glasgow University, 1996
   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 AbsCSyn          ( MagicId )
  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, OrdList )
  65 import PrimRep          ( PrimRep(..) )
  66 import Stix             ( StixTree, CodeSegment )
  67 import UniqSet          -- quite a bit of it
  68 import Outputable
  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     MOVZX sz src dst    -> usage2 src dst
 360     MOVSX sz src dst    -> usage2 src dst
 361     LEA  sz src dst     -> usage2 src dst
 362     ADD  sz src dst     -> usage2 src dst
 363     SUB  sz src dst     -> usage2 src dst
 364     IMUL sz src dst     -> usage2 src dst
 365     IDIV sz src         -> usage (eax:edx:opToReg src) [eax,edx]
 366     AND  sz src dst     -> usage2 src dst
 367     OR   sz src dst     -> usage2 src dst
 368     XOR  sz src dst     -> usage2 src dst
 369     NOT  sz op          -> usage1 op
 370     NEGI sz op          -> usage1 op
 371     SHL  sz dst len     -> usage2 dst len -- len is either an Imm or ecx.
 372     SAR  sz dst len     -> usage2 dst len -- len is either an Imm or ecx.
 373     SHR  sz len dst     -> usage2 dst len -- len is either an Imm or ecx.
 374     PUSH sz op          -> usage (opToReg op) []
 375     POP  sz op          -> usage [] (opToReg op)
 376     TEST sz src dst     -> usage (opToReg src ++ opToReg dst) []
 377     CMP  sz src dst     -> usage (opToReg src ++ opToReg dst) []
 378     SETCC cond op       -> usage [] (opToReg op)
 379     JXX cond label      -> usage [] []
 380     JMP op              -> usage (opToReg op) freeRegs
 381     CALL imm            -> usage [] callClobberedRegs
 382     CLTD                -> usage [eax] [edx]
 383     NOP                 -> usage [] []
 384     SAHF                -> usage [eax] []
 385     FABS                -> usage [st0] [st0]
 386     FADD sz src         -> usage (st0:opToReg src) [st0] -- allFPRegs
 387     FADDP               -> usage [st0,st1] [st0] -- allFPRegs
 388     FIADD sz asrc       -> usage (addrToRegs asrc) [st0]
 389     FCHS                -> usage [st0] [st0]
 390     FCOM sz src         -> usage (st0:opToReg src) []
 391     FCOS                -> usage [st0] [st0]
 392     FDIV sz src         -> usage (st0:opToReg src) [st0]
 393     FDIVP               -> usage [st0,st1] [st0]
 394     FDIVRP              -> usage [st0,st1] [st0]
 395     FIDIV sz asrc       -> usage (addrToRegs asrc) [st0]
 396     FDIVR sz src        -> usage (st0:opToReg src) [st0]
 397     FIDIVR sz asrc      -> usage (addrToRegs asrc) [st0]
 398     FICOM sz asrc       -> usage (addrToRegs asrc) []
 399     FILD sz asrc dst    -> usage (addrToRegs asrc) [dst] -- allFPRegs
 400     FIST sz adst        -> usage (st0:addrToRegs adst) []
 401     FLD  sz src         -> usage (opToReg src) [st0] -- allFPRegs
 402     FLD1                -> usage [] [st0] -- allFPRegs
 403     FLDZ                -> usage [] [st0] -- allFPRegs
 404     FMUL sz src         -> usage (st0:opToReg src) [st0]
 405     FMULP               -> usage [st0,st1] [st0]
 406     FIMUL sz asrc       -> usage (addrToRegs asrc) [st0]
 407     FRNDINT             -> usage [st0] [st0]
 408     FSIN                -> usage [st0] [st0]
 409     FSQRT               -> usage [st0] [st0]
 410     FST sz (OpReg r)    -> usage [st0] [r]
 411     FST sz dst          -> usage (st0:opToReg dst) []
 412     FSTP sz (OpReg r)   -> usage [st0] [r] -- allFPRegs
 413     FSTP sz dst         -> usage (st0:opToReg dst) [] -- allFPRegs
 414     FSUB sz src         -> usage (st0:opToReg src) [st0] -- allFPRegs
 415     FSUBR sz src        -> usage (st0:opToReg src) [st0] -- allFPRegs
 416     FISUB sz asrc       -> usage (addrToRegs asrc) [st0]
 417     FSUBP               -> usage [st0,st1] [st0] -- allFPRegs
 418     FSUBRP              -> usage [st0,st1] [st0] -- allFPRegs
 419     FISUBR sz asrc      -> usage (addrToRegs asrc) [st0]
 420     FTST                -> usage [st0] []
 421     FCOMP sz op         -> usage (st0:opToReg op) [st0] -- allFPRegs
 422     FUCOMPP             -> usage [st0, st1] [] --  allFPRegs
 423     FXCH                -> usage [st0, st1] [st0, st1]
 424     FNSTSW              -> usage [] [eax]
 425     _                   -> noUsage
 426  where
 427     usage2 :: Operand -> Operand -> RegUsage
 428     usage2 op (OpReg reg) = usage (opToReg op) [reg]
 429     usage2 op (OpAddr ea) = usage (opToReg op ++ addrToRegs ea) []
 430     usage2 op (OpImm imm) = usage (opToReg op) []
 431     usage1 :: Operand -> RegUsage
 432     usage1 (OpReg reg)    = usage [reg] [reg]
 433     usage1 (OpAddr ea)    = usage (addrToRegs ea) []
 434     allFPRegs = [st0,st1,st2,st3,st4,st5,st6,st7]
 435
 436     --callClobberedRegs = [ eax, ecx, edx ] -- according to gcc, anyway.
 437     callClobberedRegs = [eax]
 438
 439 -- General purpose register collecting functions.
 440
 441     opToReg (OpReg reg)   = [reg]
 442     opToReg (OpImm imm)   = []
 443     opToReg (OpAddr  ea)  = addrToRegs ea
 444
 445     addrToRegs (AddrBaseIndex base index _) = baseToReg base ++ indexToReg index
 446       where  baseToReg Nothing       = []
 447              baseToReg (Just r)      = [r]
 448              indexToReg Nothing      = []
 449              indexToReg (Just (r,_)) = [r]
 450     addrToRegs (ImmAddr _ _) = []
 451
 452     usage src dst = RU (mkRegSet (filter interesting src))
 453                        (mkRegSet (filter interesting dst))
 454
 455     interesting (FixedReg _) = False
 456     interesting _ = True
 457
 458 #endif {- i386_TARGET_ARCH -}
 459 -- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
 460 #if sparc_TARGET_ARCH
 461
 462 regUsage instr = case instr of
 463     LD sz addr reg      -> usage (regAddr addr, [reg])
 464     ST sz reg addr      -> usage (reg : regAddr addr, [])
 465     ADD x cc r1 ar r2   -> usage (r1 : regRI ar, [r2])
 466     SUB x cc r1 ar r2   -> usage (r1 : regRI ar, [r2])
 467     AND b r1 ar r2      -> usage (r1 : regRI ar, [r2])
 468     ANDN b r1 ar r2     -> usage (r1 : regRI ar, [r2])
 469     OR b r1 ar r2       -> usage (r1 : regRI ar, [r2])
 470     ORN b r1 ar r2      -> usage (r1 : regRI ar, [r2])
 471     XOR b r1 ar r2      -> usage (r1 : regRI ar, [r2])
 472     XNOR b r1 ar r2     -> usage (r1 : regRI ar, [r2])
 473     SLL r1 ar r2        -> usage (r1 : regRI ar, [r2])
 474     SRL r1 ar r2        -> usage (r1 : regRI ar, [r2])
 475     SRA r1 ar r2        -> usage (r1 : regRI ar, [r2])
 476     SETHI imm reg       -> usage ([], [reg])
 477     FABS s r1 r2        -> usage ([r1], [r2])
 478     FADD s r1 r2 r3     -> usage ([r1, r2], [r3])
 479     FCMP e s r1 r2      -> usage ([r1, r2], [])
 480     FDIV s r1 r2 r3     -> usage ([r1, r2], [r3])
 481     FMOV s r1 r2        -> usage ([r1], [r2])
 482     FMUL s r1 r2 r3     -> usage ([r1, r2], [r3])
 483     FNEG s r1 r2        -> usage ([r1], [r2])
 484     FSQRT s r1 r2       -> usage ([r1], [r2])
 485     FSUB s r1 r2 r3     -> usage ([r1, r2], [r3])
 486     FxTOy s1 s2 r1 r2   -> usage ([r1], [r2])
 487
 488     -- We assume that all local jumps will be BI/BF.  JMP must be out-of-line.
 489     JMP addr            -> RU (mkRegSet (filter interesting (regAddr addr))) freeRegSet
 490
 491     CALL _ n True       -> endUsage
 492     CALL _ n False      -> RU (argRegSet n) callClobberedRegSet
 493
 494     _                   -> noUsage
 495   where
 496     usage (src, dst) = RU (mkRegSet (filter interesting src))
 497                           (mkRegSet (filter interesting dst))
 498
 499     interesting (FixedReg _) = False
 500     interesting _ = True
 501
 502     regAddr (AddrRegReg r1 r2) = [r1, r2]
 503     regAddr (AddrRegImm r1 _)  = [r1]
 504
 505     regRI (RIReg r) = [r]
 506     regRI  _    = []
 507
 508 #endif {- sparc_TARGET_ARCH -}
 509 \end{code}
 510
 511 %************************************************************************
 512 %*                                                                      *
 513 \subsection{@RegLiveness@ type; @regLiveness@ function}
 514 %*                                                                      *
 515 %************************************************************************
 516
 517 @regLiveness@ takes future liveness information and modifies it
 518 according to the semantics of branches and labels.  (An out-of-line
 519 branch clobbers the liveness passed back by the following instruction;
 520 a forward local branch passes back the liveness from the target label;
 521 a conditional branch merges the liveness from the target and the
 522 liveness from its successor; a label stashes away the current liveness
 523 in the future liveness environment).
 524
 525 \begin{code}
 526 data RegLiveness = RL RegSet FutureLive
 527
 528 regLiveness :: Instr -> RegLiveness -> RegLiveness
 529
 530 regLiveness instr info@(RL live future@(FL all env))
 531   = let
 532         lookup lbl
 533           = case (lookupFM env lbl) of
 534             Just rs -> rs
 535             Nothing -> pprTrace "Missing" (pprCLabel_asm lbl <+> text "in future?")
 536                        emptyRegSet
 537     in
 538     case instr of -- the rest is machine-specific...
 539
 540 #if alpha_TARGET_ARCH
 541
 542     -- We assume that all local jumps will be BI/BF.  JMP must be out-of-line.
 543
 544     BR (ImmCLbl lbl)     -> RL (lookup lbl) future
 545     BI _ _ (ImmCLbl lbl) -> RL (lookup lbl `unionRegSets` live) future
 546     BF _ _ (ImmCLbl lbl) -> RL (lookup lbl `unionRegSets` live) future
 547     JMP _ _ _            -> RL emptyRegSet future
 548     BSR _ _              -> RL live future
 549     JSR _ _ _            -> RL live future
 550     LABEL lbl            -> RL live (FL (all `unionRegSets` live) (addToFM env lbl live))
 551     _                    -> info
 552
 553 #endif {- alpha_TARGET_ARCH -}
 554 -- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
 555 #if i386_TARGET_ARCH
 556
 557     JXX _ lbl   -> RL (lookup lbl `unionRegSets` live) future
 558     JMP _       -> RL emptyRegSet future
 559     CALL _      -> RL live future
 560     LABEL lbl   -> RL live (FL (all `unionRegSets` live) (addToFM env lbl live))
 561     _               -> info
 562
 563 #endif {- i386_TARGET_ARCH -}
 564 -- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
 565 #if sparc_TARGET_ARCH
 566
 567     -- We assume that all local jumps will be BI/BF.  JMP must be out-of-line.
 568
 569     BI ALWAYS _ (ImmCLbl lbl)   -> RL (lookup lbl) future
 570     BI _ _ (ImmCLbl lbl)        -> RL (lookup lbl `unionRegSets` live) future
 571     BF ALWAYS _ (ImmCLbl lbl)   -> RL (lookup lbl) future
 572     BF _ _ (ImmCLbl lbl)        -> RL (lookup lbl `unionRegSets` live) future
 573     JMP _                       -> RL emptyRegSet future
 574     CALL _ i True   -> RL emptyRegSet future
 575     CALL _ i False  -> RL live future
 576     LABEL lbl       -> RL live (FL (all `unionRegSets` live) (addToFM env lbl live))
 577     _               -> info
 578
 579 #endif {- sparc_TARGET_ARCH -}
 580 \end{code}
 581
 582 %************************************************************************
 583 %*                                                                      *
 584 \subsection{@patchRegs@ function}
 585 %*                                                                      *
 586 %************************************************************************
 587
 588 @patchRegs@ takes an instruction (possibly with
 589 MemoryReg/UnmappedReg registers) and changes all register references
 590 according to the supplied environment.
 591
 592 \begin{code}
 593 patchRegs :: Instr -> (Reg -> Reg) -> Instr
 594
 595 #if alpha_TARGET_ARCH
 596
 597 patchRegs instr env = case instr of
 598     LD sz reg addr -> LD sz (env reg) (fixAddr addr)
 599     LDA reg addr -> LDA (env reg) (fixAddr addr)
 600     LDAH reg addr -> LDAH (env reg) (fixAddr addr)
 601     LDGP reg addr -> LDGP (env reg) (fixAddr addr)
 602     LDI sz reg imm -> LDI sz (env reg) imm
 603     ST sz reg addr -> ST sz (env reg) (fixAddr addr)
 604     CLR reg -> CLR (env reg)
 605     ABS sz ar reg -> ABS sz (fixRI ar) (env reg)
 606     NEG sz ov ar reg -> NEG sz ov (fixRI ar) (env reg)
 607     ADD sz ov r1 ar r2 -> ADD sz ov (env r1) (fixRI ar) (env r2)
 608     SADD sz sc r1 ar r2 -> SADD sz sc (env r1) (fixRI ar) (env r2)
 609     SUB sz ov r1 ar r2 -> SUB sz ov (env r1) (fixRI ar) (env r2)
 610     SSUB sz sc r1 ar r2 -> SSUB sz sc (env r1) (fixRI ar) (env r2)
 611     MUL sz ov r1 ar r2 -> MUL sz ov (env r1) (fixRI ar) (env r2)
 612     DIV sz un r1 ar r2 -> DIV sz un (env r1) (fixRI ar) (env r2)
 613     REM sz un r1 ar r2 -> REM sz un (env r1) (fixRI ar) (env r2)
 614     NOT ar reg -> NOT (fixRI ar) (env reg)
 615     AND r1 ar r2 -> AND (env r1) (fixRI ar) (env r2)
 616     ANDNOT r1 ar r2 -> ANDNOT (env r1) (fixRI ar) (env r2)
 617     OR r1 ar r2 -> OR (env r1) (fixRI ar) (env r2)
 618     ORNOT r1 ar r2 -> ORNOT (env r1) (fixRI ar) (env r2)
 619     XOR r1 ar r2 -> XOR (env r1) (fixRI ar) (env r2)
 620     XORNOT r1 ar r2 -> XORNOT (env r1) (fixRI ar) (env r2)
 621     SLL r1 ar r2 -> SLL (env r1) (fixRI ar) (env r2)
 622     SRL r1 ar r2 -> SRL (env r1) (fixRI ar) (env r2)
 623     SRA r1 ar r2 -> SRA (env r1) (fixRI ar) (env r2)
 624     ZAP r1 ar r2 -> ZAP (env r1) (fixRI ar) (env r2)
 625     ZAPNOT r1 ar r2 -> ZAPNOT (env r1) (fixRI ar) (env r2)
 626     CMP co r1 ar r2 -> CMP co (env r1) (fixRI ar) (env r2)
 627     FCLR reg -> FCLR (env reg)
 628     FABS r1 r2 -> FABS (env r1) (env r2)
 629     FNEG s r1 r2 -> FNEG s (env r1) (env r2)
 630     FADD s r1 r2 r3 -> FADD s (env r1) (env r2) (env r3)
 631     FDIV s r1 r2 r3 -> FDIV s (env r1) (env r2) (env r3)
 632     FMUL s r1 r2 r3 -> FMUL s (env r1) (env r2) (env r3)
 633     FSUB s r1 r2 r3 -> FSUB s (env r1) (env r2) (env r3)
 634     CVTxy s1 s2 r1 r2 -> CVTxy s1 s2 (env r1) (env r2)
 635     FCMP s co r1 r2 r3 -> FCMP s co (env r1) (env r2) (env r3)
 636     FMOV r1 r2 -> FMOV (env r1) (env r2)
 637     BI cond reg lbl -> BI cond (env reg) lbl
 638     BF cond reg lbl -> BF cond (env reg) lbl
 639     JMP reg addr hint -> JMP (env reg) (fixAddr addr) hint
 640     JSR reg addr i -> JSR (env reg) (fixAddr addr) i
 641     _ -> instr
 642   where
 643     fixAddr (AddrReg r1)       = AddrReg (env r1)
 644     fixAddr (AddrRegImm r1 i)  = AddrRegImm (env r1) i
 645     fixAddr other              = other
 646
 647     fixRI (RIReg r) = RIReg (env r)
 648     fixRI other = other
 649
 650 #endif {- alpha_TARGET_ARCH -}
 651 -- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
 652 #if i386_TARGET_ARCH
 653
 654 patchRegs instr env = case instr of
 655     MOV  sz src dst     -> patch2 (MOV  sz) src dst
 656     MOVZX sz src dst    -> patch2 (MOVZX sz) src dst
 657     MOVSX sz src dst    -> patch2 (MOVSX sz) src dst
 658     LEA  sz src dst     -> patch2 (LEA  sz) src dst
 659     ADD  sz src dst     -> patch2 (ADD  sz) src dst
 660     SUB  sz src dst     -> patch2 (SUB  sz) src dst
 661     IMUL sz src dst     -> patch2 (IMUL sz) src dst
 662     IDIV sz src         -> patch1 (IDIV sz) src
 663     AND  sz src dst     -> patch2 (AND  sz) src dst
 664     OR   sz src dst     -> patch2 (OR   sz) src dst
 665     XOR  sz src dst     -> patch2 (XOR  sz) src dst
 666     NOT  sz op          -> patch1 (NOT  sz) op
 667     NEGI sz op          -> patch1 (NEGI sz) op
 668     SHL  sz imm dst     -> patch2 (SHL  sz) imm dst
 669     SAR  sz imm dst     -> patch2 (SAR  sz) imm dst
 670     SHR  sz imm dst     -> patch2 (SHR  sz) imm dst
 671     TEST sz src dst     -> patch2 (TEST sz) src dst
 672     CMP  sz src dst     -> patch2 (CMP  sz) src dst
 673     PUSH sz op          -> patch1 (PUSH sz) op
 674     POP  sz op          -> patch1 (POP  sz) op
 675     SETCC cond op       -> patch1 (SETCC cond) op
 676     JMP op              -> patch1 JMP op
 677     FADD sz src         -> FADD sz (patchOp src)
 678     FIADD sz asrc       -> FIADD sz (lookupAddr asrc)
 679     FCOM sz src         -> patch1 (FCOM sz) src
 680     FDIV sz src         -> FDIV sz (patchOp src)
 681     --FDIVP sz src      -> FDIVP sz (patchOp src)
 682     FIDIV sz asrc       -> FIDIV sz (lookupAddr asrc)
 683     FDIVR sz src        -> FDIVR sz (patchOp src)
 684     --FDIVRP sz src     -> FDIVRP sz (patchOp src)
 685     FIDIVR sz asrc      -> FIDIVR sz (lookupAddr asrc)
 686     FICOM sz asrc       -> FICOM sz (lookupAddr asrc)
 687     FILD sz asrc dst    -> FILD sz (lookupAddr asrc) (env dst)
 688     FIST sz adst        -> FIST sz (lookupAddr adst)
 689     FLD sz src          -> patch1 (FLD sz) (patchOp src)
 690     FMUL sz src         -> FMUL sz (patchOp src)
 691     --FMULP sz src      -> FMULP sz (patchOp src)
 692     FIMUL sz asrc       -> FIMUL sz (lookupAddr asrc)
 693     FST sz dst          -> FST sz (patchOp dst)
 694     FSTP sz dst         -> FSTP sz (patchOp dst)
 695     FSUB sz src         -> FSUB sz (patchOp src)
 696     --FSUBP sz src      -> FSUBP sz (patchOp src)
 697     FISUB sz asrc       -> FISUB sz (lookupAddr asrc)
 698     FSUBR sz src        -> FSUBR sz (patchOp src)
 699     --FSUBRP sz src     -> FSUBRP sz (patchOp src)
 700     FISUBR sz asrc      -> FISUBR sz (lookupAddr asrc)
 701     FCOMP sz src        -> FCOMP sz (patchOp src)
 702     _                   -> instr
 703   where
 704     patch1 insn op      = insn (patchOp op)
 705     patch2 insn src dst = insn (patchOp src) (patchOp dst)
 706
 707     patchOp (OpReg  reg) = OpReg (env reg)
 708     patchOp (OpImm  imm) = OpImm imm
 709     patchOp (OpAddr ea)  = OpAddr (lookupAddr ea)
 710
 711     lookupAddr (ImmAddr imm off) = ImmAddr imm off
 712     lookupAddr (AddrBaseIndex base index disp)
 713       = AddrBaseIndex (lookupBase base) (lookupIndex index) disp
 714       where
 715         lookupBase Nothing       = Nothing
 716         lookupBase (Just r)      = Just (env r)
 717
 718         lookupIndex Nothing      = Nothing
 719         lookupIndex (Just (r,i)) = Just (env r, i)
 720
 721 #endif {- i386_TARGET_ARCH -}
 722 -- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
 723 #if sparc_TARGET_ARCH
 724
 725 patchRegs instr env = case instr of
 726     LD sz addr reg -> LD sz (fixAddr addr) (env reg)
 727     ST sz reg addr -> ST sz (env reg) (fixAddr addr)
 728     ADD x cc r1 ar r2 -> ADD x cc (env r1) (fixRI ar) (env r2)
 729     SUB x cc r1 ar r2 -> SUB x cc (env r1) (fixRI ar) (env r2)
 730     AND b r1 ar r2 -> AND b (env r1) (fixRI ar) (env r2)
 731     ANDN b r1 ar r2 -> ANDN b (env r1) (fixRI ar) (env r2)
 732     OR b r1 ar r2 -> OR b (env r1) (fixRI ar) (env r2)
 733     ORN b r1 ar r2 -> ORN b (env r1) (fixRI ar) (env r2)
 734     XOR b r1 ar r2 -> XOR b (env r1) (fixRI ar) (env r2)
 735     XNOR b r1 ar r2 -> XNOR b (env r1) (fixRI ar) (env r2)
 736     SLL r1 ar r2 -> SLL (env r1) (fixRI ar) (env r2)
 737     SRL r1 ar r2 -> SRL (env r1) (fixRI ar) (env r2)
 738     SRA r1 ar r2 -> SRA (env r1) (fixRI ar) (env r2)
 739     SETHI imm reg -> SETHI imm (env reg)
 740     FABS s r1 r2 -> FABS s (env r1) (env r2)
 741     FADD s r1 r2 r3 -> FADD s (env r1) (env r2) (env r3)
 742     FCMP e s r1 r2 -> FCMP e s (env r1) (env r2)
 743     FDIV s r1 r2 r3 -> FDIV s (env r1) (env r2) (env r3)
 744     FMOV s r1 r2 -> FMOV s (env r1) (env r2)
 745     FMUL s r1 r2 r3 -> FMUL s (env r1) (env r2) (env r3)
 746     FNEG s r1 r2 -> FNEG s (env r1) (env r2)
 747     FSQRT s r1 r2 -> FSQRT s (env r1) (env r2)
 748     FSUB s r1 r2 r3 -> FSUB s (env r1) (env r2) (env r3)
 749     FxTOy s1 s2 r1 r2 -> FxTOy s1 s2 (env r1) (env r2)
 750     JMP addr -> JMP (fixAddr addr)
 751     _ -> instr
 752   where
 753     fixAddr (AddrRegReg r1 r2) = AddrRegReg (env r1) (env r2)
 754     fixAddr (AddrRegImm r1 i)  = AddrRegImm (env r1) i
 755
 756     fixRI (RIReg r) = RIReg (env r)
 757     fixRI other = other
 758
 759 #endif {- sparc_TARGET_ARCH -}
 760 \end{code}
 761
 762 %************************************************************************
 763 %*                                                                      *
 764 \subsection{@spillReg@ and @loadReg@ functions}
 765 %*                                                                      *
 766 %************************************************************************
 767
 768 Spill to memory, and load it back...
 769
 770 \begin{code}
 771 spillReg, loadReg :: Reg -> Reg -> InstrList
 772
 773 spillReg dyn (MemoryReg i pk)
 774   = let
 775         sz = primRepToSize pk
 776     in
 777     mkUnitList (
 778         {-Alpha: spill below the stack pointer (?)-}
 779          IF_ARCH_alpha( ST sz dyn (spRel i)
 780
 781         {-I386: spill below stack pointer leaving 2 words/spill-}
 782         ,IF_ARCH_i386 ( MOV sz (OpReg dyn) (OpAddr (spRel (-2 * i)))
 783
 784         {-SPARC: spill below frame pointer leaving 2 words/spill-}
 785         ,IF_ARCH_sparc( ST sz dyn (fpRel (-2 * i))
 786         ,)))
 787     )
 788
 789 ----------------------------
 790 loadReg (MemoryReg i pk) dyn
 791   = let
 792         sz = primRepToSize pk
 793     in
 794     mkUnitList (
 795          IF_ARCH_alpha( LD  sz dyn (spRel i)
 796         ,IF_ARCH_i386 ( MOV sz (OpAddr (spRel (-2 * i))) (OpReg dyn)
 797         ,IF_ARCH_sparc( LD  sz (fpRel (-2 * i)) dyn
 798         ,)))
 799     )
 800 \end{code}