1 ----------------------------------------------------------------------------
3 -- Pretty-printing of Cmm as (a superset of) C--
5 -- (c) The University of Glasgow 2004
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
36 writeCmms, pprCmms, pprCmm, pprStmt, pprExpr
39 #include "HsVersions.h"
42 import CmmUtils ( isTrivialCmmExpr )
43 import MachOp ( MachOp(..), pprMachOp, MachRep(..), wordRep )
44 import CLabel ( pprCLabel, mkForeignLabel, entryLblToInfoLbl )
46 import ForeignCall ( CCallConv(..) )
47 import Unique ( getUnique )
49 import FastString ( mkFastString )
51 import Data.List ( intersperse, groupBy )
53 import Maybe ( isJust )
55 pprCmms :: [Cmm] -> SDoc
56 pprCmms cmms = pprCode CStyle (vcat (intersperse separator $ map ppr cmms))
58 separator = space $$ ptext SLIT("-------------------") $$ space
60 writeCmms :: Handle -> [Cmm] -> IO ()
61 writeCmms handle cmms = printForC handle (pprCmms cmms)
63 -----------------------------------------------------------------------------
65 instance Outputable Cmm where
68 instance Outputable CmmTop where
71 instance Outputable CmmBasicBlock where
74 instance Outputable CmmStmt where
77 instance Outputable CmmExpr where
80 instance Outputable CmmReg where
83 instance Outputable GlobalReg where
84 ppr e = pprGlobalReg e
86 -----------------------------------------------------------------------------
89 pprCmm (Cmm tops) = vcat $ intersperse (text "") $ map pprTop tops
91 -- --------------------------------------------------------------------------
92 -- Top level `procedure' blocks. The info tables, if not null, are
93 -- printed in the style of C--'s 'stackdata' declaration, just inside
94 -- the proc body, and are labelled with the procedure name ++ "_info".
96 pprTop :: CmmTop -> SDoc
97 pprTop (CmmProc info lbl params blocks )
99 = vcat [ pprCLabel lbl <> parens (commafy $ map pprLocalReg params) <+> lbrace
100 , nest 8 $ pprInfo info lbl
101 , nest 4 $ vcat (map ppr blocks)
107 (hang (pprCLabel (entryLblToInfoLbl label) <+> lbrace )
108 4 $ vcat (map pprStatic i))
111 -- --------------------------------------------------------------------------
112 -- We follow [1], 4.5
114 -- section "data" { ... }
116 pprTop (CmmData section ds) =
117 (hang (pprSection section <+> lbrace) 4 (vcat (map pprStatic ds)))
121 -- --------------------------------------------------------------------------
122 -- Basic blocks look like assembly blocks.
123 -- lbl: stmt ; stmt ; ..
124 pprBBlock :: CmmBasicBlock -> SDoc
125 pprBBlock (BasicBlock ident stmts) =
126 hang (pprBlockId ident <> colon) 4 (vcat (map ppr stmts))
128 -- --------------------------------------------------------------------------
129 -- Statements. C-- usually, exceptions to this should be obvious.
131 pprStmt :: CmmStmt -> SDoc
132 pprStmt stmt = case stmt of
138 CmmComment s -> text "//" <+> ftext s
141 CmmAssign reg expr -> ppr reg <+> equals <+> ppr expr <> semi
144 CmmStore lv expr -> rep <> brackets(ppr lv) <+> equals <+> ppr expr <> semi
146 rep = ppr ( cmmExprRep expr )
148 -- call "ccall" foo(x, y)[r1, r2];
150 CmmCall (CmmForeignCall fn cconv) results args _volatile ->
151 hcat [ ptext SLIT("call"), space,
152 doubleQuotes(ppr cconv), space,
153 target fn, parens ( commafy $ map ppr args ),
156 else brackets( commafy $ map ppr results)), semi ]
158 target (CmmLit lit) = pprLit lit
159 target fn' = parens (ppr fn')
161 CmmCall (CmmPrim op) results args volatile ->
162 pprStmt (CmmCall (CmmForeignCall (CmmLit lbl) CCallConv)
163 results args volatile)
165 lbl = CmmLabel (mkForeignLabel (mkFastString (show op)) Nothing False)
167 CmmBranch ident -> genBranch ident
168 CmmCondBranch expr ident -> genCondBranch expr ident
169 CmmJump expr params -> genJump expr params
170 CmmSwitch arg ids -> genSwitch arg ids
172 -- --------------------------------------------------------------------------
173 -- goto local label. [1], section 6.6
177 genBranch :: BlockId -> SDoc
179 ptext SLIT("goto") <+> pprBlockId ident <> semi
181 -- --------------------------------------------------------------------------
182 -- Conditional. [1], section 6.4
184 -- if (expr) { goto lbl; }
186 genCondBranch :: CmmExpr -> BlockId -> SDoc
187 genCondBranch expr ident =
188 hsep [ ptext SLIT("if")
191 , pprBlockId ident <> semi ]
193 -- --------------------------------------------------------------------------
194 -- A tail call. [1], Section 6.9
196 -- jump foo(a, b, c);
198 genJump :: CmmExpr -> [LocalReg] -> SDoc
199 genJump expr actuals =
201 hcat [ ptext SLIT("jump")
203 , if isTrivialCmmExpr expr
206 CmmLoad (CmmReg _) _ -> pprExpr expr
207 _ -> parens (pprExpr expr)
212 pprActuals [] = empty
213 pprActuals as = parens ( commafy $ map pprLocalReg as )
215 -- --------------------------------------------------------------------------
216 -- Tabled jump to local label
218 -- The syntax is from [1], section 6.5
220 -- switch [0 .. n] (expr) { case ... ; }
222 genSwitch :: CmmExpr -> [Maybe BlockId] -> SDoc
223 genSwitch expr maybe_ids
225 = let pairs = groupBy snds (zip [0 .. ] maybe_ids )
227 in hang (hcat [ ptext SLIT("switch [0 .. ")
228 , int (length maybe_ids - 1)
230 , if isTrivialCmmExpr expr
232 else parens (pprExpr expr)
235 4 (vcat ( map caseify pairs )) $$ rbrace
238 snds a b = (snd a) == (snd b)
240 caseify :: [(Int,Maybe BlockId)] -> SDoc
241 caseify ixs@((i,Nothing):_)
242 = ptext SLIT("/* impossible: ") <> hcat (intersperse comma (map (int.fst) ixs))
245 = let (is,ids) = unzip as
246 in hsep [ ptext SLIT("case")
247 , hcat (punctuate comma (map int is))
248 , ptext SLIT(": goto")
249 , pprBlockId (head [ id | Just id <- ids]) <> semi ]
251 -- --------------------------------------------------------------------------
255 pprExpr :: CmmExpr -> SDoc
259 pprExpr (CmmMachOp (MO_Add rep)
260 [CmmReg reg, CmmLit (CmmInt (fromIntegral i) rep)])
261 where rep = cmmRegRep reg
262 CmmLit lit -> pprLit lit
265 -- Here's the precedence table from CmmParse.y:
266 -- %nonassoc '>=' '>' '<=' '<' '!=' '=='
275 -- We just cope with the common operators for now, the rest will get
276 -- a default conservative behaviour.
278 -- %nonassoc '>=' '>' '<=' '<' '!=' '=='
279 pprExpr1 (CmmMachOp op [x,y]) | Just doc <- infixMachOp1 op
280 = pprExpr7 x <+> doc <+> pprExpr7 y
281 pprExpr1 e = pprExpr7 e
283 infixMachOp1 (MO_Eq _) = Just (ptext SLIT("=="))
284 infixMachOp1 (MO_Ne _) = Just (ptext SLIT("!="))
285 infixMachOp1 (MO_Shl _) = Just (ptext SLIT("<<"))
286 infixMachOp1 (MO_U_Shr _) = Just (ptext SLIT(">>"))
287 infixMachOp1 (MO_U_Ge _) = Just (ptext SLIT(">="))
288 infixMachOp1 (MO_U_Le _) = Just (ptext SLIT("<="))
289 infixMachOp1 (MO_U_Gt _) = Just (char '>')
290 infixMachOp1 (MO_U_Lt _) = Just (char '<')
291 infixMachOp1 _ = Nothing
294 pprExpr7 (CmmMachOp op [x,y]) | Just doc <- infixMachOp7 op
295 = pprExpr7 x <+> doc <+> pprExpr8 y
296 pprExpr7 e = pprExpr8 e
298 infixMachOp7 (MO_Add _) = Just (char '+')
299 infixMachOp7 (MO_Sub _) = Just (char '-')
300 infixMachOp7 _ = Nothing
303 pprExpr8 (CmmMachOp op [x,y]) | Just doc <- infixMachOp8 op
304 = pprExpr8 x <+> doc <+> pprExpr9 y
305 pprExpr8 e = pprExpr9 e
307 infixMachOp8 (MO_U_Quot _) = Just (char '/')
308 infixMachOp8 (MO_Mul _) = Just (char '*')
309 infixMachOp8 (MO_U_Rem _) = Just (char '%')
310 infixMachOp8 _ = Nothing
312 pprExpr9 :: CmmExpr -> SDoc
315 CmmLit lit -> pprLit1 lit
316 CmmLoad expr rep -> ppr rep <> brackets( ppr expr )
317 CmmReg reg -> ppr reg
318 CmmRegOff reg off -> parens (ppr reg <+> char '+' <+> int off)
319 CmmMachOp mop args -> genMachOp mop args
320 CmmPicBaseReg -> text "PIC_BASE_REG"
321 e -> parens (pprExpr e)
323 genMachOp :: MachOp -> [CmmExpr] -> SDoc
325 | Just doc <- infixMachOp mop = case args of
327 [x,y] -> pprExpr9 x <+> doc <+> pprExpr9 y
330 [x] -> doc <> pprExpr9 x
332 _ -> pprTrace "PprCmm.genMachOp: machop with strange number of args"
334 parens (hcat $ punctuate comma (map pprExpr args)))
337 | isJust (infixMachOp1 mop)
338 || isJust (infixMachOp7 mop)
339 || isJust (infixMachOp8 mop) = parens (pprExpr (CmmMachOp mop args))
341 | otherwise = char '%' <> pprMachOp mop <> parens (commafy (map pprExpr args))
344 -- Unsigned ops on the word size of the machine get nice symbols.
345 -- All else get dumped in their ugly format.
347 infixMachOp :: MachOp -> Maybe SDoc
350 MO_And _ -> Just $ char '&'
351 MO_Or _ -> Just $ char '|'
352 MO_Xor _ -> Just $ char '^'
353 MO_Not _ -> Just $ char '~'
354 MO_S_Neg _ -> Just $ char '-' -- there is no unsigned neg :)
355 MO_Not _ -> Just $ char '~'
358 -- --------------------------------------------------------------------------
360 -- To minimise line noise we adopt the convention that if the literal
361 -- has the natural machine word size, we do not append the type
363 pprLit :: CmmLit -> SDoc
364 pprLit lit = case lit of
366 hcat [ (if i < 0 then parens else id)(integer i)
369 else space <> dcolon <+> ppr rep) ]
371 CmmFloat f rep -> hsep [ rational f, dcolon, ppr rep ]
372 CmmLabel clbl -> pprCLabel clbl
373 CmmLabelOff clbl i -> pprCLabel clbl <> ppr_offset i
374 CmmLabelDiffOff clbl1 clbl2 i -> pprCLabel clbl1 <> char '-'
375 <> pprCLabel clbl2 <> ppr_offset i
377 pprLit1 lit@(CmmLabelOff clbl i) = parens (pprLit lit)
378 pprLit1 lit = pprLit lit
380 ppr_offset :: Int -> SDoc
383 | i>=0 = char '+' <> int i
384 | otherwise = char '-' <> int (-i)
386 -- --------------------------------------------------------------------------
388 -- Strings are printed as C strings, and we print them as I8[],
391 pprStatic :: CmmStatic -> SDoc
392 pprStatic s = case s of
393 CmmStaticLit lit -> nest 4 $ ptext SLIT("const") <+> pprLit lit <> semi
394 CmmUninitialised i -> nest 4 $ text "I8" <> brackets (int i)
395 CmmAlign i -> nest 4 $ text "align" <+> int i
396 CmmDataLabel clbl -> pprCLabel clbl <> colon
397 CmmString s' -> nest 4 $ text "I8[]" <+> doubleQuotes (text s')
399 -- --------------------------------------------------------------------------
400 -- Registers, whether local (temps) or global
402 pprReg :: CmmReg -> SDoc
405 CmmLocal local -> pprLocalReg local
406 CmmGlobal global -> pprGlobalReg global
409 -- We only print the type of the local reg if it isn't wordRep
411 pprLocalReg :: LocalReg -> SDoc
412 pprLocalReg (LocalReg uniq rep)
413 = hcat [ char '_', ppr uniq,
415 then empty else dcolon <> ppr rep) ]
417 -- needs to be kept in syn with Cmm.hs.GlobalReg
419 pprGlobalReg :: GlobalReg -> SDoc
422 VanillaReg n -> char 'R' <> int n
423 FloatReg n -> char 'F' <> int n
424 DoubleReg n -> char 'D' <> int n
425 LongReg n -> char 'L' <> int n
426 Sp -> ptext SLIT("Sp")
427 SpLim -> ptext SLIT("SpLim")
428 Hp -> ptext SLIT("Hp")
429 HpLim -> ptext SLIT("HpLim")
430 CurrentTSO -> ptext SLIT("CurrentTSO")
431 CurrentNursery -> ptext SLIT("CurrentNursery")
432 HpAlloc -> ptext SLIT("HpAlloc")
433 GCEnter1 -> ptext SLIT("stg_gc_enter_1")
434 GCFun -> ptext SLIT("stg_gc_fun")
435 BaseReg -> ptext SLIT("BaseReg")
437 _ -> panic $ "PprCmm.pprGlobalReg: unknown global reg"
439 -- --------------------------------------------------------------------------
442 pprSection :: Section -> SDoc
443 pprSection s = case s of
444 Text -> section <+> doubleQuotes (ptext SLIT("text"))
445 Data -> section <+> doubleQuotes (ptext SLIT("data"))
446 ReadOnlyData -> section <+> doubleQuotes (ptext SLIT("readonly"))
447 RelocatableReadOnlyData
448 -> section <+> doubleQuotes (ptext SLIT("relreadonly"))
449 UninitialisedData -> section <+> doubleQuotes (ptext SLIT("uninitialised"))
450 OtherSection s' -> section <+> doubleQuotes (text s')
452 section = ptext SLIT("section")
454 -- --------------------------------------------------------------------------
457 pprBlockId :: BlockId -> SDoc
458 pprBlockId b = ppr $ getUnique b
460 -----------------------------------------------------------------------------
462 commafy :: [SDoc] -> SDoc
463 commafy xs = hsep $ punctuate comma xs