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