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