ghc/compiler/nativeGen/RegAllocInfo.lhs

   1 %
   2 % (c) The AQUA Project, Glasgow University, 1996-1998
   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 "nativeGen/NCG.h"
  10
  11 module RegAllocInfo (
  12         MRegsState(..),
  13         mkMRegsState,
  14         freeMReg,
  15         freeMRegs,
  16         possibleMRegs,
  17         useMReg,
  18         useMRegs,
  19
  20         RegUsage(..),
  21         noUsage,
  22         endUsage,
  23         regUsage,
  24
  25         FutureLive(..),
  26         RegAssignment,
  27         RegConflicts,
  28         RegFuture(..),
  29         RegHistory(..),
  30         RegInfo(..),
  31         RegLiveness(..),
  32
  33         fstFL,
  34         loadReg,
  35         patchRegs,
  36         regLiveness,
  37         spillReg,
  38         findReservedRegs,
  39
  40         RegSet,
  41         elementOfRegSet,
  42         emptyRegSet,
  43         isEmptyRegSet,
  44         minusRegSet,
  45         mkRegSet,
  46         regSetToList,
  47         unionRegSets,
  48
  49         argRegSet,
  50         callClobberedRegSet,
  51         freeRegSet
  52     ) where
  53
  54 #include "HsVersions.h"
  55
  56 import List             ( partition )
  57 import MachMisc
  58 import MachRegs
  59 import MachCode         ( InstrList )
  60
  61 import BitSet           ( unitBS, mkBS, minusBS, unionBS, listBS, BitSet )
  62 import CLabel           ( pprCLabel_asm, CLabel{-instance Ord-} )
  63 import FiniteMap        ( addToFM, lookupFM, FiniteMap )
  64 import OrdList          ( mkUnitList )
  65 import PrimRep          ( PrimRep(..) )
  66 import UniqSet          -- quite a bit of it
  67 import Outputable
  68 import Constants        ( rESERVED_C_STACK_BYTES )
  69 \end{code}
  70
  71 %************************************************************************
  72 %*                                                                      *
  73 \subsection{Register allocation information}
  74 %*                                                                      *
  75 %************************************************************************
  76
  77 \begin{code}
  78 type RegSet = UniqSet Reg
  79
  80 mkRegSet :: [Reg] -> RegSet
  81 emptyRegSet :: RegSet
  82 unionRegSets, minusRegSet :: RegSet -> RegSet -> RegSet
  83 elementOfRegSet :: Reg -> RegSet -> Bool
  84 isEmptyRegSet :: RegSet -> Bool
  85 regSetToList :: RegSet -> [Reg]
  86
  87 mkRegSet        = mkUniqSet
  88 emptyRegSet     = emptyUniqSet
  89 unionRegSets    = unionUniqSets
  90 minusRegSet     = minusUniqSet
  91 elementOfRegSet = elementOfUniqSet
  92 isEmptyRegSet   = isEmptyUniqSet
  93 regSetToList    = uniqSetToList
  94
  95 freeRegSet, callClobberedRegSet :: RegSet
  96 argRegSet :: Int -> RegSet
  97
  98 freeRegSet          = mkRegSet freeRegs
  99 callClobberedRegSet = mkRegSet callClobberedRegs
 100 argRegSet n         = mkRegSet (argRegs n)
 101
 102 type RegAssignment = FiniteMap Reg Reg
 103 type RegConflicts  = FiniteMap Int RegSet
 104
 105 data FutureLive = FL RegSet (FiniteMap CLabel RegSet)
 106
 107 fstFL (FL a b)  = a
 108
 109 data RegHistory a
 110   = RH  a
 111         Int
 112         RegAssignment
 113
 114 data RegFuture
 115   = RF  RegSet          -- in use
 116         FutureLive      -- future
 117         RegConflicts
 118
 119 data RegInfo a
 120   = RI  RegSet          -- in use
 121         RegSet          -- sources
 122         RegSet          -- destinations
 123         [Reg]           -- last used
 124         RegConflicts
 125 \end{code}
 126
 127 %************************************************************************
 128 %*                                                                      *
 129 \subsection{Register allocation information}
 130 %*                                                                      *
 131 %************************************************************************
 132
 133 COMMENT ON THE EXTRA BitSet FOR SPARC MRegsState: Getting the conflicts
 134 right is a bit tedious for doubles.  We'd have to add a conflict
 135 function to the MachineRegisters class, and we'd have to put a PrimRep
 136 in the MappedReg datatype, or use some kludge (e.g. register 64 + n is
 137 really the same as 32 + n, except that it's used for a double, so it
 138 also conflicts with 33 + n) to deal with it.  It's just not worth the
 139 bother, so we just partition the free floating point registers into
 140 two sets: one for single precision and one for double precision.  We
 141 never seem to run out of floating point registers anyway.
 142
 143 \begin{code}
 144 data MRegsState
 145   = MRs BitSet  -- integer registers
 146         BitSet  -- floating-point registers
 147         IF_ARCH_sparc(BitSet,) -- double registers handled separately
 148 \end{code}
 149
 150 \begin{code}
 151 #if alpha_TARGET_ARCH
 152 # define INT_FLPT_CUTOFF 32
 153 #endif
 154 #if i386_TARGET_ARCH
 155 # define INT_FLPT_CUTOFF 8
 156 #endif
 157 #if sparc_TARGET_ARCH
 158 # define INT_FLPT_CUTOFF 32
 159 # define SNGL_DBL_CUTOFF 48
 160 #endif
 161
 162 mkMRegsState    :: [RegNo] -> MRegsState
 163 possibleMRegs   :: PrimRep -> MRegsState -> [RegNo]
 164 useMReg         :: MRegsState -> FAST_REG_NO -> MRegsState
 165 useMRegs        :: MRegsState -> [RegNo]     -> MRegsState
 166 freeMReg        :: MRegsState -> FAST_REG_NO -> MRegsState
 167 freeMRegs       :: MRegsState -> [RegNo]     -> MRegsState
 168
 169 mkMRegsState xs
 170   = MRs (mkBS is) (mkBS fs2) IF_ARCH_sparc((mkBS ds2),)
 171   where
 172     (is, fs) = partition (< INT_FLPT_CUTOFF) xs
 173 #if sparc_TARGET_ARCH
 174     (ss, ds) = partition (< SNGL_DBL_CUTOFF) fs
 175     fs2  = map (subtract INT_FLPT_CUTOFF) ss
 176     ds2  = map (subtract INT_FLPT_CUTOFF) (filter even ds)
 177 #else
 178     fs2      = map (subtract INT_FLPT_CUTOFF) fs
 179 #endif
 180
 181 ------------------------------------------------
 182 #if sparc_TARGET_ARCH
 183 possibleMRegs FloatRep  (MRs _ ss _) = [ x + INT_FLPT_CUTOFF | x <- listBS ss]
 184 possibleMRegs DoubleRep (MRs _ _ ds) = [ x + INT_FLPT_CUTOFF | x <- listBS ds]
 185 possibleMRegs _         (MRs is _ _) = listBS is
 186 #else
 187 possibleMRegs FloatRep  (MRs _ fs) = [ x + INT_FLPT_CUTOFF | x <- listBS fs]
 188 possibleMRegs DoubleRep (MRs _ fs) = [ x + INT_FLPT_CUTOFF | x <- listBS fs]
 189 possibleMRegs _     (MRs is _) = listBS is
 190 #endif
 191
 192 ------------------------------------------------
 193 #if sparc_TARGET_ARCH
 194 useMReg (MRs is ss ds) n
 195   = if (n _LT_ ILIT(INT_FLPT_CUTOFF)) then
 196         MRs (is `minusBS` unitBS IBOX(n)) ss ds
 197     else if (n _LT_ ILIT(SNGL_DBL_CUTOFF)) then
 198         MRs is (ss `minusBS` unitBS (IBOX(n _SUB_ ILIT(INT_FLPT_CUTOFF)))) ds
 199     else
 200         MRs is ss (ds `minusBS` unitBS (IBOX(n _SUB_ ILIT(INT_FLPT_CUTOFF))))
 201 #else
 202 useMReg (MRs is fs) n
 203   = if (n _LT_ ILIT(INT_FLPT_CUTOFF))
 204     then MRs (is `minusBS` unitBS IBOX(n)) fs
 205     else MRs is (fs `minusBS` unitBS (IBOX(n _SUB_ ILIT(INT_FLPT_CUTOFF))))
 206 #endif
 207
 208 ------------------------------------------------
 209 #if sparc_TARGET_ARCH
 210 useMRegs (MRs is ss ds) xs
 211   = MRs (is `minusBS` is2) (ss `minusBS` ss2) (ds `minusBS` ds2)
 212   where
 213     MRs is2 ss2 ds2 = mkMRegsState xs
 214 #else
 215 useMRegs (MRs is fs) xs
 216   = MRs (is `minusBS` is2) (fs `minusBS` fs2)
 217   where
 218     MRs is2 fs2 = mkMRegsState xs
 219 #endif
 220
 221 ------------------------------------------------
 222 #if sparc_TARGET_ARCH
 223 freeMReg (MRs is ss ds) n
 224   = if (n _LT_ ILIT(INT_FLPT_CUTOFF)) then
 225         MRs (is `unionBS` unitBS IBOX(n)) ss ds
 226     else if (n _LT_ ILIT(SNGL_DBL_CUTOFF)) then
 227         MRs is (ss `unionBS` unitBS (IBOX(n _SUB_ ILIT(INT_FLPT_CUTOFF)))) ds
 228     else
 229         MRs is ss (ds `unionBS` unitBS (IBOX(n _SUB_ ILIT(INT_FLPT_CUTOFF))))
 230 #else
 231 freeMReg (MRs is fs) n
 232   = if (n _LT_ ILIT(INT_FLPT_CUTOFF))
 233     then MRs (is `unionBS` unitBS IBOX(n)) fs
 234     else MRs is (fs `unionBS` unitBS (IBOX(n _SUB_ ILIT(INT_FLPT_CUTOFF))))
 235 #endif
 236
 237 ------------------------------------------------
 238 #if sparc_TARGET_ARCH
 239 freeMRegs (MRs is ss ds) xs
 240   = MRs (is `unionBS` is2) (ss `unionBS` ss2) (ds `unionBS` ds2)
 241   where
 242     MRs is2 ss2 ds2 = mkMRegsState xs
 243 #else
 244 freeMRegs (MRs is fs) xs
 245   = MRs (is `unionBS` is2) (fs `unionBS` fs2)
 246   where
 247     MRs is2 fs2 = mkMRegsState xs
 248 #endif
 249 \end{code}
 250
 251 %************************************************************************
 252 %*                                                                      *
 253 \subsection{@RegUsage@ type; @noUsage@, @endUsage@, @regUsage@ functions}
 254 %*                                                                      *
 255 %************************************************************************
 256
 257 @regUsage@ returns the sets of src and destination registers used by a
 258 particular instruction.  Machine registers that are pre-allocated to
 259 stgRegs are filtered out, because they are uninteresting from a
 260 register allocation standpoint.  (We wouldn't want them to end up on
 261 the free list!)
 262
 263 An important point: The @regUsage@ function for a particular
 264 assembly language must not refer to fixed registers, such as Hp, SpA,
 265 etc.  The source and destination MRegsStates should only refer to
 266 dynamically allocated registers or static registers from the free
 267 list.  As far as we are concerned, the fixed registers simply don't
 268 exist (for allocation purposes, anyway).
 269
 270 \begin{code}
 271 data RegUsage = RU RegSet RegSet
 272
 273 noUsage, endUsage :: RegUsage
 274 noUsage  = RU emptyRegSet emptyRegSet
 275 endUsage = RU emptyRegSet freeRegSet
 276
 277 regUsage :: Instr -> RegUsage
 278
 279 #if alpha_TARGET_ARCH
 280
 281 regUsage instr = case instr of
 282     LD B reg addr       -> usage (regAddr addr, [reg, t9])
 283     LD BU reg addr      -> usage (regAddr addr, [reg, t9])
 284 --  LD W reg addr       -> usage (regAddr addr, [reg, t9]) : UNUSED
 285 --  LD WU reg addr      -> usage (regAddr addr, [reg, t9]) : UNUSED
 286     LD sz reg addr      -> usage (regAddr addr, [reg])
 287     LDA reg addr        -> usage (regAddr addr, [reg])
 288     LDAH reg addr       -> usage (regAddr addr, [reg])
 289     LDGP reg addr       -> usage (regAddr addr, [reg])
 290     LDI sz reg imm      -> usage ([], [reg])
 291     ST B reg addr       -> usage (reg : regAddr addr, [t9, t10])
 292 --  ST W reg addr       -> usage (reg : regAddr addr, [t9, t10]) : UNUSED
 293     ST sz reg addr      -> usage (reg : regAddr addr, [])
 294     CLR reg             -> usage ([], [reg])
 295     ABS sz ri reg       -> usage (regRI ri, [reg])
 296     NEG sz ov ri reg    -> usage (regRI ri, [reg])
 297     ADD sz ov r1 ar r2  -> usage (r1 : regRI ar, [r2])
 298     SADD sz sc r1 ar r2 -> usage (r1 : regRI ar, [r2])
 299     SUB sz ov r1 ar r2  -> usage (r1 : regRI ar, [r2])
 300     SSUB sz sc r1 ar r2 -> usage (r1 : regRI ar, [r2])
 301     MUL sz ov r1 ar r2  -> usage (r1 : regRI ar, [r2])
 302     DIV sz un r1 ar r2  -> usage (r1 : regRI ar, [r2, t9, t10, t11, t12])
 303     REM sz un r1 ar r2  -> usage (r1 : regRI ar, [r2, t9, t10, t11, t12])
 304     NOT ri reg          -> usage (regRI ri, [reg])
 305     AND r1 ar r2        -> usage (r1 : regRI ar, [r2])
 306     ANDNOT r1 ar r2     -> usage (r1 : regRI ar, [r2])
 307     OR r1 ar r2         -> usage (r1 : regRI ar, [r2])
 308     ORNOT r1 ar r2      -> usage (r1 : regRI ar, [r2])
 309     XOR r1 ar r2        -> usage (r1 : regRI ar, [r2])
 310     XORNOT r1 ar r2     -> usage (r1 : regRI ar, [r2])
 311     SLL r1 ar r2        -> usage (r1 : regRI ar, [r2])
 312     SRL r1 ar r2        -> usage (r1 : regRI ar, [r2])
 313     SRA r1 ar r2        -> usage (r1 : regRI ar, [r2])
 314     ZAP r1 ar r2        -> usage (r1 : regRI ar, [r2])
 315     ZAPNOT r1 ar r2     -> usage (r1 : regRI ar, [r2])
 316     CMP co r1 ar r2     -> usage (r1 : regRI ar, [r2])
 317     FCLR reg            -> usage ([], [reg])
 318     FABS r1 r2          -> usage ([r1], [r2])
 319     FNEG sz r1 r2       -> usage ([r1], [r2])
 320     FADD sz r1 r2 r3    -> usage ([r1, r2], [r3])
 321     FDIV sz r1 r2 r3    -> usage ([r1, r2], [r3])
 322     FMUL sz r1 r2 r3    -> usage ([r1, r2], [r3])
 323     FSUB sz r1 r2 r3    -> usage ([r1, r2], [r3])
 324     CVTxy sz1 sz2 r1 r2 -> usage ([r1], [r2])
 325     FCMP sz co r1 r2 r3 -> usage ([r1, r2], [r3])
 326     FMOV r1 r2          -> usage ([r1], [r2])
 327
 328
 329     -- We assume that all local jumps will be BI/BF/BR.  JMP must be out-of-line.
 330     BI cond reg lbl     -> usage ([reg], [])
 331     BF cond reg lbl     -> usage ([reg], [])
 332     JMP reg addr hint   -> RU (mkRegSet (filter interesting (regAddr addr))) freeRegSet
 333
 334     BSR _ n             -> RU (argRegSet n) callClobberedRegSet
 335     JSR reg addr n      -> RU (argRegSet n) callClobberedRegSet
 336
 337     _                   -> noUsage
 338
 339   where
 340     usage (src, dst) = RU (mkRegSet (filter interesting src))
 341                           (mkRegSet (filter interesting dst))
 342
 343     interesting (FixedReg _) = False
 344     interesting _ = True
 345
 346     regAddr (AddrReg r1)      = [r1]
 347     regAddr (AddrRegImm r1 _) = [r1]
 348     regAddr (AddrImm _)       = []
 349
 350     regRI (RIReg r) = [r]
 351     regRI  _    = []
 352
 353 #endif {- alpha_TARGET_ARCH -}
 354 -- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
 355 #if i386_TARGET_ARCH
 356
 357 regUsage instr = case instr of
 358     MOV  sz src dst     -> usage2  src dst
 359     MOVZxL sz src dst   -> usage2  src dst
 360     MOVSxL sz src dst   -> usage2  src dst
 361     LEA  sz src dst     -> usage2  src dst
 362     ADD  sz src dst     -> usage2s src dst
 363     SUB  sz src dst     -> usage2s src dst
 364     IMUL sz src dst     -> usage2s src dst
 365     IDIV sz src         -> usage (eax:edx:opToReg src) [eax,edx]
 366     AND  sz src dst     -> usage2s src dst
 367     OR   sz src dst     -> usage2s src dst
 368     XOR  sz src dst     -> usage2s src dst
 369     NOT  sz op          -> usage1 op
 370     NEGI sz op          -> usage1 op
 371     SHL  sz imm dst     -> usage1 dst
 372     SAR  sz imm dst     -> usage1 dst
 373     SHR  sz imm dst     -> usage1 dst
 374     BT   sz imm src     -> usage (opToReg src) []
 375
 376     PUSH sz op          -> usage (opToReg op) []
 377     POP  sz op          -> usage [] (opToReg op)
 378     TEST sz src dst     -> usage (opToReg src ++ opToReg dst) []
 379     CMP  sz src dst     -> usage (opToReg src ++ opToReg dst) []
 380     SETCC cond op       -> usage [] (opToReg op)
 381     JXX cond lbl        -> usage [] []
 382     JMP op              -> usage (opToReg op) freeRegs
 383     CALL imm            -> usage [] callClobberedRegs
 384     CLTD                -> usage [eax] [edx]
 385     NOP                 -> usage [] []
 386
 387     GMOV src dst        -> usage [src] [dst]
 388     GLD sz src dst      -> usage (addrToRegs src) [dst]
 389     GST sz src dst      -> usage [src] (addrToRegs dst)
 390
 391     GFTOD src dst       -> usage [src] [dst]
 392     GFTOI src dst       -> usage [src] [dst]
 393
 394     GDTOF src dst       -> usage [src] [dst]
 395     GDTOI src dst       -> usage [src] [dst]
 396
 397     GITOF src dst       -> usage [src] [dst]
 398     GITOD src dst       -> usage [src] [dst]
 399
 400     GADD sz s1 s2 dst   -> usage [s1,s2] [dst]
 401     GSUB sz s1 s2 dst   -> usage [s1,s2] [dst]
 402     GMUL sz s1 s2 dst   -> usage [s1,s2] [dst]
 403     GDIV sz s1 s2 dst   -> usage [s1,s2] [dst]
 404
 405     GCMP sz src1 src2   -> usage [src1,src2] []
 406     GABS sz src dst     -> usage [src] [dst]
 407     GNEG sz src dst     -> usage [src] [dst]
 408     GSQRT sz src dst    -> usage [src] [dst]
 409     GSIN sz src dst     -> usage [src] [dst]
 410     GCOS sz src dst     -> usage [src] [dst]
 411     GTAN sz src dst     -> usage [src] [dst]
 412
 413     COMMENT _           -> noUsage
 414     SEGMENT _           -> noUsage
 415     LABEL _             -> noUsage
 416     ASCII _ _           -> noUsage
 417     DATA _ _            -> noUsage
 418     _                   -> pprPanic "regUsage(x86)" empty
 419
 420  where
 421     -- 2 operand form in which the second operand is purely a destination
 422     usage2 :: Operand -> Operand -> RegUsage
 423     usage2 op (OpReg reg) = usage (opToReg op) [reg]
 424     usage2 op (OpAddr ea) = usage (opToReg op ++ addrToRegs ea) []
 425     usage2 op (OpImm imm) = usage (opToReg op) []
 426
 427     -- 2 operand form in which the second operand is also an input
 428     usage2s :: Operand -> Operand -> RegUsage
 429     usage2s op (OpReg reg) = usage (opToReg op ++ [reg]) [reg]
 430     usage2s op (OpAddr ea) = usage (opToReg op ++ addrToRegs ea) []
 431     usage2s op (OpImm imm) = usage (opToReg op) []
 432
 433     -- 1 operand form in which the operand is both used and written
 434     usage1 :: Operand -> RegUsage
 435     usage1 (OpReg reg)    = usage [reg] [reg]
 436     usage1 (OpAddr ea)    = usage (addrToRegs ea) []
 437
 438     allFPRegs = [fake0,fake1,fake2,fake3,fake4,fake5]
 439
 440     --callClobberedRegs = [ eax, ecx, edx ] -- according to gcc, anyway.
 441     callClobberedRegs = [eax,fake0,fake1,fake2,fake3,fake4,fake5]
 442
 443 -- General purpose register collecting functions.
 444
 445     opToReg (OpReg reg)   = [reg]
 446     opToReg (OpImm imm)   = []
 447     opToReg (OpAddr  ea)  = addrToRegs ea
 448
 449     addrToRegs (AddrBaseIndex base index _) = baseToReg base ++ indexToReg index
 450       where  baseToReg Nothing       = []
 451              baseToReg (Just r)      = [r]
 452              indexToReg Nothing      = []
 453              indexToReg (Just (r,_)) = [r]
 454     addrToRegs (ImmAddr _ _) = []
 455
 456     usage src dst = RU (mkRegSet (filter interesting src))
 457                        (mkRegSet (filter interesting dst))
 458
 459     interesting (FixedReg _) = False
 460     interesting _ = True
 461
 462
 463 -- Allow the spiller to decide whether or not it can use
 464 -- %eax and %edx as spill temporaries.
 465 hasFixedEAXorEDX instr = case instr of
 466     IDIV _ _ -> True
 467     CLTD     -> True
 468     other    -> False
 469
 470 #endif {- i386_TARGET_ARCH -}
 471 -- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
 472 #if sparc_TARGET_ARCH
 473
 474 regUsage instr = case instr of
 475     LD sz addr reg      -> usage (regAddr addr, [reg])
 476     ST sz reg addr      -> usage (reg : regAddr addr, [])
 477     ADD x cc r1 ar r2   -> usage (r1 : regRI ar, [r2])
 478     SUB x cc r1 ar r2   -> usage (r1 : regRI ar, [r2])
 479     AND b r1 ar r2      -> usage (r1 : regRI ar, [r2])
 480     ANDN b r1 ar r2     -> usage (r1 : regRI ar, [r2])
 481     OR b r1 ar r2       -> usage (r1 : regRI ar, [r2])
 482     ORN b r1 ar r2      -> usage (r1 : regRI ar, [r2])
 483     XOR b r1 ar r2      -> usage (r1 : regRI ar, [r2])
 484     XNOR b r1 ar r2     -> usage (r1 : regRI ar, [r2])
 485     SLL r1 ar r2        -> usage (r1 : regRI ar, [r2])
 486     SRL r1 ar r2        -> usage (r1 : regRI ar, [r2])
 487     SRA r1 ar r2        -> usage (r1 : regRI ar, [r2])
 488     SETHI imm reg       -> usage ([], [reg])
 489     FABS s r1 r2        -> usage ([r1], [r2])
 490     FADD s r1 r2 r3     -> usage ([r1, r2], [r3])
 491     FCMP e s r1 r2      -> usage ([r1, r2], [])
 492     FDIV s r1 r2 r3     -> usage ([r1, r2], [r3])
 493     FMOV s r1 r2        -> usage ([r1], [r2])
 494     FMUL s r1 r2 r3     -> usage ([r1, r2], [r3])
 495     FNEG s r1 r2        -> usage ([r1], [r2])
 496     FSQRT s r1 r2       -> usage ([r1], [r2])
 497     FSUB s r1 r2 r3     -> usage ([r1, r2], [r3])
 498     FxTOy s1 s2 r1 r2   -> usage ([r1], [r2])
 499
 500     -- We assume that all local jumps will be BI/BF.  JMP must be out-of-line.
 501     JMP addr            -> RU (mkRegSet (filter interesting (regAddr addr))) freeRegSet
 502
 503     CALL _ n True       -> endUsage
 504     CALL _ n False      -> RU (argRegSet n) callClobberedRegSet
 505
 506     _                   -> noUsage
 507   where
 508     usage (src, dst) = RU (mkRegSet (filter interesting src))
 509                           (mkRegSet (filter interesting dst))
 510
 511     interesting (FixedReg _) = False
 512     interesting _ = True
 513
 514     regAddr (AddrRegReg r1 r2) = [r1, r2]
 515     regAddr (AddrRegImm r1 _)  = [r1]
 516
 517     regRI (RIReg r) = [r]
 518     regRI  _    = []
 519
 520 #endif {- sparc_TARGET_ARCH -}
 521 \end{code}
 522
 523
 524 %************************************************************************
 525 %*                                                                      *
 526 \subsection{Free, reserved, call-clobbered, and argument registers}
 527 %*                                                                      *
 528 %************************************************************************
 529
 530 @freeRegs@ is the list of registers we can use in register allocation.
 531 @freeReg@ (below) says if a particular register is free.
 532
 533 With a per-instruction clobber list, we might be able to get some of
 534 these back, but it's probably not worth the hassle.
 535
 536 @callClobberedRegs@ ... the obvious.
 537
 538 @argRegs@: assuming a call with N arguments, what registers will be
 539 used to hold arguments?  (NB: it doesn't know whether the arguments
 540 are integer or floating-point...)
 541
 542 findReservedRegs tells us which regs can be used as spill temporaries.
 543 The list of instructions for which we are attempting allocation is
 544 supplied.  This is so that we can (at least for x86) examine it to
 545 discover which registers are being used in a fixed way -- for example,
 546 %eax and %edx are used by integer division, so they can't be used as
 547 spill temporaries.  However, most instruction lists don't do integer
 548 division, so we don't want to rule them out altogether.
 549
 550 findReservedRegs returns not a list of spill temporaries, but a list
 551 of list of them.  This is so that the allocator can attempt allocating
 552 with at first no spill temps, then if that fails, increasing numbers.
 553 For x86 it is important that we minimise the number of regs reserved
 554 as spill temporaries, since there are so few.  For Alpha and Sparc
 555 this isn't a concern; we just ignore the supplied code list and return
 556 a singleton list which we know will satisfy all spill demands.
 557
 558 \begin{code}
 559 findReservedRegs :: [Instr] -> [[RegNo]]
 560 findReservedRegs instrs
 561 #if alpha_TARGET_ARCH
 562   = --[[NCG_Reserved_I1, NCG_Reserved_I2,
 563     --  NCG_Reserved_F1, NCG_Reserved_F2]]
 564     error "findReservedRegs: alpha"
 565 #endif
 566 #if sparc_TARGET_ARCH
 567   = --[[NCG_Reserved_I1, NCG_Reserved_I2,
 568     --  NCG_Reserved_F1, NCG_Reserved_F2,
 569     --  NCG_Reserved_D1, NCG_Reserved_D2]]
 570     error "findReservedRegs: sparc"
 571 #endif
 572 #if i386_TARGET_ARCH
 573     -- Sigh.  This is where it gets complicated.
 574   = -- first of all, try without any at all.
 575     map (map mappedRegNo) (
 576     [ [],
 577     -- if that doesn't work, try one integer reg (which might fail)
 578     -- and two float regs (which will always fix any float insns)
 579       [ecx, fake4,fake5]
 580     ]
 581     -- dire straits (but still correct): see if we can bag %eax and %edx
 582     ++ if   any hasFixedEAXorEDX instrs
 583        then []  -- bummer
 584        else --[ [ecx,edx,fake4,fake5],
 585             --  [ecx,edx,eax,fake4,fake5] ]
 586             -- pro tem, don't use %eax until we institute a check that
 587             -- instrs doesn't do a CALL insn, since that effectively
 588             -- uses %eax in a fixed way
 589             [ [ecx,edx,fake4,fake5] ]
 590
 591     )
 592 #endif
 593 \end{code}
 594
 595 %************************************************************************
 596 %*                                                                      *
 597 \subsection{@RegLiveness@ type; @regLiveness@ function}
 598 %*                                                                      *
 599 %************************************************************************
 600
 601 @regLiveness@ takes future liveness information and modifies it
 602 according to the semantics of branches and labels.  (An out-of-line
 603 branch clobbers the liveness passed back by the following instruction;
 604 a forward local branch passes back the liveness from the target label;
 605 a conditional branch merges the liveness from the target and the
 606 liveness from its successor; a label stashes away the current liveness
 607 in the future liveness environment).
 608
 609 \begin{code}
 610 data RegLiveness = RL RegSet FutureLive
 611
 612 regLiveness :: Instr -> RegLiveness -> RegLiveness
 613
 614 regLiveness instr info@(RL live future@(FL all env))
 615   = let
 616         lookup lbl
 617           = case (lookupFM env lbl) of
 618             Just rs -> rs
 619             Nothing -> pprTrace "Missing" (pprCLabel_asm lbl <+> text "in future?")
 620                        emptyRegSet
 621     in
 622     case instr of -- the rest is machine-specific...
 623
 624 #if alpha_TARGET_ARCH
 625
 626     -- We assume that all local jumps will be BI/BF.  JMP must be out-of-line.
 627
 628     BR (ImmCLbl lbl)     -> RL (lookup lbl) future
 629     BI _ _ (ImmCLbl lbl) -> RL (lookup lbl `unionRegSets` live) future
 630     BF _ _ (ImmCLbl lbl) -> RL (lookup lbl `unionRegSets` live) future
 631     JMP _ _ _            -> RL emptyRegSet future
 632     BSR _ _              -> RL live future
 633     JSR _ _ _            -> RL live future
 634     LABEL lbl            -> RL live (FL (all `unionRegSets` live) (addToFM env lbl live))
 635     _                    -> info
 636
 637 #endif {- alpha_TARGET_ARCH -}
 638 -- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
 639 #if i386_TARGET_ARCH
 640
 641     JXX _ lbl   -> RL (lookup lbl `unionRegSets` live) future
 642     JMP _       -> RL emptyRegSet future
 643     CALL _      -> RL live future
 644     LABEL lbl   -> RL live (FL (all `unionRegSets` live) (addToFM env lbl live))
 645     _               -> info
 646
 647 #endif {- i386_TARGET_ARCH -}
 648 -- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
 649 #if sparc_TARGET_ARCH
 650
 651     -- We assume that all local jumps will be BI/BF.  JMP must be out-of-line.
 652
 653     BI ALWAYS _ (ImmCLbl lbl)   -> RL (lookup lbl) future
 654     BI _ _ (ImmCLbl lbl)        -> RL (lookup lbl `unionRegSets` live) future
 655     BF ALWAYS _ (ImmCLbl lbl)   -> RL (lookup lbl) future
 656     BF _ _ (ImmCLbl lbl)        -> RL (lookup lbl `unionRegSets` live) future
 657     JMP _                       -> RL emptyRegSet future
 658     CALL _ i True   -> RL emptyRegSet future
 659     CALL _ i False  -> RL live future
 660     LABEL lbl       -> RL live (FL (all `unionRegSets` live) (addToFM env lbl live))
 661     _               -> info
 662
 663 #endif {- sparc_TARGET_ARCH -}
 664 \end{code}
 665
 666 %************************************************************************
 667 %*                                                                      *
 668 \subsection{@patchRegs@ function}
 669 %*                                                                      *
 670 %************************************************************************
 671
 672 @patchRegs@ takes an instruction (possibly with
 673 MemoryReg/UnmappedReg registers) and changes all register references
 674 according to the supplied environment.
 675
 676 \begin{code}
 677 patchRegs :: Instr -> (Reg -> Reg) -> Instr
 678
 679 #if alpha_TARGET_ARCH
 680
 681 patchRegs instr env = case instr of
 682     LD sz reg addr -> LD sz (env reg) (fixAddr addr)
 683     LDA reg addr -> LDA (env reg) (fixAddr addr)
 684     LDAH reg addr -> LDAH (env reg) (fixAddr addr)
 685     LDGP reg addr -> LDGP (env reg) (fixAddr addr)
 686     LDI sz reg imm -> LDI sz (env reg) imm
 687     ST sz reg addr -> ST sz (env reg) (fixAddr addr)
 688     CLR reg -> CLR (env reg)
 689     ABS sz ar reg -> ABS sz (fixRI ar) (env reg)
 690     NEG sz ov ar reg -> NEG sz ov (fixRI ar) (env reg)
 691     ADD sz ov r1 ar r2 -> ADD sz ov (env r1) (fixRI ar) (env r2)
 692     SADD sz sc r1 ar r2 -> SADD sz sc (env r1) (fixRI ar) (env r2)
 693     SUB sz ov r1 ar r2 -> SUB sz ov (env r1) (fixRI ar) (env r2)
 694     SSUB sz sc r1 ar r2 -> SSUB sz sc (env r1) (fixRI ar) (env r2)
 695     MUL sz ov r1 ar r2 -> MUL sz ov (env r1) (fixRI ar) (env r2)
 696     DIV sz un r1 ar r2 -> DIV sz un (env r1) (fixRI ar) (env r2)
 697     REM sz un r1 ar r2 -> REM sz un (env r1) (fixRI ar) (env r2)
 698     NOT ar reg -> NOT (fixRI ar) (env reg)
 699     AND r1 ar r2 -> AND (env r1) (fixRI ar) (env r2)
 700     ANDNOT r1 ar r2 -> ANDNOT (env r1) (fixRI ar) (env r2)
 701     OR r1 ar r2 -> OR (env r1) (fixRI ar) (env r2)
 702     ORNOT r1 ar r2 -> ORNOT (env r1) (fixRI ar) (env r2)
 703     XOR r1 ar r2 -> XOR (env r1) (fixRI ar) (env r2)
 704     XORNOT r1 ar r2 -> XORNOT (env r1) (fixRI ar) (env r2)
 705     SLL r1 ar r2 -> SLL (env r1) (fixRI ar) (env r2)
 706     SRL r1 ar r2 -> SRL (env r1) (fixRI ar) (env r2)
 707     SRA r1 ar r2 -> SRA (env r1) (fixRI ar) (env r2)
 708     ZAP r1 ar r2 -> ZAP (env r1) (fixRI ar) (env r2)
 709     ZAPNOT r1 ar r2 -> ZAPNOT (env r1) (fixRI ar) (env r2)
 710     CMP co r1 ar r2 -> CMP co (env r1) (fixRI ar) (env r2)
 711     FCLR reg -> FCLR (env reg)
 712     FABS r1 r2 -> FABS (env r1) (env r2)
 713     FNEG s r1 r2 -> FNEG s (env r1) (env r2)
 714     FADD s r1 r2 r3 -> FADD s (env r1) (env r2) (env r3)
 715     FDIV s r1 r2 r3 -> FDIV s (env r1) (env r2) (env r3)
 716     FMUL s r1 r2 r3 -> FMUL s (env r1) (env r2) (env r3)
 717     FSUB s r1 r2 r3 -> FSUB s (env r1) (env r2) (env r3)
 718     CVTxy s1 s2 r1 r2 -> CVTxy s1 s2 (env r1) (env r2)
 719     FCMP s co r1 r2 r3 -> FCMP s co (env r1) (env r2) (env r3)
 720     FMOV r1 r2 -> FMOV (env r1) (env r2)
 721     BI cond reg lbl -> BI cond (env reg) lbl
 722     BF cond reg lbl -> BF cond (env reg) lbl
 723     JMP reg addr hint -> JMP (env reg) (fixAddr addr) hint
 724     JSR reg addr i -> JSR (env reg) (fixAddr addr) i
 725     _ -> instr
 726   where
 727     fixAddr (AddrReg r1)       = AddrReg (env r1)
 728     fixAddr (AddrRegImm r1 i)  = AddrRegImm (env r1) i
 729     fixAddr other              = other
 730
 731     fixRI (RIReg r) = RIReg (env r)
 732     fixRI other = other
 733
 734 #endif {- alpha_TARGET_ARCH -}
 735 -- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
 736 #if i386_TARGET_ARCH
 737
 738 patchRegs instr env = case instr of
 739     MOV  sz src dst     -> patch2 (MOV  sz) src dst
 740     MOVZxL sz src dst   -> patch2 (MOVZxL sz) src dst
 741     MOVSxL sz src dst   -> patch2 (MOVSxL sz) src dst
 742     LEA  sz src dst     -> patch2 (LEA  sz) src dst
 743     ADD  sz src dst     -> patch2 (ADD  sz) src dst
 744     SUB  sz src dst     -> patch2 (SUB  sz) src dst
 745     IMUL sz src dst     -> patch2 (IMUL sz) src dst
 746     IDIV sz src         -> patch1 (IDIV sz) src
 747     AND  sz src dst     -> patch2 (AND  sz) src dst
 748     OR   sz src dst     -> patch2 (OR   sz) src dst
 749     XOR  sz src dst     -> patch2 (XOR  sz) src dst
 750     NOT  sz op          -> patch1 (NOT  sz) op
 751     NEGI sz op          -> patch1 (NEGI sz) op
 752     SHL  sz imm dst     -> patch1 (SHL sz imm) dst
 753     SAR  sz imm dst     -> patch1 (SAR sz imm) dst
 754     SHR  sz imm dst     -> patch1 (SHR sz imm) dst
 755     BT   sz imm src     -> patch1 (BT  sz imm) src
 756     TEST sz src dst     -> patch2 (TEST sz) src dst
 757     CMP  sz src dst     -> patch2 (CMP  sz) src dst
 758     PUSH sz op          -> patch1 (PUSH sz) op
 759     POP  sz op          -> patch1 (POP  sz) op
 760     SETCC cond op       -> patch1 (SETCC cond) op
 761     JMP op              -> patch1 JMP op
 762
 763     GMOV src dst        -> GMOV (env src) (env dst)
 764     GLD sz src dst      -> GLD sz (lookupAddr src) (env dst)
 765     GST sz src dst      -> GST sz (env src) (lookupAddr dst)
 766
 767     GFTOD src dst       -> GFTOD (env src) (env dst)
 768     GFTOI src dst       -> GFTOI (env src) (env dst)
 769
 770     GDTOF src dst       -> GDTOF (env src) (env dst)
 771     GDTOI src dst       -> GDTOI (env src) (env dst)
 772
 773     GITOF src dst       -> GITOF (env src) (env dst)
 774     GITOD src dst       -> GITOD (env src) (env dst)
 775
 776     GADD sz s1 s2 dst   -> GADD sz (env s1) (env s2) (env dst)
 777     GSUB sz s1 s2 dst   -> GSUB sz (env s1) (env s2) (env dst)
 778     GMUL sz s1 s2 dst   -> GMUL sz (env s1) (env s2) (env dst)
 779     GDIV sz s1 s2 dst   -> GDIV sz (env s1) (env s2) (env dst)
 780
 781     GCMP sz src1 src2   -> GCMP sz (env src1) (env src2)
 782     GABS sz src dst     -> GABS sz (env src) (env dst)
 783     GNEG sz src dst     -> GNEG sz (env src) (env dst)
 784     GSQRT sz src dst    -> GSQRT sz (env src) (env dst)
 785     GSIN sz src dst     -> GSIN sz (env src) (env dst)
 786     GCOS sz src dst     -> GCOS sz (env src) (env dst)
 787     GTAN sz src dst     -> GTAN sz (env src) (env dst)
 788
 789     COMMENT _           -> instr
 790     SEGMENT _           -> instr
 791     LABEL _             -> instr
 792     ASCII _ _           -> instr
 793     DATA _ _            -> instr
 794     JXX _ _             -> instr
 795     CALL _              -> instr
 796     CLTD                -> instr
 797     _                   -> pprPanic "patchInstr(x86)" empty
 798
 799   where
 800     patch1 insn op      = insn (patchOp op)
 801     patch2 insn src dst = insn (patchOp src) (patchOp dst)
 802
 803     patchOp (OpReg  reg) = OpReg (env reg)
 804     patchOp (OpImm  imm) = OpImm imm
 805     patchOp (OpAddr ea)  = OpAddr (lookupAddr ea)
 806
 807     lookupAddr (ImmAddr imm off) = ImmAddr imm off
 808     lookupAddr (AddrBaseIndex base index disp)
 809       = AddrBaseIndex (lookupBase base) (lookupIndex index) disp
 810       where
 811         lookupBase Nothing       = Nothing
 812         lookupBase (Just r)      = Just (env r)
 813
 814         lookupIndex Nothing      = Nothing
 815         lookupIndex (Just (r,i)) = Just (env r, i)
 816
 817 #endif {- i386_TARGET_ARCH -}
 818 -- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
 819 #if sparc_TARGET_ARCH
 820
 821 patchRegs instr env = case instr of
 822     LD sz addr reg -> LD sz (fixAddr addr) (env reg)
 823     ST sz reg addr -> ST sz (env reg) (fixAddr addr)
 824     ADD x cc r1 ar r2 -> ADD x cc (env r1) (fixRI ar) (env r2)
 825     SUB x cc r1 ar r2 -> SUB x cc (env r1) (fixRI ar) (env r2)
 826     AND b r1 ar r2 -> AND b (env r1) (fixRI ar) (env r2)
 827     ANDN b r1 ar r2 -> ANDN b (env r1) (fixRI ar) (env r2)
 828     OR b r1 ar r2 -> OR b (env r1) (fixRI ar) (env r2)
 829     ORN b r1 ar r2 -> ORN b (env r1) (fixRI ar) (env r2)
 830     XOR b r1 ar r2 -> XOR b (env r1) (fixRI ar) (env r2)
 831     XNOR b r1 ar r2 -> XNOR b (env r1) (fixRI ar) (env r2)
 832     SLL r1 ar r2 -> SLL (env r1) (fixRI ar) (env r2)
 833     SRL r1 ar r2 -> SRL (env r1) (fixRI ar) (env r2)
 834     SRA r1 ar r2 -> SRA (env r1) (fixRI ar) (env r2)
 835     SETHI imm reg -> SETHI imm (env reg)
 836     FABS s r1 r2 -> FABS s (env r1) (env r2)
 837     FADD s r1 r2 r3 -> FADD s (env r1) (env r2) (env r3)
 838     FCMP e s r1 r2 -> FCMP e s (env r1) (env r2)
 839     FDIV s r1 r2 r3 -> FDIV s (env r1) (env r2) (env r3)
 840     FMOV s r1 r2 -> FMOV s (env r1) (env r2)
 841     FMUL s r1 r2 r3 -> FMUL s (env r1) (env r2) (env r3)
 842     FNEG s r1 r2 -> FNEG s (env r1) (env r2)
 843     FSQRT s r1 r2 -> FSQRT s (env r1) (env r2)
 844     FSUB s r1 r2 r3 -> FSUB s (env r1) (env r2) (env r3)
 845     FxTOy s1 s2 r1 r2 -> FxTOy s1 s2 (env r1) (env r2)
 846     JMP addr -> JMP (fixAddr addr)
 847     _ -> instr
 848   where
 849     fixAddr (AddrRegReg r1 r2) = AddrRegReg (env r1) (env r2)
 850     fixAddr (AddrRegImm r1 i)  = AddrRegImm (env r1) i
 851
 852     fixRI (RIReg r) = RIReg (env r)
 853     fixRI other = other
 854
 855 #endif {- sparc_TARGET_ARCH -}
 856 \end{code}
 857
 858 %************************************************************************
 859 %*                                                                      *
 860 \subsection{@spillReg@ and @loadReg@ functions}
 861 %*                                                                      *
 862 %************************************************************************
 863
 864 Spill to memory, and load it back...
 865
 866 JRS, 000122: on x86, don't spill directly above the stack pointer,
 867 since some insn sequences (int <-> conversions, and eventually
 868 StixInteger) use this as a temp location.  Leave 8 words (ie, 64 bytes
 869 for a 64-bit arch) of slop.
 870
 871 \begin{code}
 872 maxSpillSlots :: Int
 873 maxSpillSlots = (rESERVED_C_STACK_BYTES - 64) `div` 8
 874
 875 -- convert a spill slot number to a *byte* offset, with no sign:
 876 -- decide on a per arch basis whether you are spilling above or below
 877 -- the C stack pointer.
 878 spillSlotToOffset :: Int -> Int
 879 spillSlotToOffset slot
 880    | slot >= 0 && slot < maxSpillSlots
 881    = 64 + 8 * slot
 882    | otherwise
 883    = pprPanic "spillSlotToOffset:"
 884               (text "invalid spill location: " <> int slot)
 885
 886 spillReg, loadReg :: Reg -> Reg -> InstrList
 887
 888 spillReg dyn (MemoryReg i pk)
 889   = let sz  = primRepToSize pk
 890         off = spillSlotToOffset i
 891     in
 892     mkUnitList (
 893         {-Alpha: spill below the stack pointer (?)-}
 894          IF_ARCH_alpha( ST sz dyn (spRel (- (off `div` 8)))
 895
 896         {-I386: spill above stack pointer leaving 2 words/spill-}
 897         ,IF_ARCH_i386 ( let off_w = off `div` 4
 898                         in
 899                         if pk == FloatRep || pk == DoubleRep
 900                         then GST DF dyn (spRel off_w)
 901                         else MOV sz (OpReg dyn) (OpAddr (spRel off_w))
 902
 903         {-SPARC: spill below frame pointer leaving 2 words/spill-}
 904         ,IF_ARCH_sparc( ST sz dyn (fpRel (- (off `div` 4)))
 905         ,)))
 906     )
 907
 908 loadReg (MemoryReg i pk) dyn
 909   = let sz  = primRepToSize pk
 910         off = spillSlotToOffset i
 911     in
 912     mkUnitList (
 913          IF_ARCH_alpha( LD  sz dyn (spRel (- (off `div` 8)))
 914         ,IF_ARCH_i386 ( let off_w = off `div` 4
 915                         in
 916                         if   pk == FloatRep || pk == DoubleRep
 917                         then GLD DF (spRel off_w) dyn
 918                         else MOV sz (OpAddr (spRel off_w)) (OpReg dyn)
 919         ,IF_ARCH_sparc( LD  sz (fpRel (- (off `div` 4))) dyn
 920         ,)))
 921     )
 922 \end{code}