compiler/nativeGen/X86/RegInfo.hs

   1
   2 module X86.RegInfo (
   3         RegUsage(..),
   4         noUsage,
   5         regUsage,
   6         patchRegs,
   7         jumpDests,
   8         isJumpish,
   9         patchJump,
  10         isRegRegMove,
  11
  12         JumpDest,
  13         canShortcut,
  14         shortcutJump,
  15
  16         mkSpillInstr,
  17         mkLoadInstr,
  18         mkRegRegMoveInstr,
  19         mkBranchInstr,
  20
  21         spillSlotSize,
  22         maxSpillSlots,
  23         spillSlotToOffset
  24 )
  25
  26 where
  27
  28 #include "nativeGen/NCG.h"
  29 #include "HsVersions.h"
  30
  31 import X86.Instr
  32 import X86.Regs
  33 import RegsBase
  34
  35 import BlockId
  36 import Outputable
  37 import Constants        ( rESERVED_C_STACK_BYTES )
  38 import FastBool
  39
  40
  41 -- -----------------------------------------------------------------------------
  42 -- RegUsage type
  43
  44 -- @regUsage@ returns the sets of src and destination registers used
  45 -- by a particular instruction.  Machine registers that are
  46 -- pre-allocated to stgRegs are filtered out, because they are
  47 -- uninteresting from a register allocation standpoint.  (We wouldn't
  48 -- want them to end up on the free list!)  As far as we are concerned,
  49 -- the fixed registers simply don't exist (for allocation purposes,
  50 -- anyway).
  51
  52 -- regUsage doesn't need to do any trickery for jumps and such.  Just
  53 -- state precisely the regs read and written by that insn.  The
  54 -- consequences of control flow transfers, as far as register
  55 -- allocation goes, are taken care of by the register allocator.
  56
  57 data RegUsage = RU [Reg] [Reg]
  58
  59 noUsage :: RegUsage
  60 noUsage  = RU [] []
  61
  62
  63 regUsage :: Instr -> RegUsage
  64 regUsage instr = case instr of
  65     MOV    _ src dst    -> usageRW src dst
  66     MOVZxL _ src dst    -> usageRW src dst
  67     MOVSxL _ src dst    -> usageRW src dst
  68     LEA    _ src dst    -> usageRW src dst
  69     ADD    _ src dst    -> usageRM src dst
  70     ADC    _ src dst    -> usageRM src dst
  71     SUB    _ src dst    -> usageRM src dst
  72     IMUL   _ src dst    -> usageRM src dst
  73     IMUL2  _ src       -> mkRU (eax:use_R src) [eax,edx]
  74     MUL    _ src dst    -> usageRM src dst
  75     DIV    _ op -> mkRU (eax:edx:use_R op) [eax,edx]
  76     IDIV   _ op -> mkRU (eax:edx:use_R op) [eax,edx]
  77     AND    _ src dst    -> usageRM src dst
  78     OR     _ src dst    -> usageRM src dst
  79
  80     XOR    _ (OpReg src) (OpReg dst)
  81         | src == dst    -> mkRU [] [dst]
  82
  83     XOR    _ src dst    -> usageRM src dst
  84     NOT    _ op         -> usageM op
  85     NEGI   _ op         -> usageM op
  86     SHL    _ imm dst    -> usageRM imm dst
  87     SAR    _ imm dst    -> usageRM imm dst
  88     SHR    _ imm dst    -> usageRM imm dst
  89     BT     _ _   src    -> mkRUR (use_R src)
  90
  91     PUSH   _ op         -> mkRUR (use_R op)
  92     POP    _ op         -> mkRU [] (def_W op)
  93     TEST   _ src dst    -> mkRUR (use_R src ++ use_R dst)
  94     CMP    _ src dst    -> mkRUR (use_R src ++ use_R dst)
  95     SETCC  _ op         -> mkRU [] (def_W op)
  96     JXX    _ _          -> mkRU [] []
  97     JXX_GBL _ _         -> mkRU [] []
  98     JMP     op          -> mkRUR (use_R op)
  99     JMP_TBL op _        -> mkRUR (use_R op)
 100     CALL (Left _)  params   -> mkRU params callClobberedRegs
 101     CALL (Right reg) params -> mkRU (reg:params) callClobberedRegs
 102     CLTD   _            -> mkRU [eax] [edx]
 103     NOP                 -> mkRU [] []
 104
 105 #if i386_TARGET_ARCH
 106     GMOV   src dst      -> mkRU [src] [dst]
 107     GLD    _ src dst    -> mkRU (use_EA src) [dst]
 108     GST    _ src dst    -> mkRUR (src : use_EA dst)
 109
 110     GLDZ   dst          -> mkRU [] [dst]
 111     GLD1   dst          -> mkRU [] [dst]
 112
 113     GFTOI  src dst      -> mkRU [src] [dst]
 114     GDTOI  src dst      -> mkRU [src] [dst]
 115
 116     GITOF  src dst      -> mkRU [src] [dst]
 117     GITOD  src dst      -> mkRU [src] [dst]
 118
 119     GADD   _ s1 s2 dst  -> mkRU [s1,s2] [dst]
 120     GSUB   _ s1 s2 dst  -> mkRU [s1,s2] [dst]
 121     GMUL   _ s1 s2 dst  -> mkRU [s1,s2] [dst]
 122     GDIV   _ s1 s2 dst  -> mkRU [s1,s2] [dst]
 123
 124     GCMP   _ src1 src2   -> mkRUR [src1,src2]
 125     GABS   _ src dst     -> mkRU [src] [dst]
 126     GNEG   _ src dst     -> mkRU [src] [dst]
 127     GSQRT  _ src dst     -> mkRU [src] [dst]
 128     GSIN   _ _ _ src dst -> mkRU [src] [dst]
 129     GCOS   _ _ _ src dst -> mkRU [src] [dst]
 130     GTAN   _ _ _ src dst -> mkRU [src] [dst]
 131 #endif
 132
 133 #if x86_64_TARGET_ARCH
 134     CVTSS2SD   src dst  -> mkRU [src] [dst]
 135     CVTSD2SS   src dst  -> mkRU [src] [dst]
 136     CVTTSS2SIQ src dst  -> mkRU (use_R src) [dst]
 137     CVTTSD2SIQ src dst  -> mkRU (use_R src) [dst]
 138     CVTSI2SS   src dst  -> mkRU (use_R src) [dst]
 139     CVTSI2SD   src dst  -> mkRU (use_R src) [dst]
 140     FDIV _     src dst  -> usageRM src dst
 141 #endif
 142
 143     FETCHGOT reg        -> mkRU [] [reg]
 144     FETCHPC  reg        -> mkRU [] [reg]
 145
 146     COMMENT _           -> noUsage
 147     DELTA   _           -> noUsage
 148     SPILL   reg _       -> mkRU [reg] []
 149     RELOAD  _  reg      -> mkRU []    [reg]
 150
 151     _other              -> panic "regUsage: unrecognised instr"
 152
 153  where
 154     -- 2 operand form; first operand Read; second Written
 155     usageRW :: Operand -> Operand -> RegUsage
 156     usageRW op (OpReg reg)      = mkRU (use_R op) [reg]
 157     usageRW op (OpAddr ea)      = mkRUR (use_R op ++ use_EA ea)
 158     usageRW _ _                 = panic "X86.RegInfo.usageRW: no match"
 159
 160     -- 2 operand form; first operand Read; second Modified
 161     usageRM :: Operand -> Operand -> RegUsage
 162     usageRM op (OpReg reg)      = mkRU (use_R op ++ [reg]) [reg]
 163     usageRM op (OpAddr ea)      = mkRUR (use_R op ++ use_EA ea)
 164     usageRM _ _                 = panic "X86.RegInfo.usageRM: no match"
 165
 166     -- 1 operand form; operand Modified
 167     usageM :: Operand -> RegUsage
 168     usageM (OpReg reg)          = mkRU [reg] [reg]
 169     usageM (OpAddr ea)          = mkRUR (use_EA ea)
 170     usageM _                    = panic "X86.RegInfo.usageM: no match"
 171
 172     -- Registers defd when an operand is written.
 173     def_W (OpReg reg)           = [reg]
 174     def_W (OpAddr _ )           = []
 175     def_W _                     = panic "X86.RegInfo.def_W: no match"
 176
 177     -- Registers used when an operand is read.
 178     use_R (OpReg reg)  = [reg]
 179     use_R (OpImm _)    = []
 180     use_R (OpAddr ea)  = use_EA ea
 181
 182     -- Registers used to compute an effective address.
 183     use_EA (ImmAddr _ _) = []
 184     use_EA (AddrBaseIndex base index _) =
 185         use_base base $! use_index index
 186         where use_base (EABaseReg r) x = r : x
 187               use_base _ x             = x
 188               use_index EAIndexNone   = []
 189               use_index (EAIndex i _) = [i]
 190
 191     mkRUR src = src' `seq` RU src' []
 192         where src' = filter interesting src
 193
 194     mkRU src dst = src' `seq` dst' `seq` RU src' dst'
 195         where src' = filter interesting src
 196               dst' = filter interesting dst
 197
 198 interesting :: Reg -> Bool
 199 interesting (VirtualRegI  _)  = True
 200 interesting (VirtualRegHi _)  = True
 201 interesting (VirtualRegF  _)  = True
 202 interesting (VirtualRegD  _)  = True
 203 interesting (RealReg i)       = isFastTrue (freeReg i)
 204
 205
 206
 207
 208 -- -----------------------------------------------------------------------------
 209 -- 'patchRegs' function
 210
 211 -- 'patchRegs' takes an instruction and applies the given mapping to
 212 -- all the register references.
 213
 214 patchRegs :: Instr -> (Reg -> Reg) -> Instr
 215 patchRegs instr env = case instr of
 216     MOV  sz src dst     -> patch2 (MOV  sz) src dst
 217     MOVZxL sz src dst   -> patch2 (MOVZxL sz) src dst
 218     MOVSxL sz src dst   -> patch2 (MOVSxL sz) src dst
 219     LEA  sz src dst     -> patch2 (LEA  sz) src dst
 220     ADD  sz src dst     -> patch2 (ADD  sz) src dst
 221     ADC  sz src dst     -> patch2 (ADC  sz) src dst
 222     SUB  sz src dst     -> patch2 (SUB  sz) src dst
 223     IMUL sz src dst     -> patch2 (IMUL sz) src dst
 224     IMUL2 sz src        -> patch1 (IMUL2 sz) src
 225     MUL sz src dst      -> patch2 (MUL sz) src dst
 226     IDIV sz op          -> patch1 (IDIV sz) op
 227     DIV sz op           -> patch1 (DIV sz) op
 228     AND  sz src dst     -> patch2 (AND  sz) src dst
 229     OR   sz src dst     -> patch2 (OR   sz) src dst
 230     XOR  sz src dst     -> patch2 (XOR  sz) src dst
 231     NOT  sz op          -> patch1 (NOT  sz) op
 232     NEGI sz op          -> patch1 (NEGI sz) op
 233     SHL  sz imm dst     -> patch1 (SHL sz imm) dst
 234     SAR  sz imm dst     -> patch1 (SAR sz imm) dst
 235     SHR  sz imm dst     -> patch1 (SHR sz imm) dst
 236     BT   sz imm src     -> patch1 (BT  sz imm) src
 237     TEST sz src dst     -> patch2 (TEST sz) src dst
 238     CMP  sz src dst     -> patch2 (CMP  sz) src dst
 239     PUSH sz op          -> patch1 (PUSH sz) op
 240     POP  sz op          -> patch1 (POP  sz) op
 241     SETCC cond op       -> patch1 (SETCC cond) op
 242     JMP op              -> patch1 JMP op
 243     JMP_TBL op ids      -> patch1 JMP_TBL op $ ids
 244
 245 #if i386_TARGET_ARCH
 246     GMOV src dst        -> GMOV (env src) (env dst)
 247     GLD  sz src dst     -> GLD sz (lookupAddr src) (env dst)
 248     GST  sz src dst     -> GST sz (env src) (lookupAddr dst)
 249
 250     GLDZ dst            -> GLDZ (env dst)
 251     GLD1 dst            -> GLD1 (env dst)
 252
 253     GFTOI src dst       -> GFTOI (env src) (env dst)
 254     GDTOI src dst       -> GDTOI (env src) (env dst)
 255
 256     GITOF src dst       -> GITOF (env src) (env dst)
 257     GITOD src dst       -> GITOD (env src) (env dst)
 258
 259     GADD sz s1 s2 dst   -> GADD sz (env s1) (env s2) (env dst)
 260     GSUB sz s1 s2 dst   -> GSUB sz (env s1) (env s2) (env dst)
 261     GMUL sz s1 s2 dst   -> GMUL sz (env s1) (env s2) (env dst)
 262     GDIV sz s1 s2 dst   -> GDIV sz (env s1) (env s2) (env dst)
 263
 264     GCMP sz src1 src2   -> GCMP sz (env src1) (env src2)
 265     GABS sz src dst     -> GABS sz (env src) (env dst)
 266     GNEG sz src dst     -> GNEG sz (env src) (env dst)
 267     GSQRT sz src dst    -> GSQRT sz (env src) (env dst)
 268     GSIN sz l1 l2 src dst       -> GSIN sz l1 l2 (env src) (env dst)
 269     GCOS sz l1 l2 src dst       -> GCOS sz l1 l2 (env src) (env dst)
 270     GTAN sz l1 l2 src dst       -> GTAN sz l1 l2 (env src) (env dst)
 271 #endif
 272
 273 #if x86_64_TARGET_ARCH
 274     CVTSS2SD src dst    -> CVTSS2SD (env src) (env dst)
 275     CVTSD2SS src dst    -> CVTSD2SS (env src) (env dst)
 276     CVTTSS2SIQ src dst  -> CVTTSS2SIQ (patchOp src) (env dst)
 277     CVTTSD2SIQ src dst  -> CVTTSD2SIQ (patchOp src) (env dst)
 278     CVTSI2SS src dst    -> CVTSI2SS (patchOp src) (env dst)
 279     CVTSI2SD src dst    -> CVTSI2SD (patchOp src) (env dst)
 280     FDIV sz src dst     -> FDIV sz (patchOp src) (patchOp dst)
 281 #endif
 282
 283     CALL (Left _)  _    -> instr
 284     CALL (Right reg) p  -> CALL (Right (env reg)) p
 285
 286     FETCHGOT reg        -> FETCHGOT (env reg)
 287     FETCHPC  reg        -> FETCHPC  (env reg)
 288
 289     NOP                 -> instr
 290     COMMENT _           -> instr
 291     DELTA _             -> instr
 292     SPILL  reg slot     -> SPILL (env reg) slot
 293     RELOAD slot reg     -> RELOAD slot (env reg)
 294
 295     JXX _ _             -> instr
 296     JXX_GBL _ _         -> instr
 297     CLTD _              -> instr
 298
 299     _other              -> panic "patchRegs: unrecognised instr"
 300
 301   where
 302     patch1 insn op      = insn $! patchOp op
 303     patch2 insn src dst = (insn $! patchOp src) $! patchOp dst
 304
 305     patchOp (OpReg  reg) = OpReg $! env reg
 306     patchOp (OpImm  imm) = OpImm imm
 307     patchOp (OpAddr ea)  = OpAddr $! lookupAddr ea
 308
 309     lookupAddr (ImmAddr imm off) = ImmAddr imm off
 310     lookupAddr (AddrBaseIndex base index disp)
 311       = ((AddrBaseIndex $! lookupBase base) $! lookupIndex index) disp
 312       where
 313         lookupBase EABaseNone       = EABaseNone
 314         lookupBase EABaseRip        = EABaseRip
 315         lookupBase (EABaseReg r)    = EABaseReg (env r)
 316
 317         lookupIndex EAIndexNone     = EAIndexNone
 318         lookupIndex (EAIndex r i)   = EAIndex (env r) i
 319
 320
 321 -- -----------------------------------------------------------------------------
 322 -- Determine the possible destinations from the current instruction.
 323
 324 -- (we always assume that the next instruction is also a valid destination;
 325 -- if this isn't the case then the jump should be at the end of the basic
 326 -- block).
 327
 328 jumpDests :: Instr -> [BlockId] -> [BlockId]
 329 jumpDests insn acc
 330   = case insn of
 331         JXX _ id        -> id : acc
 332         JMP_TBL _ ids   -> ids ++ acc
 333         _               -> acc
 334
 335
 336 isJumpish :: Instr -> Bool
 337 isJumpish instr
 338  = case instr of
 339         JMP{}           -> True
 340         JXX{}           -> True
 341         JXX_GBL{}       -> True
 342         JMP_TBL{}       -> True
 343         CALL{}          -> True
 344         _               -> False
 345
 346 -- | Change the destination of this jump instruction
 347 --      Used in joinToTargets in the linear allocator, when emitting fixup code
 348 --      for join points.
 349 patchJump :: Instr -> BlockId -> BlockId -> Instr
 350 patchJump insn old new
 351   = case insn of
 352         JXX cc id | id == old -> JXX cc new
 353         JMP_TBL _ _     -> error "Cannot patch JMP_TBL"
 354         _other          -> insn
 355
 356
 357 -- -----------------------------------------------------------------------------
 358 -- Detecting reg->reg moves
 359
 360 -- The register allocator attempts to eliminate reg->reg moves whenever it can,
 361 -- by assigning the src and dest temporaries to the same real register.
 362
 363 isRegRegMove :: Instr -> Maybe (Reg,Reg)
 364 isRegRegMove (MOV _ (OpReg r1) (OpReg r2)) = Just (r1,r2)
 365 isRegRegMove _  = Nothing
 366
 367
 368
 369 data JumpDest = DestBlockId BlockId | DestImm Imm
 370
 371
 372 canShortcut :: Instr -> Maybe JumpDest
 373 canShortcut (JXX ALWAYS id)     = Just (DestBlockId id)
 374 canShortcut (JMP (OpImm imm))   = Just (DestImm imm)
 375 canShortcut _                   = Nothing
 376
 377
 378 shortcutJump :: (BlockId -> Maybe JumpDest) -> Instr -> Instr
 379 shortcutJump fn insn@(JXX cc id) =
 380   case fn id of
 381     Nothing                -> insn
 382     Just (DestBlockId id') -> shortcutJump fn (JXX cc id')
 383     Just (DestImm imm)     -> shortcutJump fn (JXX_GBL cc imm)
 384
 385 shortcutJump _ other = other
 386
 387
 388
 389 -- -----------------------------------------------------------------------------
 390 -- Generating spill instructions
 391
 392 mkSpillInstr
 393    :: Reg               -- register to spill
 394    -> Int               -- current stack delta
 395    -> Int               -- spill slot to use
 396    -> Instr
 397
 398 #if   i386_TARGET_ARCH
 399 mkSpillInstr reg delta slot
 400   = let off     = spillSlotToOffset slot
 401     in
 402     let off_w = (off-delta) `div` 4
 403     in case regClass reg of
 404            RcInteger -> MOV II32 (OpReg reg) (OpAddr (spRel off_w))
 405            _         -> GST FF80 reg (spRel off_w) {- RcFloat/RcDouble -}
 406
 407 #elif x86_64_TARGET_ARCH
 408 mkSpillInstr reg delta slot
 409   = let off     = spillSlotToOffset slot
 410     in
 411     let off_w = (off-delta) `div` 8
 412     in case regClass reg of
 413            RcInteger -> MOV II64 (OpReg reg) (OpAddr (spRel off_w))
 414            RcDouble  -> MOV FF64 (OpReg reg) (OpAddr (spRel off_w))
 415                 -- ToDo: will it work to always spill as a double?
 416                 -- does that cause a stall if the data was a float?
 417 #else
 418 mkSpillInstr _ _ _
 419     =   panic "X86.RegInfo.mkSpillInstr: not defined for this architecture."
 420 #endif
 421
 422
 423 mkLoadInstr
 424    :: Reg               -- register to load
 425    -> Int               -- current stack delta
 426    -> Int               -- spill slot to use
 427    -> Instr
 428 #if   i386_TARGET_ARCH
 429 mkLoadInstr reg delta slot
 430   = let off     = spillSlotToOffset slot
 431     in
 432         let off_w = (off-delta) `div` 4
 433         in case regClass reg of {
 434               RcInteger -> MOV II32 (OpAddr (spRel off_w)) (OpReg reg);
 435               _         -> GLD FF80 (spRel off_w) reg} {- RcFloat/RcDouble -}
 436 #elif x86_64_TARGET_ARCH
 437 mkLoadInstr reg delta slot
 438   = let off     = spillSlotToOffset slot
 439     in
 440         let off_w = (off-delta) `div` 8
 441         in case regClass reg of
 442               RcInteger -> MOV II64 (OpAddr (spRel off_w)) (OpReg reg)
 443               _         -> MOV FF64 (OpAddr (spRel off_w)) (OpReg reg)
 444 #else
 445 mkLoadInstr _ _ _
 446   =    panic "X86.RegInfo.mkLoadInstr: not defined for this architecture."
 447 #endif
 448
 449
 450
 451 mkRegRegMoveInstr
 452     :: Reg
 453     -> Reg
 454     -> Instr
 455 mkRegRegMoveInstr src dst
 456     = case regClass src of
 457         RcInteger -> MOV wordSize (OpReg src) (OpReg dst)
 458 #if   i386_TARGET_ARCH
 459         RcDouble  -> GMOV src dst
 460 #else
 461         RcDouble  -> MOV FF64 (OpReg src) (OpReg dst)
 462         RcFloat   -> panic "X86.RegInfo.mkRegRegMoveInstr: no match"
 463 #endif
 464
 465
 466 mkBranchInstr
 467     :: BlockId
 468     -> [Instr]
 469
 470 mkBranchInstr id = [JXX ALWAYS id]
 471
 472
 473 spillSlotSize :: Int
 474 spillSlotSize = IF_ARCH_i386(12, 8)
 475
 476 maxSpillSlots :: Int
 477 maxSpillSlots = ((rESERVED_C_STACK_BYTES - 64) `div` spillSlotSize) - 1
 478
 479 -- convert a spill slot number to a *byte* offset, with no sign:
 480 -- decide on a per arch basis whether you are spilling above or below
 481 -- the C stack pointer.
 482 spillSlotToOffset :: Int -> Int
 483 spillSlotToOffset slot
 484    | slot >= 0 && slot < maxSpillSlots
 485    = 64 + spillSlotSize * slot
 486    | otherwise
 487    = pprPanic "spillSlotToOffset:"
 488               (   text "invalid spill location: " <> int slot
 489               $$  text "maxSpillSlots:          " <> int maxSpillSlots)