Revert "Add new mbmi and mbmi2 compiler flags"
[ghc.git] / compiler / cmm / PprCmmExpr.hs
1 ----------------------------------------------------------------------------
2 --
3 -- Pretty-printing of common Cmm types
4 --
5 -- (c) The University of Glasgow 2004-2006
6 --
7 -----------------------------------------------------------------------------
8
9 --
10 -- This is where we walk over Cmm emitting an external representation,
11 -- suitable for parsing, in a syntax strongly reminiscent of C--. This
12 -- is the "External Core" for the Cmm layer.
13 --
14 -- As such, this should be a well-defined syntax: we want it to look nice.
15 -- Thus, we try wherever possible to use syntax defined in [1],
16 -- "The C-- Reference Manual", http://www.cminusminus.org/. We differ
17 -- slightly, in some cases. For one, we use I8 .. I64 for types, rather
18 -- than C--'s bits8 .. bits64.
19 --
20 -- We try to ensure that all information available in the abstract
21 -- syntax is reproduced, or reproducible, in the concrete syntax.
22 -- Data that is not in printed out can be reconstructed according to
23 -- conventions used in the pretty printer. There are at least two such
24 -- cases:
25 -- 1) if a value has wordRep type, the type is not appended in the
26 -- output.
27 -- 2) MachOps that operate over wordRep type are printed in a
28 -- C-style, rather than as their internal MachRep name.
29 --
30 -- These conventions produce much more readable Cmm output.
31 --
32 -- A useful example pass over Cmm is in nativeGen/MachCodeGen.hs
33 --
34
35 {-# OPTIONS_GHC -fno-warn-orphans #-}
36 module PprCmmExpr
37 ( pprExpr, pprLit
38 )
39 where
40
41 import GhcPrelude
42
43 import CmmExpr
44
45 import Outputable
46
47 import Data.Maybe
48 import Numeric ( fromRat )
49
50 -----------------------------------------------------------------------------
51
52 instance Outputable CmmExpr where
53 ppr e = pprExpr e
54
55 instance Outputable CmmReg where
56 ppr e = pprReg e
57
58 instance Outputable CmmLit where
59 ppr l = pprLit l
60
61 instance Outputable LocalReg where
62 ppr e = pprLocalReg e
63
64 instance Outputable Area where
65 ppr e = pprArea e
66
67 instance Outputable GlobalReg where
68 ppr e = pprGlobalReg e
69
70 -- --------------------------------------------------------------------------
71 -- Expressions
72 --
73
74 pprExpr :: CmmExpr -> SDoc
75 pprExpr e
76 = sdocWithDynFlags $ \dflags ->
77 case e of
78 CmmRegOff reg i ->
79 pprExpr (CmmMachOp (MO_Add rep)
80 [CmmReg reg, CmmLit (CmmInt (fromIntegral i) rep)])
81 where rep = typeWidth (cmmRegType dflags reg)
82 CmmLit lit -> pprLit lit
83 _other -> pprExpr1 e
84
85 -- Here's the precedence table from CmmParse.y:
86 -- %nonassoc '>=' '>' '<=' '<' '!=' '=='
87 -- %left '|'
88 -- %left '^'
89 -- %left '&'
90 -- %left '>>' '<<'
91 -- %left '-' '+'
92 -- %left '/' '*' '%'
93 -- %right '~'
94
95 -- We just cope with the common operators for now, the rest will get
96 -- a default conservative behaviour.
97
98 -- %nonassoc '>=' '>' '<=' '<' '!=' '=='
99 pprExpr1, pprExpr7, pprExpr8 :: CmmExpr -> SDoc
100 pprExpr1 (CmmMachOp op [x,y]) | Just doc <- infixMachOp1 op
101 = pprExpr7 x <+> doc <+> pprExpr7 y
102 pprExpr1 e = pprExpr7 e
103
104 infixMachOp1, infixMachOp7, infixMachOp8 :: MachOp -> Maybe SDoc
105
106 infixMachOp1 (MO_Eq _) = Just (text "==")
107 infixMachOp1 (MO_Ne _) = Just (text "!=")
108 infixMachOp1 (MO_Shl _) = Just (text "<<")
109 infixMachOp1 (MO_U_Shr _) = Just (text ">>")
110 infixMachOp1 (MO_U_Ge _) = Just (text ">=")
111 infixMachOp1 (MO_U_Le _) = Just (text "<=")
112 infixMachOp1 (MO_U_Gt _) = Just (char '>')
113 infixMachOp1 (MO_U_Lt _) = Just (char '<')
114 infixMachOp1 _ = Nothing
115
116 -- %left '-' '+'
117 pprExpr7 (CmmMachOp (MO_Add rep1) [x, CmmLit (CmmInt i rep2)]) | i < 0
118 = pprExpr7 (CmmMachOp (MO_Sub rep1) [x, CmmLit (CmmInt (negate i) rep2)])
119 pprExpr7 (CmmMachOp op [x,y]) | Just doc <- infixMachOp7 op
120 = pprExpr7 x <+> doc <+> pprExpr8 y
121 pprExpr7 e = pprExpr8 e
122
123 infixMachOp7 (MO_Add _) = Just (char '+')
124 infixMachOp7 (MO_Sub _) = Just (char '-')
125 infixMachOp7 _ = Nothing
126
127 -- %left '/' '*' '%'
128 pprExpr8 (CmmMachOp op [x,y]) | Just doc <- infixMachOp8 op
129 = pprExpr8 x <+> doc <+> pprExpr9 y
130 pprExpr8 e = pprExpr9 e
131
132 infixMachOp8 (MO_U_Quot _) = Just (char '/')
133 infixMachOp8 (MO_Mul _) = Just (char '*')
134 infixMachOp8 (MO_U_Rem _) = Just (char '%')
135 infixMachOp8 _ = Nothing
136
137 pprExpr9 :: CmmExpr -> SDoc
138 pprExpr9 e =
139 case e of
140 CmmLit lit -> pprLit1 lit
141 CmmLoad expr rep -> ppr rep <> brackets (ppr expr)
142 CmmReg reg -> ppr reg
143 CmmRegOff reg off -> parens (ppr reg <+> char '+' <+> int off)
144 CmmStackSlot a off -> parens (ppr a <+> char '+' <+> int off)
145 CmmMachOp mop args -> genMachOp mop args
146
147 genMachOp :: MachOp -> [CmmExpr] -> SDoc
148 genMachOp mop args
149 | Just doc <- infixMachOp mop = case args of
150 -- dyadic
151 [x,y] -> pprExpr9 x <+> doc <+> pprExpr9 y
152
153 -- unary
154 [x] -> doc <> pprExpr9 x
155
156 _ -> pprTrace "PprCmm.genMachOp: machop with strange number of args"
157 (pprMachOp mop <+>
158 parens (hcat $ punctuate comma (map pprExpr args)))
159 empty
160
161 | isJust (infixMachOp1 mop)
162 || isJust (infixMachOp7 mop)
163 || isJust (infixMachOp8 mop) = parens (pprExpr (CmmMachOp mop args))
164
165 | otherwise = char '%' <> ppr_op <> parens (commafy (map pprExpr args))
166 where ppr_op = text (map (\c -> if c == ' ' then '_' else c)
167 (show mop))
168 -- replace spaces in (show mop) with underscores,
169
170 --
171 -- Unsigned ops on the word size of the machine get nice symbols.
172 -- All else get dumped in their ugly format.
173 --
174 infixMachOp :: MachOp -> Maybe SDoc
175 infixMachOp mop
176 = case mop of
177 MO_And _ -> Just $ char '&'
178 MO_Or _ -> Just $ char '|'
179 MO_Xor _ -> Just $ char '^'
180 MO_Not _ -> Just $ char '~'
181 MO_S_Neg _ -> Just $ char '-' -- there is no unsigned neg :)
182 _ -> Nothing
183
184 -- --------------------------------------------------------------------------
185 -- Literals.
186 -- To minimise line noise we adopt the convention that if the literal
187 -- has the natural machine word size, we do not append the type
188 --
189 pprLit :: CmmLit -> SDoc
190 pprLit lit = sdocWithDynFlags $ \dflags ->
191 case lit of
192 CmmInt i rep ->
193 hcat [ (if i < 0 then parens else id)(integer i)
194 , ppUnless (rep == wordWidth dflags) $
195 space <> dcolon <+> ppr rep ]
196
197 CmmFloat f rep -> hsep [ double (fromRat f), dcolon, ppr rep ]
198 CmmVec lits -> char '<' <> commafy (map pprLit lits) <> char '>'
199 CmmLabel clbl -> ppr clbl
200 CmmLabelOff clbl i -> ppr clbl <> ppr_offset i
201 CmmLabelDiffOff clbl1 clbl2 i -> ppr clbl1 <> char '-'
202 <> ppr clbl2 <> ppr_offset i
203 CmmBlock id -> ppr id
204 CmmHighStackMark -> text "<highSp>"
205
206 pprLit1 :: CmmLit -> SDoc
207 pprLit1 lit@(CmmLabelOff {}) = parens (pprLit lit)
208 pprLit1 lit = pprLit lit
209
210 ppr_offset :: Int -> SDoc
211 ppr_offset i
212 | i==0 = empty
213 | i>=0 = char '+' <> int i
214 | otherwise = char '-' <> int (-i)
215
216 -- --------------------------------------------------------------------------
217 -- Registers, whether local (temps) or global
218 --
219 pprReg :: CmmReg -> SDoc
220 pprReg r
221 = case r of
222 CmmLocal local -> pprLocalReg local
223 CmmGlobal global -> pprGlobalReg global
224
225 --
226 -- We only print the type of the local reg if it isn't wordRep
227 --
228 pprLocalReg :: LocalReg -> SDoc
229 pprLocalReg (LocalReg uniq rep)
230 -- = ppr rep <> char '_' <> ppr uniq
231 -- Temp Jan08
232 = char '_' <> ppr uniq <>
233 (if isWord32 rep -- && not (isGcPtrType rep) -- Temp Jan08 -- sigh
234 then dcolon <> ptr <> ppr rep
235 else dcolon <> ptr <> ppr rep)
236 where
237 ptr = empty
238 --if isGcPtrType rep
239 -- then doubleQuotes (text "ptr")
240 -- else empty
241
242 -- Stack areas
243 pprArea :: Area -> SDoc
244 pprArea Old = text "old"
245 pprArea (Young id) = hcat [ text "young<", ppr id, text ">" ]
246
247 -- needs to be kept in syn with CmmExpr.hs.GlobalReg
248 --
249 pprGlobalReg :: GlobalReg -> SDoc
250 pprGlobalReg gr
251 = case gr of
252 VanillaReg n _ -> char 'R' <> int n
253 -- Temp Jan08
254 -- VanillaReg n VNonGcPtr -> char 'R' <> int n
255 -- VanillaReg n VGcPtr -> char 'P' <> int n
256 FloatReg n -> char 'F' <> int n
257 DoubleReg n -> char 'D' <> int n
258 LongReg n -> char 'L' <> int n
259 XmmReg n -> text "XMM" <> int n
260 YmmReg n -> text "YMM" <> int n
261 ZmmReg n -> text "ZMM" <> int n
262 Sp -> text "Sp"
263 SpLim -> text "SpLim"
264 Hp -> text "Hp"
265 HpLim -> text "HpLim"
266 MachSp -> text "MachSp"
267 UnwindReturnReg-> text "UnwindReturnReg"
268 CCCS -> text "CCCS"
269 CurrentTSO -> text "CurrentTSO"
270 CurrentNursery -> text "CurrentNursery"
271 HpAlloc -> text "HpAlloc"
272 EagerBlackholeInfo -> text "stg_EAGER_BLACKHOLE_info"
273 GCEnter1 -> text "stg_gc_enter_1"
274 GCFun -> text "stg_gc_fun"
275 BaseReg -> text "BaseReg"
276 PicBaseReg -> text "PicBaseReg"
277
278 -----------------------------------------------------------------------------
279
280 commafy :: [SDoc] -> SDoc
281 commafy xs = fsep $ punctuate comma xs