compiler/nativeGen/PPC/RegInfo.hs

   1 -----------------------------------------------------------------------------
   2 --
   3 -- Machine-specific parts of the register allocator
   4 --
   5 -- (c) The University of Glasgow 1996-2004
   6 --
   7 -----------------------------------------------------------------------------
   8
   9 module PPC.RegInfo (
  10         mkVReg,
  11
  12         JumpDest,
  13         canShortcut,
  14         shortcutJump,
  15
  16         shortcutStatic,
  17         regDotColor
  18 )
  19
  20 where
  21
  22 #include "nativeGen/NCG.h"
  23 #include "HsVersions.h"
  24
  25 import PPC.Regs
  26 import PPC.Instr
  27 import RegClass
  28 import Reg
  29 import Size
  30
  31 import BlockId
  32 import Cmm
  33 import CLabel
  34
  35 import Outputable
  36 import Unique
  37
  38 mkVReg :: Unique -> Size -> Reg
  39 mkVReg u size
  40    | not (isFloatSize size) = RegVirtual $ VirtualRegI u
  41    | otherwise
  42    = case size of
  43         FF32    -> RegVirtual $ VirtualRegD u
  44         FF64    -> RegVirtual $ VirtualRegD u
  45         _       -> panic "mkVReg"
  46
  47
  48
  49
  50 data JumpDest = DestBlockId BlockId | DestImm Imm
  51
  52 canShortcut :: Instr -> Maybe JumpDest
  53 canShortcut _ = Nothing
  54
  55 shortcutJump :: (BlockId -> Maybe JumpDest) -> Instr -> Instr
  56 shortcutJump _ other = other
  57
  58
  59 -- Here because it knows about JumpDest
  60 shortcutStatic :: (BlockId -> Maybe JumpDest) -> CmmStatic -> CmmStatic
  61
  62 shortcutStatic fn (CmmStaticLit (CmmLabel lab))
  63   | Just uq <- maybeAsmTemp lab
  64   = CmmStaticLit (CmmLabel (shortBlockId fn (BlockId uq)))
  65
  66 shortcutStatic fn (CmmStaticLit (CmmLabelDiffOff lbl1 lbl2 off))
  67   | Just uq <- maybeAsmTemp lbl1
  68   = CmmStaticLit (CmmLabelDiffOff (shortBlockId fn (BlockId uq)) lbl2 off)
  69         -- slightly dodgy, we're ignoring the second label, but this
  70         -- works with the way we use CmmLabelDiffOff for jump tables now.
  71
  72 shortcutStatic _ other_static
  73         = other_static
  74
  75 shortBlockId
  76         :: (BlockId -> Maybe JumpDest)
  77         -> BlockId
  78         -> CLabel
  79
  80 shortBlockId fn blockid@(BlockId uq) =
  81    case fn blockid of
  82       Nothing -> mkAsmTempLabel uq
  83       Just (DestBlockId blockid')  -> shortBlockId fn blockid'
  84       Just (DestImm (ImmCLbl lbl)) -> lbl
  85       _other -> panic "shortBlockId"
  86
  87
  88
  89 regDotColor :: Reg -> SDoc
  90 regDotColor reg
  91  = case regClass reg of
  92         RcInteger       -> text "blue"
  93         RcFloat         -> text "red"
  94         RcDouble        -> text "green"