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