142ec6e65d00a944e90e622a253e43772849d083
[ghc.git] / compiler / nativeGen / SPARC / ShortcutJump.hs
1
2 {-# OPTIONS_GHC -fno-warn-tabs #-}
3 -- The above warning supression flag is a temporary kludge.
4 -- While working on this module you are encouraged to remove it and
5 -- detab the module (please do the detabbing in a separate patch). See
6 -- http://ghc.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#TabsvsSpaces
7 -- for details
8
9 module SPARC.ShortcutJump (
10 JumpDest(..), getJumpDestBlockId,
11 canShortcut,
12 shortcutJump,
13 shortcutStatics,
14 shortBlockId
15 )
16
17 where
18
19 import SPARC.Instr
20 import SPARC.Imm
21
22 import CLabel
23 import BlockId
24 import Cmm
25
26 import Panic
27 import Unique
28
29
30
31 data JumpDest
32 = DestBlockId BlockId
33 | DestImm Imm
34
35 getJumpDestBlockId :: JumpDest -> Maybe BlockId
36 getJumpDestBlockId (DestBlockId bid) = Just bid
37 getJumpDestBlockId _ = Nothing
38
39
40 canShortcut :: Instr -> Maybe JumpDest
41 canShortcut _ = Nothing
42
43
44 shortcutJump :: (BlockId -> Maybe JumpDest) -> Instr -> Instr
45 shortcutJump _ other = other
46
47
48
49 shortcutStatics :: (BlockId -> Maybe JumpDest) -> CmmStatics -> CmmStatics
50 shortcutStatics fn (Statics lbl statics)
51 = Statics lbl $ map (shortcutStatic fn) statics
52 -- we need to get the jump tables, so apply the mapping to the entries
53 -- of a CmmData too.
54
55 shortcutLabel :: (BlockId -> Maybe JumpDest) -> CLabel -> CLabel
56 shortcutLabel fn lab
57 | Just uq <- maybeAsmTemp lab = shortBlockId fn (mkBlockId uq)
58 | otherwise = lab
59
60 shortcutStatic :: (BlockId -> Maybe JumpDest) -> CmmStatic -> CmmStatic
61 shortcutStatic fn (CmmStaticLit (CmmLabel lab))
62 = CmmStaticLit (CmmLabel (shortcutLabel fn lab))
63 shortcutStatic fn (CmmStaticLit (CmmLabelDiffOff lbl1 lbl2 off))
64 = CmmStaticLit (CmmLabelDiffOff (shortcutLabel fn lbl1) lbl2 off)
65 -- slightly dodgy, we're ignoring the second label, but this
66 -- works with the way we use CmmLabelDiffOff for jump tables now.
67 shortcutStatic _ other_static
68 = other_static
69
70
71 shortBlockId :: (BlockId -> Maybe JumpDest) -> BlockId -> CLabel
72 shortBlockId fn blockid =
73 case fn blockid of
74 Nothing -> mkAsmTempLabel (getUnique blockid)
75 Just (DestBlockId blockid') -> shortBlockId fn blockid'
76 Just (DestImm (ImmCLbl lbl)) -> lbl
77 _other -> panic "shortBlockId"
78
79
80