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