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 OrdList          ( unitOL )
  58 import MachMisc
  59 import MachRegs
  60 import MachCode         ( InstrBlock )
  61
  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 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   -> usageRW src dst
 359     MOVZxL sz src dst   -> usageRW src dst
 360     MOVSxL sz src dst   -> usageRW src dst
 361     LEA    sz src dst   -> usageRW src dst
 362     ADD    sz src dst   -> usageRM src dst
 363     SUB    sz src dst   -> usageRM src dst
 364     IMUL   sz src dst   -> usageRM src dst
 365     IDIV   sz src       -> mkRU (eax:edx:use_R src) [eax,edx]
 366     AND    sz src dst   -> usageRM src dst
 367     OR     sz src dst   -> usageRM src dst
 368     XOR    sz src dst   -> usageRM src dst
 369     NOT    sz op        -> usageM op
 370     NEGI   sz op        -> usageM op
 371     SHL    sz imm dst   -> usageM dst
 372     SAR    sz imm dst   -> usageM dst
 373     SHR    sz imm dst   -> usageM dst
 374     BT     sz imm src   -> mkRU (use_R src) []
 375
 376     PUSH   sz op        -> mkRU (use_R op) []
 377     POP    sz op        -> mkRU [] (def_W op)
 378     TEST   sz src dst   -> mkRU (use_R src ++ use_R dst) []
 379     CMP    sz src dst   -> mkRU (use_R src ++ use_R dst) []
 380     SETCC  cond op      -> mkRU [] (def_W op)
 381     JXX    cond lbl     -> mkRU [] []
 382     JMP    op           -> mkRU (use_R op) freeRegs
 383     CALL   imm          -> mkRU [] callClobberedRegs
 384     CLTD                -> mkRU [eax] [edx]
 385     NOP                 -> mkRU [] []
 386
 387     GMOV   src dst      -> mkRU [src] [dst]
 388     GLD    sz src dst   -> mkRU (use_EA src) [dst]
 389     GST    sz src dst   -> mkRU (src : use_EA dst) []
 390
 391     GLDZ   dst          -> mkRU [] [dst]
 392     GLD1   dst          -> mkRU [] [dst]
 393
 394     GFTOD  src dst      -> mkRU [src] [dst]
 395     GFTOI  src dst      -> mkRU [src] [dst]
 396
 397     GDTOF  src dst      -> mkRU [src] [dst]
 398     GDTOI  src dst      -> mkRU [src] [dst]
 399
 400     GITOF  src dst      -> mkRU [src] [dst]
 401     GITOD  src dst      -> mkRU [src] [dst]
 402
 403     GADD   sz s1 s2 dst -> mkRU [s1,s2] [dst]
 404     GSUB   sz s1 s2 dst -> mkRU [s1,s2] [dst]
 405     GMUL   sz s1 s2 dst -> mkRU [s1,s2] [dst]
 406     GDIV   sz s1 s2 dst -> mkRU [s1,s2] [dst]
 407
 408     GCMP   sz src1 src2 -> mkRU [src1,src2] []
 409     GABS   sz src dst   -> mkRU [src] [dst]
 410     GNEG   sz src dst   -> mkRU [src] [dst]
 411     GSQRT  sz src dst   -> mkRU [src] [dst]
 412     GSIN   sz src dst   -> mkRU [src] [dst]
 413     GCOS   sz src dst   -> mkRU [src] [dst]
 414     GTAN   sz src dst   -> mkRU [src] [dst]
 415
 416     COMMENT _           -> noUsage
 417     SEGMENT _           -> noUsage
 418     LABEL   _           -> noUsage
 419     ASCII   _ _         -> noUsage
 420     DATA    _ _         -> noUsage
 421     DELTA   _           -> noUsage
 422     _                   -> pprPanic "regUsage(x86)" empty
 423
 424  where
 425     -- 2 operand form; first operand Read; second Written
 426     usageRW :: Operand -> Operand -> RegUsage
 427     usageRW op (OpReg reg) = mkRU (use_R op) [reg]
 428     usageRW op (OpAddr ea) = mkRU (use_R op ++ use_EA ea) []
 429
 430     -- 2 operand form; first operand Read; second Modified
 431     usageRM :: Operand -> Operand -> RegUsage
 432     usageRM op (OpReg reg) = mkRU (use_R op ++ [reg]) [reg]
 433     usageRM op (OpAddr ea) = mkRU (use_R op ++ use_EA ea) []
 434
 435     -- 1 operand form; operand Modified
 436     usageM :: Operand -> RegUsage
 437     usageM (OpReg reg)    = mkRU [reg] [reg]
 438     usageM (OpAddr ea)    = mkRU (use_EA ea) []
 439
 440     -- caller-saves registers
 441     callClobberedRegs = [eax,ecx,edx,fake0,fake1,fake2,fake3,fake4,fake5]
 442
 443     -- Registers defd when an operand is written.
 444     def_W (OpReg reg)  = [reg]
 445     def_W (OpAddr ea)  = []
 446
 447     -- Registers used when an operand is read.
 448     use_R (OpReg reg)  = [reg]
 449     use_R (OpImm imm)  = []
 450     use_R (OpAddr ea)  = use_EA ea
 451
 452     -- Registers used to compute an effective address.
 453     use_EA (ImmAddr _ _)                           = []
 454     use_EA (AddrBaseIndex Nothing  Nothing      _) = []
 455     use_EA (AddrBaseIndex (Just b) Nothing      _) = [b]
 456     use_EA (AddrBaseIndex Nothing  (Just (i,_)) _) = [i]
 457     use_EA (AddrBaseIndex (Just b) (Just (i,_)) _) = [b,i]
 458
 459     mkRU src dst = RU (mkRegSet (filter interesting src))
 460                       (mkRegSet (filter interesting dst))
 461
 462     interesting (FixedReg _) = False
 463     interesting _            = True
 464
 465
 466 -- Allow the spiller to decide whether or not it can use
 467 -- %edx as spill temporaries.
 468 hasFixedEDX instr
 469    = case instr of
 470         IDIV _ _ -> True
 471         CLTD     -> True
 472         other    -> False
 473
 474 #endif {- i386_TARGET_ARCH -}
 475 -- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
 476 #if sparc_TARGET_ARCH
 477
 478 regUsage instr = case instr of
 479     LD sz addr reg      -> usage (regAddr addr, [reg])
 480     ST sz reg addr      -> usage (reg : regAddr addr, [])
 481     ADD x cc r1 ar r2   -> usage (r1 : regRI ar, [r2])
 482     SUB x cc r1 ar r2   -> usage (r1 : regRI ar, [r2])
 483     AND b r1 ar r2      -> usage (r1 : regRI ar, [r2])
 484     ANDN b r1 ar r2     -> usage (r1 : regRI ar, [r2])
 485     OR b r1 ar r2       -> usage (r1 : regRI ar, [r2])
 486     ORN b r1 ar r2      -> usage (r1 : regRI ar, [r2])
 487     XOR b r1 ar r2      -> usage (r1 : regRI ar, [r2])
 488     XNOR b r1 ar r2     -> usage (r1 : regRI ar, [r2])
 489     SLL r1 ar r2        -> usage (r1 : regRI ar, [r2])
 490     SRL r1 ar r2        -> usage (r1 : regRI ar, [r2])
 491     SRA r1 ar r2        -> usage (r1 : regRI ar, [r2])
 492     SETHI imm reg       -> usage ([], [reg])
 493     FABS s r1 r2        -> usage ([r1], [r2])
 494     FADD s r1 r2 r3     -> usage ([r1, r2], [r3])
 495     FCMP e s r1 r2      -> usage ([r1, r2], [])
 496     FDIV s r1 r2 r3     -> usage ([r1, r2], [r3])
 497     FMOV s r1 r2        -> usage ([r1], [r2])
 498     FMUL s r1 r2 r3     -> usage ([r1, r2], [r3])
 499     FNEG s r1 r2        -> usage ([r1], [r2])
 500     FSQRT s r1 r2       -> usage ([r1], [r2])
 501     FSUB s r1 r2 r3     -> usage ([r1, r2], [r3])
 502     FxTOy s1 s2 r1 r2   -> usage ([r1], [r2])
 503
 504     -- We assume that all local jumps will be BI/BF.  JMP must be out-of-line.
 505     JMP addr            -> RU (mkRegSet (filter interesting (regAddr addr))) freeRegSet
 506
 507     CALL _ n True       -> endUsage
 508     CALL _ n False      -> RU (argRegSet n) callClobberedRegSet
 509
 510     _                   -> noUsage
 511   where
 512     usage (src, dst) = RU (mkRegSet (filter interesting src))
 513                           (mkRegSet (filter interesting dst))
 514
 515     interesting (FixedReg _) = False
 516     interesting _ = True
 517
 518     regAddr (AddrRegReg r1 r2) = [r1, r2]
 519     regAddr (AddrRegImm r1 _)  = [r1]
 520
 521     regRI (RIReg r) = [r]
 522     regRI  _    = []
 523
 524 #endif {- sparc_TARGET_ARCH -}
 525 \end{code}
 526
 527
 528 %************************************************************************
 529 %*                                                                      *
 530 \subsection{Free, reserved, call-clobbered, and argument registers}
 531 %*                                                                      *
 532 %************************************************************************
 533
 534 @freeRegs@ is the list of registers we can use in register allocation.
 535 @freeReg@ (below) says if a particular register is free.
 536
 537 With a per-instruction clobber list, we might be able to get some of
 538 these back, but it's probably not worth the hassle.
 539
 540 @callClobberedRegs@ ... the obvious.
 541
 542 @argRegs@: assuming a call with N arguments, what registers will be
 543 used to hold arguments?  (NB: it doesn't know whether the arguments
 544 are integer or floating-point...)
 545
 546 findReservedRegs tells us which regs can be used as spill temporaries.
 547 The list of instructions for which we are attempting allocation is
 548 supplied.  This is so that we can (at least for x86) examine it to
 549 discover which registers are being used in a fixed way -- for example,
 550 %eax and %edx are used by integer division, so they can't be used as
 551 spill temporaries.  However, most instruction lists don't do integer
 552 division, so we don't want to rule them out altogether.
 553
 554 findReservedRegs returns not a list of spill temporaries, but a list
 555 of list of them.  This is so that the allocator can attempt allocating
 556 with at first no spill temps, then if that fails, increasing numbers.
 557 For x86 it is important that we minimise the number of regs reserved
 558 as spill temporaries, since there are so few.  For Alpha and Sparc
 559 this isn't a concern; we just ignore the supplied code list and return
 560 a singleton list which we know will satisfy all spill demands.
 561
 562 \begin{code}
 563 findReservedRegs :: [Instr] -> [[RegNo]]
 564 findReservedRegs instrs
 565 #if alpha_TARGET_ARCH
 566   = --[[NCG_Reserved_I1, NCG_Reserved_I2,
 567     --  NCG_Reserved_F1, NCG_Reserved_F2]]
 568     error "findReservedRegs: alpha"
 569 #endif
 570 #if sparc_TARGET_ARCH
 571   = --[[NCG_Reserved_I1, NCG_Reserved_I2,
 572     --  NCG_Reserved_F1, NCG_Reserved_F2,
 573     --  NCG_Reserved_D1, NCG_Reserved_D2]]
 574     error "findReservedRegs: sparc"
 575 #endif
 576 #if i386_TARGET_ARCH
 577   -- We can use %fake4 and %fake5 safely for float temps.
 578   -- Int regs are more troublesome.  Only %ecx is definitely
 579   -- available.  If there are no division insns, we can use %edx
 580   -- too.  At a pinch, we also could bag %eax if there are no
 581   -- divisions and no ccalls, but so far we've never encountered
 582   -- a situation where three integer temporaries are necessary.
 583   --
 584   -- Because registers are in short supply on x86, we give the
 585   -- allocator a whole bunch of possibilities, starting with zero
 586   -- temporaries and working up to all that are available.  This
 587   -- is inefficient, but spills are pretty rare, so we don't care
 588   -- if the register allocator has to try half a dozen or so possibilities
 589   -- before getting to one that works.
 590   = let f1 = fake5
 591         f2 = fake4
 592         intregs_avail
 593            = ecx : if any hasFixedEDX instrs then [] else [edx]
 594         possibilities
 595            = case intregs_avail of
 596                 [i1] -> [ [], [i1], [f1], [i1,f1], [f1,f2], [i1,f1,f2] ]
 597
 598                 [i1,i2] -> [ [], [i1], [f1], [i1,i2], [i1,f1], [f1,f2],
 599                              [i1,i2,f1], [i1,f1,f2], [i1,i2,f1,f2] ]
 600     in
 601         map (map mappedRegNo) possibilities
 602 #endif
 603 \end{code}
 604
 605 %************************************************************************
 606 %*                                                                      *
 607 \subsection{@RegLiveness@ type; @regLiveness@ function}
 608 %*                                                                      *
 609 %************************************************************************
 610
 611 @regLiveness@ takes future liveness information and modifies it
 612 according to the semantics of branches and labels.  (An out-of-line
 613 branch clobbers the liveness passed back by the following instruction;
 614 a forward local branch passes back the liveness from the target label;
 615 a conditional branch merges the liveness from the target and the
 616 liveness from its successor; a label stashes away the current liveness
 617 in the future liveness environment).
 618
 619 \begin{code}
 620 data RegLiveness = RL RegSet FutureLive
 621
 622 regLiveness :: Instr -> RegLiveness -> RegLiveness
 623
 624 regLiveness instr info@(RL live future@(FL all env))
 625   = let
 626         lookup lbl
 627           = case (lookupFM env lbl) of
 628             Just rs -> rs
 629             Nothing -> pprTrace "Missing" (pprCLabel_asm lbl <+> text "in future?")
 630                        emptyRegSet
 631     in
 632     case instr of -- the rest is machine-specific...
 633
 634 #if alpha_TARGET_ARCH
 635
 636     -- We assume that all local jumps will be BI/BF.  JMP must be out-of-line.
 637
 638     BR (ImmCLbl lbl)     -> RL (lookup lbl) future
 639     BI _ _ (ImmCLbl lbl) -> RL (lookup lbl `unionRegSets` live) future
 640     BF _ _ (ImmCLbl lbl) -> RL (lookup lbl `unionRegSets` live) future
 641     JMP _ _ _            -> RL emptyRegSet future
 642     BSR _ _              -> RL live future
 643     JSR _ _ _            -> RL live future
 644     LABEL lbl            -> RL live (FL (all `unionRegSets` live) (addToFM env lbl live))
 645     _                    -> info
 646
 647 #endif {- alpha_TARGET_ARCH -}
 648 -- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
 649 #if i386_TARGET_ARCH
 650
 651     JXX _ lbl   -> RL (lookup lbl `unionRegSets` live) future
 652     JMP _       -> RL emptyRegSet future
 653     CALL _      -> RL live future
 654     LABEL lbl   -> RL live (FL (all `unionRegSets` live) (addToFM env lbl live))
 655     _               -> info
 656
 657 #endif {- i386_TARGET_ARCH -}
 658 -- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
 659 #if sparc_TARGET_ARCH
 660
 661     -- We assume that all local jumps will be BI/BF.  JMP must be out-of-line.
 662
 663     BI ALWAYS _ (ImmCLbl lbl)   -> RL (lookup lbl) future
 664     BI _ _ (ImmCLbl lbl)        -> RL (lookup lbl `unionRegSets` live) future
 665     BF ALWAYS _ (ImmCLbl lbl)   -> RL (lookup lbl) future
 666     BF _ _ (ImmCLbl lbl)        -> RL (lookup lbl `unionRegSets` live) future
 667     JMP _                       -> RL emptyRegSet future
 668     CALL _ i True   -> RL emptyRegSet future
 669     CALL _ i False  -> RL live future
 670     LABEL lbl       -> RL live (FL (all `unionRegSets` live) (addToFM env lbl live))
 671     _               -> info
 672
 673 #endif {- sparc_TARGET_ARCH -}
 674 \end{code}
 675
 676 %************************************************************************
 677 %*                                                                      *
 678 \subsection{@patchRegs@ function}
 679 %*                                                                      *
 680 %************************************************************************
 681
 682 @patchRegs@ takes an instruction (possibly with
 683 MemoryReg/UnmappedReg registers) and changes all register references
 684 according to the supplied environment.
 685
 686 \begin{code}
 687 patchRegs :: Instr -> (Reg -> Reg) -> Instr
 688
 689 #if alpha_TARGET_ARCH
 690
 691 patchRegs instr env = case instr of
 692     LD sz reg addr -> LD sz (env reg) (fixAddr addr)
 693     LDA reg addr -> LDA (env reg) (fixAddr addr)
 694     LDAH reg addr -> LDAH (env reg) (fixAddr addr)
 695     LDGP reg addr -> LDGP (env reg) (fixAddr addr)
 696     LDI sz reg imm -> LDI sz (env reg) imm
 697     ST sz reg addr -> ST sz (env reg) (fixAddr addr)
 698     CLR reg -> CLR (env reg)
 699     ABS sz ar reg -> ABS sz (fixRI ar) (env reg)
 700     NEG sz ov ar reg -> NEG sz ov (fixRI ar) (env reg)
 701     ADD sz ov r1 ar r2 -> ADD sz ov (env r1) (fixRI ar) (env r2)
 702     SADD sz sc r1 ar r2 -> SADD sz sc (env r1) (fixRI ar) (env r2)
 703     SUB sz ov r1 ar r2 -> SUB sz ov (env r1) (fixRI ar) (env r2)
 704     SSUB sz sc r1 ar r2 -> SSUB sz sc (env r1) (fixRI ar) (env r2)
 705     MUL sz ov r1 ar r2 -> MUL sz ov (env r1) (fixRI ar) (env r2)
 706     DIV sz un r1 ar r2 -> DIV sz un (env r1) (fixRI ar) (env r2)
 707     REM sz un r1 ar r2 -> REM sz un (env r1) (fixRI ar) (env r2)
 708     NOT ar reg -> NOT (fixRI ar) (env reg)
 709     AND r1 ar r2 -> AND (env r1) (fixRI ar) (env r2)
 710     ANDNOT r1 ar r2 -> ANDNOT (env r1) (fixRI ar) (env r2)
 711     OR r1 ar r2 -> OR (env r1) (fixRI ar) (env r2)
 712     ORNOT r1 ar r2 -> ORNOT (env r1) (fixRI ar) (env r2)
 713     XOR r1 ar r2 -> XOR (env r1) (fixRI ar) (env r2)
 714     XORNOT r1 ar r2 -> XORNOT (env r1) (fixRI ar) (env r2)
 715     SLL r1 ar r2 -> SLL (env r1) (fixRI ar) (env r2)
 716     SRL r1 ar r2 -> SRL (env r1) (fixRI ar) (env r2)
 717     SRA r1 ar r2 -> SRA (env r1) (fixRI ar) (env r2)
 718     ZAP r1 ar r2 -> ZAP (env r1) (fixRI ar) (env r2)
 719     ZAPNOT r1 ar r2 -> ZAPNOT (env r1) (fixRI ar) (env r2)
 720     CMP co r1 ar r2 -> CMP co (env r1) (fixRI ar) (env r2)
 721     FCLR reg -> FCLR (env reg)
 722     FABS r1 r2 -> FABS (env r1) (env r2)
 723     FNEG s r1 r2 -> FNEG s (env r1) (env r2)
 724     FADD s r1 r2 r3 -> FADD s (env r1) (env r2) (env r3)
 725     FDIV s r1 r2 r3 -> FDIV s (env r1) (env r2) (env r3)
 726     FMUL s r1 r2 r3 -> FMUL s (env r1) (env r2) (env r3)
 727     FSUB s r1 r2 r3 -> FSUB s (env r1) (env r2) (env r3)
 728     CVTxy s1 s2 r1 r2 -> CVTxy s1 s2 (env r1) (env r2)
 729     FCMP s co r1 r2 r3 -> FCMP s co (env r1) (env r2) (env r3)
 730     FMOV r1 r2 -> FMOV (env r1) (env r2)
 731     BI cond reg lbl -> BI cond (env reg) lbl
 732     BF cond reg lbl -> BF cond (env reg) lbl
 733     JMP reg addr hint -> JMP (env reg) (fixAddr addr) hint
 734     JSR reg addr i -> JSR (env reg) (fixAddr addr) i
 735     _ -> instr
 736   where
 737     fixAddr (AddrReg r1)       = AddrReg (env r1)
 738     fixAddr (AddrRegImm r1 i)  = AddrRegImm (env r1) i
 739     fixAddr other              = other
 740
 741     fixRI (RIReg r) = RIReg (env r)
 742     fixRI other = other
 743
 744 #endif {- alpha_TARGET_ARCH -}
 745 -- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
 746 #if i386_TARGET_ARCH
 747
 748 patchRegs instr env = case instr of
 749     MOV  sz src dst     -> patch2 (MOV  sz) src dst
 750     MOVZxL sz src dst   -> patch2 (MOVZxL sz) src dst
 751     MOVSxL sz src dst   -> patch2 (MOVSxL sz) src dst
 752     LEA  sz src dst     -> patch2 (LEA  sz) src dst
 753     ADD  sz src dst     -> patch2 (ADD  sz) src dst
 754     SUB  sz src dst     -> patch2 (SUB  sz) src dst
 755     IMUL sz src dst     -> patch2 (IMUL sz) src dst
 756     IDIV sz src         -> patch1 (IDIV sz) src
 757     AND  sz src dst     -> patch2 (AND  sz) src dst
 758     OR   sz src dst     -> patch2 (OR   sz) src dst
 759     XOR  sz src dst     -> patch2 (XOR  sz) src dst
 760     NOT  sz op          -> patch1 (NOT  sz) op
 761     NEGI sz op          -> patch1 (NEGI sz) op
 762     SHL  sz imm dst     -> patch1 (SHL sz imm) dst
 763     SAR  sz imm dst     -> patch1 (SAR sz imm) dst
 764     SHR  sz imm dst     -> patch1 (SHR sz imm) dst
 765     BT   sz imm src     -> patch1 (BT  sz imm) src
 766     TEST sz src dst     -> patch2 (TEST sz) src dst
 767     CMP  sz src dst     -> patch2 (CMP  sz) src dst
 768     PUSH sz op          -> patch1 (PUSH sz) op
 769     POP  sz op          -> patch1 (POP  sz) op
 770     SETCC cond op       -> patch1 (SETCC cond) op
 771     JMP op              -> patch1 JMP op
 772
 773     GMOV src dst        -> GMOV (env src) (env dst)
 774     GLD sz src dst      -> GLD sz (lookupAddr src) (env dst)
 775     GST sz src dst      -> GST sz (env src) (lookupAddr dst)
 776
 777     GLDZ dst            -> GLDZ (env dst)
 778     GLD1 dst            -> GLD1 (env dst)
 779
 780     GFTOD src dst       -> GFTOD (env src) (env dst)
 781     GFTOI src dst       -> GFTOI (env src) (env dst)
 782
 783     GDTOF src dst       -> GDTOF (env src) (env dst)
 784     GDTOI src dst       -> GDTOI (env src) (env dst)
 785
 786     GITOF src dst       -> GITOF (env src) (env dst)
 787     GITOD src dst       -> GITOD (env src) (env dst)
 788
 789     GADD sz s1 s2 dst   -> GADD sz (env s1) (env s2) (env dst)
 790     GSUB sz s1 s2 dst   -> GSUB sz (env s1) (env s2) (env dst)
 791     GMUL sz s1 s2 dst   -> GMUL sz (env s1) (env s2) (env dst)
 792     GDIV sz s1 s2 dst   -> GDIV sz (env s1) (env s2) (env dst)
 793
 794     GCMP sz src1 src2   -> GCMP sz (env src1) (env src2)
 795     GABS sz src dst     -> GABS sz (env src) (env dst)
 796     GNEG sz src dst     -> GNEG sz (env src) (env dst)
 797     GSQRT sz src dst    -> GSQRT sz (env src) (env dst)
 798     GSIN sz src dst     -> GSIN sz (env src) (env dst)
 799     GCOS sz src dst     -> GCOS sz (env src) (env dst)
 800     GTAN sz src dst     -> GTAN sz (env src) (env dst)
 801
 802     COMMENT _           -> instr
 803     SEGMENT _           -> instr
 804     LABEL _             -> instr
 805     ASCII _ _           -> instr
 806     DATA _ _            -> instr
 807     DELTA _             -> instr
 808     JXX _ _             -> instr
 809     CALL _              -> instr
 810     CLTD                -> instr
 811     _                   -> pprPanic "patchInstr(x86)" empty
 812
 813   where
 814     patch1 insn op      = insn (patchOp op)
 815     patch2 insn src dst = insn (patchOp src) (patchOp dst)
 816
 817     patchOp (OpReg  reg) = OpReg (env reg)
 818     patchOp (OpImm  imm) = OpImm imm
 819     patchOp (OpAddr ea)  = OpAddr (lookupAddr ea)
 820
 821     lookupAddr (ImmAddr imm off) = ImmAddr imm off
 822     lookupAddr (AddrBaseIndex base index disp)
 823       = AddrBaseIndex (lookupBase base) (lookupIndex index) disp
 824       where
 825         lookupBase Nothing       = Nothing
 826         lookupBase (Just r)      = Just (env r)
 827
 828         lookupIndex Nothing      = Nothing
 829         lookupIndex (Just (r,i)) = Just (env r, i)
 830
 831 #endif {- i386_TARGET_ARCH -}
 832 -- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
 833 #if sparc_TARGET_ARCH
 834
 835 patchRegs instr env = case instr of
 836     LD sz addr reg -> LD sz (fixAddr addr) (env reg)
 837     ST sz reg addr -> ST sz (env reg) (fixAddr addr)
 838     ADD x cc r1 ar r2 -> ADD x cc (env r1) (fixRI ar) (env r2)
 839     SUB x cc r1 ar r2 -> SUB x cc (env r1) (fixRI ar) (env r2)
 840     AND b r1 ar r2 -> AND b (env r1) (fixRI ar) (env r2)
 841     ANDN b r1 ar r2 -> ANDN b (env r1) (fixRI ar) (env r2)
 842     OR b r1 ar r2 -> OR b (env r1) (fixRI ar) (env r2)
 843     ORN b r1 ar r2 -> ORN b (env r1) (fixRI ar) (env r2)
 844     XOR b r1 ar r2 -> XOR b (env r1) (fixRI ar) (env r2)
 845     XNOR b r1 ar r2 -> XNOR b (env r1) (fixRI ar) (env r2)
 846     SLL r1 ar r2 -> SLL (env r1) (fixRI ar) (env r2)
 847     SRL r1 ar r2 -> SRL (env r1) (fixRI ar) (env r2)
 848     SRA r1 ar r2 -> SRA (env r1) (fixRI ar) (env r2)
 849     SETHI imm reg -> SETHI imm (env reg)
 850     FABS s r1 r2 -> FABS s (env r1) (env r2)
 851     FADD s r1 r2 r3 -> FADD s (env r1) (env r2) (env r3)
 852     FCMP e s r1 r2 -> FCMP e s (env r1) (env r2)
 853     FDIV s r1 r2 r3 -> FDIV s (env r1) (env r2) (env r3)
 854     FMOV s r1 r2 -> FMOV s (env r1) (env r2)
 855     FMUL s r1 r2 r3 -> FMUL s (env r1) (env r2) (env r3)
 856     FNEG s r1 r2 -> FNEG s (env r1) (env r2)
 857     FSQRT s r1 r2 -> FSQRT s (env r1) (env r2)
 858     FSUB s r1 r2 r3 -> FSUB s (env r1) (env r2) (env r3)
 859     FxTOy s1 s2 r1 r2 -> FxTOy s1 s2 (env r1) (env r2)
 860     JMP addr -> JMP (fixAddr addr)
 861     _ -> instr
 862   where
 863     fixAddr (AddrRegReg r1 r2) = AddrRegReg (env r1) (env r2)
 864     fixAddr (AddrRegImm r1 i)  = AddrRegImm (env r1) i
 865
 866     fixRI (RIReg r) = RIReg (env r)
 867     fixRI other = other
 868
 869 #endif {- sparc_TARGET_ARCH -}
 870 \end{code}
 871
 872 %************************************************************************
 873 %*                                                                      *
 874 \subsection{@spillReg@ and @loadReg@ functions}
 875 %*                                                                      *
 876 %************************************************************************
 877
 878 Spill to memory, and load it back...
 879
 880 JRS, 000122: on x86, don't spill directly above the stack pointer,
 881 since some insn sequences (int <-> conversions, and eventually
 882 StixInteger) use this as a temp location.  Leave 8 words (ie, 64 bytes
 883 for a 64-bit arch) of slop.
 884
 885 \begin{code}
 886 maxSpillSlots :: Int
 887 maxSpillSlots = (rESERVED_C_STACK_BYTES - 64) `div` 12
 888
 889 -- convert a spill slot number to a *byte* offset, with no sign:
 890 -- decide on a per arch basis whether you are spilling above or below
 891 -- the C stack pointer.
 892 spillSlotToOffset :: Int -> Int
 893 spillSlotToOffset slot
 894    | slot >= 0 && slot < maxSpillSlots
 895    = 64 + 12 * slot
 896    | otherwise
 897    = pprPanic "spillSlotToOffset:"
 898               (text "invalid spill location: " <> int slot)
 899
 900 spillReg, loadReg :: Int -> Reg -> Reg -> Instr
 901
 902 spillReg delta dyn (MemoryReg i pk)
 903   = let sz  = primRepToSize pk
 904         off = spillSlotToOffset i
 905     in
 906         {-Alpha: spill below the stack pointer (?)-}
 907          IF_ARCH_alpha( ST sz dyn (spRel (- (off `div` 8)))
 908
 909         {-I386: spill above stack pointer leaving 3 words/spill-}
 910         ,IF_ARCH_i386 ( let off_w = (off-delta) `div` 4
 911                         in
 912                         if pk == FloatRep || pk == DoubleRep
 913                         then GST F80 dyn (spRel off_w)
 914                         else MOV sz (OpReg dyn) (OpAddr (spRel off_w))
 915
 916         {-SPARC: spill below frame pointer leaving 2 words/spill-}
 917         ,IF_ARCH_sparc( ST sz dyn (fpRel (- (off `div` 4)))
 918         ,)))
 919
 920
 921 loadReg delta (MemoryReg i pk) dyn
 922   = let sz  = primRepToSize pk
 923         off = spillSlotToOffset i
 924     in
 925          IF_ARCH_alpha( LD  sz dyn (spRel (- (off `div` 8)))
 926         ,IF_ARCH_i386 ( let off_w = (off-delta) `div` 4
 927                         in
 928                         if   pk == FloatRep || pk == DoubleRep
 929                         then GLD F80 (spRel off_w) dyn
 930                         else MOV sz (OpAddr (spRel off_w)) (OpReg dyn)
 931         ,IF_ARCH_sparc( LD  sz (fpRel (- (off `div` 4))) dyn
 932         ,)))
 933 \end{code}