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