1 ----------------------------------------------------------------------------
3 -- Pretty-printing of common Cmm types
5 -- (c) The University of Glasgow 2004-2006
7 -----------------------------------------------------------------------------
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.
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.
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
25 -- 1) if a value has wordRep type, the type is not appended in the
27 -- 2) MachOps that operate over wordRep type are printed in a
28 -- C-style, rather than as their internal MachRep name.
30 -- These conventions produce much more readable Cmm output.
32 -- A useful example pass over Cmm is in nativeGen/MachCodeGen.hs
37 , pprExpr9 {-only to import in OldPprCmm. When it dies, remove the export -}
49 -----------------------------------------------------------------------------
51 instance Outputable CmmExpr where
54 instance Outputable CmmReg where
57 instance Outputable CmmLit where
60 instance Outputable LocalReg where
63 instance Outputable Area where
66 instance Outputable GlobalReg where
67 ppr e = pprGlobalReg e
69 -- --------------------------------------------------------------------------
73 pprExpr :: CmmExpr -> SDoc
77 pprExpr (CmmMachOp (MO_Add rep)
78 [CmmReg reg, CmmLit (CmmInt (fromIntegral i) rep)])
79 where rep = typeWidth (cmmRegType reg)
80 CmmLit lit -> pprLit lit
83 -- Here's the precedence table from CmmParse.y:
84 -- %nonassoc '>=' '>' '<=' '<' '!=' '=='
93 -- We just cope with the common operators for now, the rest will get
94 -- a default conservative behaviour.
96 -- %nonassoc '>=' '>' '<=' '<' '!=' '=='
97 pprExpr1, pprExpr7, pprExpr8 :: CmmExpr -> SDoc
98 pprExpr1 (CmmMachOp op [x,y]) | Just doc <- infixMachOp1 op
99 = pprExpr7 x <+> doc <+> pprExpr7 y
100 pprExpr1 e = pprExpr7 e
102 infixMachOp1, infixMachOp7, infixMachOp8 :: MachOp -> Maybe SDoc
104 infixMachOp1 (MO_Eq _) = Just (ptext (sLit "=="))
105 infixMachOp1 (MO_Ne _) = Just (ptext (sLit "!="))
106 infixMachOp1 (MO_Shl _) = Just (ptext (sLit "<<"))
107 infixMachOp1 (MO_U_Shr _) = Just (ptext (sLit ">>"))
108 infixMachOp1 (MO_U_Ge _) = Just (ptext (sLit ">="))
109 infixMachOp1 (MO_U_Le _) = Just (ptext (sLit "<="))
110 infixMachOp1 (MO_U_Gt _) = Just (char '>')
111 infixMachOp1 (MO_U_Lt _) = Just (char '<')
112 infixMachOp1 _ = Nothing
115 pprExpr7 (CmmMachOp (MO_Add rep1) [x, CmmLit (CmmInt i rep2)]) | i < 0
116 = pprExpr7 (CmmMachOp (MO_Sub rep1) [x, CmmLit (CmmInt (negate i) rep2)])
117 pprExpr7 (CmmMachOp op [x,y]) | Just doc <- infixMachOp7 op
118 = pprExpr7 x <+> doc <+> pprExpr8 y
119 pprExpr7 e = pprExpr8 e
121 infixMachOp7 (MO_Add _) = Just (char '+')
122 infixMachOp7 (MO_Sub _) = Just (char '-')
123 infixMachOp7 _ = Nothing
126 pprExpr8 (CmmMachOp op [x,y]) | Just doc <- infixMachOp8 op
127 = pprExpr8 x <+> doc <+> pprExpr9 y
128 pprExpr8 e = pprExpr9 e
130 infixMachOp8 (MO_U_Quot _) = Just (char '/')
131 infixMachOp8 (MO_Mul _) = Just (char '*')
132 infixMachOp8 (MO_U_Rem _) = Just (char '%')
133 infixMachOp8 _ = Nothing
135 pprExpr9 :: CmmExpr -> SDoc
138 CmmLit lit -> pprLit1 lit
139 CmmLoad expr rep -> ppr rep <> brackets( ppr expr )
140 CmmReg reg -> ppr reg
141 CmmRegOff reg off -> parens (ppr reg <+> char '+' <+> int off)
142 CmmStackSlot a off -> parens (ppr a <+> char '+' <+> int off)
143 CmmMachOp mop args -> genMachOp mop args
145 genMachOp :: MachOp -> [CmmExpr] -> SDoc
147 | Just doc <- infixMachOp mop = case args of
149 [x,y] -> pprExpr9 x <+> doc <+> pprExpr9 y
152 [x] -> doc <> pprExpr9 x
154 _ -> pprTrace "PprCmm.genMachOp: machop with strange number of args"
156 parens (hcat $ punctuate comma (map pprExpr args)))
159 | isJust (infixMachOp1 mop)
160 || isJust (infixMachOp7 mop)
161 || isJust (infixMachOp8 mop) = parens (pprExpr (CmmMachOp mop args))
163 | otherwise = char '%' <> ppr_op <> parens (commafy (map pprExpr args))
164 where ppr_op = text (map (\c -> if c == ' ' then '_' else c)
166 -- replace spaces in (show mop) with underscores,
169 -- Unsigned ops on the word size of the machine get nice symbols.
170 -- All else get dumped in their ugly format.
172 infixMachOp :: MachOp -> Maybe SDoc
175 MO_And _ -> Just $ char '&'
176 MO_Or _ -> Just $ char '|'
177 MO_Xor _ -> Just $ char '^'
178 MO_Not _ -> Just $ char '~'
179 MO_S_Neg _ -> Just $ char '-' -- there is no unsigned neg :)
182 -- --------------------------------------------------------------------------
184 -- To minimise line noise we adopt the convention that if the literal
185 -- has the natural machine word size, we do not append the type
187 pprLit :: CmmLit -> SDoc
188 pprLit lit = case lit of
190 hcat [ (if i < 0 then parens else id)(integer i)
191 , ppUnless (rep == wordWidth) $
192 space <> dcolon <+> ppr rep ]
194 CmmFloat f rep -> hsep [ rational f, dcolon, ppr rep ]
195 CmmLabel clbl -> pprCLabel clbl
196 CmmLabelOff clbl i -> pprCLabel clbl <> ppr_offset i
197 CmmLabelDiffOff clbl1 clbl2 i -> pprCLabel clbl1 <> char '-'
198 <> pprCLabel clbl2 <> ppr_offset i
199 CmmBlock id -> ppr id
200 CmmHighStackMark -> text "<highSp>"
202 pprLit1 :: CmmLit -> SDoc
203 pprLit1 lit@(CmmLabelOff {}) = parens (pprLit lit)
204 pprLit1 lit = pprLit lit
206 ppr_offset :: Int -> SDoc
209 | i>=0 = char '+' <> int i
210 | otherwise = char '-' <> int (-i)
212 -- --------------------------------------------------------------------------
213 -- Registers, whether local (temps) or global
215 pprReg :: CmmReg -> SDoc
218 CmmLocal local -> pprLocalReg local
219 CmmGlobal global -> pprGlobalReg global
222 -- We only print the type of the local reg if it isn't wordRep
224 pprLocalReg :: LocalReg -> SDoc
225 pprLocalReg (LocalReg uniq rep)
226 -- = ppr rep <> char '_' <> ppr uniq
228 = char '_' <> ppr uniq <>
229 (if isWord32 rep -- && not (isGcPtrType rep) -- Temp Jan08 -- sigh
230 then dcolon <> ptr <> ppr rep
231 else dcolon <> ptr <> ppr rep)
235 -- then doubleQuotes (text "ptr")
239 pprArea :: Area -> SDoc
240 pprArea (RegSlot r) = hcat [ text "slot<", ppr r, text ">" ]
241 pprArea (CallArea id) = pprAreaId id
243 pprAreaId :: AreaId -> SDoc
244 pprAreaId Old = text "old"
245 pprAreaId (Young id) = hcat [ text "young<", ppr id, text ">" ]
247 -- needs to be kept in syn with CmmExpr.hs.GlobalReg
249 pprGlobalReg :: GlobalReg -> SDoc
252 VanillaReg n _ -> char 'R' <> int n
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 Sp -> ptext (sLit "Sp")
260 SpLim -> ptext (sLit "SpLim")
261 Hp -> ptext (sLit "Hp")
262 HpLim -> ptext (sLit "HpLim")
263 CurrentTSO -> ptext (sLit "CurrentTSO")
264 CurrentNursery -> ptext (sLit "CurrentNursery")
265 HpAlloc -> ptext (sLit "HpAlloc")
266 EagerBlackholeInfo -> ptext (sLit "stg_EAGER_BLACKHOLE_info")
267 GCEnter1 -> ptext (sLit "stg_gc_enter_1")
268 GCFun -> ptext (sLit "stg_gc_fun")
269 BaseReg -> ptext (sLit "BaseReg")
270 PicBaseReg -> ptext (sLit "PicBaseReg")
272 -----------------------------------------------------------------------------
274 commafy :: [SDoc] -> SDoc
275 commafy xs = fsep $ punctuate comma xs