719d76c3161094c3bfb9cf7f0b5f9b2327a8341c
[ghc.git] / 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"