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