1 ----------------------------------------------------------------------------
3 -- Pretty-printing of Cmm as (a superset of) C--
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
36 ( writeCmms, pprCmms, pprCmm, pprStmt, pprExpr,
37 pprSection, pprStatic, pprLit
59 #include "../includes/rts/storage/FunTypes.h"
62 pprCmms :: (Outputable info, Outputable g) => [GenCmm CmmStatic info g] -> SDoc
63 pprCmms cmms = pprCode CStyle (vcat (intersperse separator $ map ppr cmms))
65 separator = space $$ ptext (sLit "-------------------") $$ space
67 writeCmms :: Handle -> [Cmm] -> IO ()
68 writeCmms handle cmms = printForC handle (pprCmms cmms)
70 -----------------------------------------------------------------------------
72 instance (Outputable d, Outputable info, Outputable g)
73 => Outputable (GenCmm d info g) where
76 instance (Outputable d, Outputable info, Outputable i)
77 => Outputable (GenCmmTop d info i) where
80 instance (Outputable instr) => Outputable (ListGraph instr) where
81 ppr (ListGraph blocks) = vcat (map ppr blocks)
83 instance (Outputable instr) => Outputable (GenBasicBlock instr) where
86 instance Outputable CmmStmt where
89 instance Outputable CmmExpr where
92 instance Outputable CmmReg where
95 instance Outputable CmmLit where
98 instance Outputable LocalReg where
101 instance Outputable Area where
104 instance Outputable GlobalReg where
105 ppr e = pprGlobalReg e
107 instance Outputable CmmStatic where
110 instance Outputable CmmInfo where
115 -----------------------------------------------------------------------------
117 pprCmm :: (Outputable d, Outputable info, Outputable g) => GenCmm d info g -> SDoc
118 pprCmm (Cmm tops) = vcat $ intersperse blankLine $ map pprTop tops
120 -- --------------------------------------------------------------------------
121 -- Top level `procedure' blocks.
123 pprTop :: (Outputable d, Outputable info, Outputable i)
124 => GenCmmTop d info i -> SDoc
126 pprTop (CmmProc info lbl params graph )
128 = vcat [ pprCLabel lbl <> parens (commafy $ map ppr params)
129 , nest 8 $ lbrace <+> ppr info $$ rbrace
133 -- --------------------------------------------------------------------------
134 -- We follow [1], 4.5
136 -- section "data" { ... }
138 pprTop (CmmData section ds) =
139 (hang (pprSection section <+> lbrace) 4 (vcat (map ppr ds)))
142 -- --------------------------------------------------------------------------
143 instance Outputable CmmSafety where
144 ppr CmmUnsafe = ptext (sLit "_unsafe_call_")
145 ppr (CmmSafe srt) = ppr srt
147 -- --------------------------------------------------------------------------
148 -- Info tables. The current pretty printer needs refinement
149 -- but will work for now.
151 -- For ideas on how to refine it, they used to be printed in the
152 -- style of C--'s 'stackdata' declaration, just inside the proc body,
153 -- and were labelled with the procedure name ++ "_info".
154 pprInfo :: CmmInfo -> SDoc
155 pprInfo (CmmInfo _gc_target update_frame CmmNonInfoTable) =
156 vcat [{-ptext (sLit "gc_target: ") <>
157 maybe (ptext (sLit "<none>")) ppr gc_target,-}
158 ptext (sLit "update_frame: ") <>
159 maybe (ptext (sLit "<none>")) pprUpdateFrame update_frame]
160 pprInfo (CmmInfo _gc_target update_frame
161 (CmmInfoTable stat_clos (ProfilingInfo closure_type closure_desc) tag info)) =
162 vcat [{-ptext (sLit "gc_target: ") <>
163 maybe (ptext (sLit "<none>")) ppr gc_target,-}
164 ptext (sLit "has static closure: ") <> ppr stat_clos <+>
165 ptext (sLit "update_frame: ") <>
166 maybe (ptext (sLit "<none>")) pprUpdateFrame update_frame,
167 ptext (sLit "type: ") <> pprLit closure_type,
168 ptext (sLit "desc: ") <> pprLit closure_desc,
169 ptext (sLit "tag: ") <> integer (toInteger tag),
172 pprTypeInfo :: ClosureTypeInfo -> SDoc
173 pprTypeInfo (ConstrInfo layout constr descr) =
174 vcat [ptext (sLit "ptrs: ") <> integer (toInteger (fst layout)),
175 ptext (sLit "nptrs: ") <> integer (toInteger (snd layout)),
176 ptext (sLit "constructor: ") <> integer (toInteger constr),
178 pprTypeInfo (FunInfo layout srt arity _args slow_entry) =
179 vcat [ptext (sLit "ptrs: ") <> integer (toInteger (fst layout)),
180 ptext (sLit "nptrs: ") <> integer (toInteger (snd layout)),
181 ptext (sLit "srt: ") <> ppr srt,
183 ptext (sLit ("fun_type: ")) <> integer (toInteger (argDescrType _args)),
185 ptext (sLit "arity: ") <> integer (toInteger arity),
186 --ptext (sLit "args: ") <> ppr args, -- TODO: needs to be printed
187 ptext (sLit "slow: ") <> pprLit slow_entry
189 pprTypeInfo (ThunkInfo layout srt) =
190 vcat [ptext (sLit "ptrs: ") <> integer (toInteger (fst layout)),
191 ptext (sLit "nptrs: ") <> integer (toInteger (snd layout)),
192 ptext (sLit "srt: ") <> ppr srt]
193 pprTypeInfo (ThunkSelectorInfo offset srt) =
194 vcat [ptext (sLit "ptrs: ") <> integer (toInteger offset),
195 ptext (sLit "srt: ") <> ppr srt]
196 pprTypeInfo (ContInfo stack srt) =
197 vcat [ptext (sLit "stack: ") <> ppr stack,
198 ptext (sLit "srt: ") <> ppr srt]
201 argDescrType :: ArgDescr -> StgHalfWord
202 -- The "argument type" RTS field type
203 argDescrType (ArgSpec n) = n
204 argDescrType (ArgGen liveness)
205 | isBigLiveness liveness = ARG_GEN_BIG
206 | otherwise = ARG_GEN
209 isBigLiveness :: Liveness -> Bool
210 isBigLiveness (BigLiveness _) = True
211 isBigLiveness (SmallLiveness _) = False
214 pprUpdateFrame :: UpdateFrame -> SDoc
215 pprUpdateFrame (UpdateFrame expr args) =
216 hcat [ ptext (sLit "jump")
218 , if isTrivialCmmExpr expr
221 CmmLoad (CmmReg _) _ -> pprExpr expr
222 _ -> parens (pprExpr expr)
224 , parens ( commafy $ map ppr args ) ]
227 -- --------------------------------------------------------------------------
228 -- Basic blocks look like assembly blocks.
229 -- lbl: stmt ; stmt ; ..
230 pprBBlock :: Outputable stmt => GenBasicBlock stmt -> SDoc
231 pprBBlock (BasicBlock ident stmts) =
232 hang (ppr ident <> colon) 4 (vcat (map ppr stmts))
234 -- --------------------------------------------------------------------------
235 -- Statements. C-- usually, exceptions to this should be obvious.
237 pprStmt :: CmmStmt -> SDoc
238 pprStmt stmt = case stmt of
244 CmmComment s -> text "//" <+> ftext s
247 CmmAssign reg expr -> ppr reg <+> equals <+> ppr expr <> semi
250 CmmStore lv expr -> rep <> brackets(ppr lv) <+> equals <+> ppr expr <> semi
252 rep = ppr ( cmmExprType expr )
254 -- call "ccall" foo(x, y)[r1, r2];
256 CmmCall (CmmCallee fn cconv) results args safety ret ->
257 sep [ pp_lhs <+> pp_conv
258 , nest 2 (pprExpr9 fn <>
259 parens (commafy (map ppr_ar args)))
260 <> brackets (ppr safety)
261 , case ret of CmmMayReturn -> empty
262 CmmNeverReturns -> ptext $ sLit (" never returns")
265 pp_lhs | null results = empty
266 | otherwise = commafy (map ppr_ar results) <+> equals
267 -- Don't print the hints on a native C-- call
268 ppr_ar (CmmHinted ar k) = case cconv of
269 CmmCallConv -> ppr ar
271 pp_conv = case cconv of
273 _ -> ptext (sLit("foreign")) <+> doubleQuotes (ppr cconv)
275 -- Call a CallishMachOp, like sin or cos that might be implemented as a library call.
276 CmmCall (CmmPrim op) results args safety ret ->
277 pprStmt (CmmCall (CmmCallee (CmmLit lbl) CCallConv)
278 results args safety ret)
280 -- HACK: A CallishMachOp doesn't really correspond to a ForeignLabel, but we
281 -- use one to get the label printed.
282 lbl = CmmLabel (mkForeignLabel
283 (mkFastString (show op))
284 Nothing ForeignLabelInThisPackage IsFunction)
286 CmmBranch ident -> genBranch ident
287 CmmCondBranch expr ident -> genCondBranch expr ident
288 CmmJump expr params -> genJump expr params
289 CmmReturn params -> genReturn params
290 CmmSwitch arg ids -> genSwitch arg ids
292 instance Outputable ForeignHint where
294 ppr SignedHint = quotes(text "signed")
295 -- ppr AddrHint = quotes(text "address")
297 ppr AddrHint = (text "PtrHint")
299 -- Just look like a tuple, since it was a tuple before
300 -- ... is that a good idea? --Isaac Dupree
301 instance (Outputable a) => Outputable (CmmHinted a) where
302 ppr (CmmHinted a k) = ppr (a, k)
304 -- --------------------------------------------------------------------------
305 -- goto local label. [1], section 6.6
309 genBranch :: BlockId -> SDoc
311 ptext (sLit "goto") <+> ppr ident <> semi
313 -- --------------------------------------------------------------------------
314 -- Conditional. [1], section 6.4
316 -- if (expr) { goto lbl; }
318 genCondBranch :: CmmExpr -> BlockId -> SDoc
319 genCondBranch expr ident =
320 hsep [ ptext (sLit "if")
322 , ptext (sLit "goto")
323 , ppr ident <> semi ]
325 -- --------------------------------------------------------------------------
326 -- A tail call. [1], Section 6.9
328 -- jump foo(a, b, c);
330 genJump :: CmmExpr -> [CmmHinted CmmExpr] -> SDoc
332 hcat [ ptext (sLit "jump")
334 , if isTrivialCmmExpr expr
337 CmmLoad (CmmReg _) _ -> pprExpr expr
338 _ -> parens (pprExpr expr)
340 , parens ( commafy $ map ppr args )
344 -- --------------------------------------------------------------------------
345 -- Return from a function. [1], Section 6.8.2 of version 1.128
349 genReturn :: [CmmHinted CmmExpr] -> SDoc
351 hcat [ ptext (sLit "return")
353 , parens ( commafy $ map ppr args )
356 -- --------------------------------------------------------------------------
357 -- Tabled jump to local label
359 -- The syntax is from [1], section 6.5
361 -- switch [0 .. n] (expr) { case ... ; }
363 genSwitch :: CmmExpr -> [Maybe BlockId] -> SDoc
364 genSwitch expr maybe_ids
366 = let pairs = groupBy snds (zip [0 .. ] maybe_ids )
368 in hang (hcat [ ptext (sLit "switch [0 .. ")
369 , int (length maybe_ids - 1)
371 , if isTrivialCmmExpr expr
373 else parens (pprExpr expr)
376 4 (vcat ( map caseify pairs )) $$ rbrace
379 snds a b = (snd a) == (snd b)
381 caseify :: [(Int,Maybe BlockId)] -> SDoc
382 caseify ixs@((_,Nothing):_)
383 = ptext (sLit "/* impossible: ") <> hcat (intersperse comma (map (int.fst) ixs))
384 <> ptext (sLit " */")
386 = let (is,ids) = unzip as
387 in hsep [ ptext (sLit "case")
388 , hcat (punctuate comma (map int is))
389 , ptext (sLit ": goto")
390 , ppr (head [ id | Just id <- ids]) <> semi ]
392 -- --------------------------------------------------------------------------
396 pprExpr :: CmmExpr -> SDoc
400 pprExpr (CmmMachOp (MO_Add rep)
401 [CmmReg reg, CmmLit (CmmInt (fromIntegral i) rep)])
402 where rep = typeWidth (cmmRegType reg)
403 CmmLit lit -> pprLit lit
406 -- Here's the precedence table from CmmParse.y:
407 -- %nonassoc '>=' '>' '<=' '<' '!=' '=='
416 -- We just cope with the common operators for now, the rest will get
417 -- a default conservative behaviour.
419 -- %nonassoc '>=' '>' '<=' '<' '!=' '=='
420 pprExpr1, pprExpr7, pprExpr8 :: CmmExpr -> SDoc
421 pprExpr1 (CmmMachOp op [x,y]) | Just doc <- infixMachOp1 op
422 = pprExpr7 x <+> doc <+> pprExpr7 y
423 pprExpr1 e = pprExpr7 e
425 infixMachOp1, infixMachOp7, infixMachOp8 :: MachOp -> Maybe SDoc
427 infixMachOp1 (MO_Eq _) = Just (ptext (sLit "=="))
428 infixMachOp1 (MO_Ne _) = Just (ptext (sLit "!="))
429 infixMachOp1 (MO_Shl _) = Just (ptext (sLit "<<"))
430 infixMachOp1 (MO_U_Shr _) = Just (ptext (sLit ">>"))
431 infixMachOp1 (MO_U_Ge _) = Just (ptext (sLit ">="))
432 infixMachOp1 (MO_U_Le _) = Just (ptext (sLit "<="))
433 infixMachOp1 (MO_U_Gt _) = Just (char '>')
434 infixMachOp1 (MO_U_Lt _) = Just (char '<')
435 infixMachOp1 _ = Nothing
438 pprExpr7 (CmmMachOp (MO_Add rep1) [x, CmmLit (CmmInt i rep2)]) | i < 0
439 = pprExpr7 (CmmMachOp (MO_Sub rep1) [x, CmmLit (CmmInt (negate i) rep2)])
440 pprExpr7 (CmmMachOp op [x,y]) | Just doc <- infixMachOp7 op
441 = pprExpr7 x <+> doc <+> pprExpr8 y
442 pprExpr7 e = pprExpr8 e
444 infixMachOp7 (MO_Add _) = Just (char '+')
445 infixMachOp7 (MO_Sub _) = Just (char '-')
446 infixMachOp7 _ = Nothing
449 pprExpr8 (CmmMachOp op [x,y]) | Just doc <- infixMachOp8 op
450 = pprExpr8 x <+> doc <+> pprExpr9 y
451 pprExpr8 e = pprExpr9 e
453 infixMachOp8 (MO_U_Quot _) = Just (char '/')
454 infixMachOp8 (MO_Mul _) = Just (char '*')
455 infixMachOp8 (MO_U_Rem _) = Just (char '%')
456 infixMachOp8 _ = Nothing
458 pprExpr9 :: CmmExpr -> SDoc
461 CmmLit lit -> pprLit1 lit
462 CmmLoad expr rep -> ppr rep <> brackets( ppr expr )
463 CmmReg reg -> ppr reg
464 CmmRegOff reg off -> parens (ppr reg <+> char '+' <+> int off)
465 CmmStackSlot a off -> parens (ppr a <+> char '+' <+> int off)
466 CmmMachOp mop args -> genMachOp mop args
468 genMachOp :: MachOp -> [CmmExpr] -> SDoc
470 | Just doc <- infixMachOp mop = case args of
472 [x,y] -> pprExpr9 x <+> doc <+> pprExpr9 y
475 [x] -> doc <> pprExpr9 x
477 _ -> pprTrace "PprCmm.genMachOp: machop with strange number of args"
479 parens (hcat $ punctuate comma (map pprExpr args)))
482 | isJust (infixMachOp1 mop)
483 || isJust (infixMachOp7 mop)
484 || isJust (infixMachOp8 mop) = parens (pprExpr (CmmMachOp mop args))
486 | otherwise = char '%' <> ppr_op <> parens (commafy (map pprExpr args))
487 where ppr_op = text (map (\c -> if c == ' ' then '_' else c)
489 -- replace spaces in (show mop) with underscores,
492 -- Unsigned ops on the word size of the machine get nice symbols.
493 -- All else get dumped in their ugly format.
495 infixMachOp :: MachOp -> Maybe SDoc
498 MO_And _ -> Just $ char '&'
499 MO_Or _ -> Just $ char '|'
500 MO_Xor _ -> Just $ char '^'
501 MO_Not _ -> Just $ char '~'
502 MO_S_Neg _ -> Just $ char '-' -- there is no unsigned neg :)
505 -- --------------------------------------------------------------------------
507 -- To minimise line noise we adopt the convention that if the literal
508 -- has the natural machine word size, we do not append the type
510 pprLit :: CmmLit -> SDoc
511 pprLit lit = case lit of
513 hcat [ (if i < 0 then parens else id)(integer i)
514 , ppUnless (rep == wordWidth) $
515 space <> dcolon <+> ppr rep ]
517 CmmFloat f rep -> hsep [ rational f, dcolon, ppr rep ]
518 CmmLabel clbl -> pprCLabel clbl
519 CmmLabelOff clbl i -> pprCLabel clbl <> ppr_offset i
520 CmmLabelDiffOff clbl1 clbl2 i -> pprCLabel clbl1 <> char '-'
521 <> pprCLabel clbl2 <> ppr_offset i
522 CmmBlock id -> ppr id
523 CmmHighStackMark -> text "<highSp>"
525 pprLit1 :: CmmLit -> SDoc
526 pprLit1 lit@(CmmLabelOff {}) = parens (pprLit lit)
527 pprLit1 lit = pprLit lit
529 ppr_offset :: Int -> SDoc
532 | i>=0 = char '+' <> int i
533 | otherwise = char '-' <> int (-i)
535 -- --------------------------------------------------------------------------
537 -- Strings are printed as C strings, and we print them as I8[],
540 pprStatic :: CmmStatic -> SDoc
541 pprStatic s = case s of
542 CmmStaticLit lit -> nest 4 $ ptext (sLit "const") <+> pprLit lit <> semi
543 CmmUninitialised i -> nest 4 $ text "I8" <> brackets (int i)
544 CmmAlign i -> nest 4 $ text "align" <+> int i
545 CmmDataLabel clbl -> pprCLabel clbl <> colon
546 CmmString s' -> nest 4 $ text "I8[]" <+> text (show s')
548 -- --------------------------------------------------------------------------
549 -- Registers, whether local (temps) or global
551 pprReg :: CmmReg -> SDoc
554 CmmLocal local -> pprLocalReg local
555 CmmGlobal global -> pprGlobalReg global
558 -- We only print the type of the local reg if it isn't wordRep
560 pprLocalReg :: LocalReg -> SDoc
561 pprLocalReg (LocalReg uniq rep)
562 -- = ppr rep <> char '_' <> ppr uniq
564 = char '_' <> ppr uniq <>
565 (if isWord32 rep -- && not (isGcPtrType rep) -- Temp Jan08 -- sigh
566 then dcolon <> ptr <> ppr rep
567 else dcolon <> ptr <> ppr rep)
571 -- then doubleQuotes (text "ptr")
575 pprArea :: Area -> SDoc
576 pprArea (RegSlot r) = hcat [ text "slot<", ppr r, text ">" ]
577 pprArea (CallArea id) = pprAreaId id
579 pprAreaId :: AreaId -> SDoc
580 pprAreaId Old = text "old"
581 pprAreaId (Young id) = hcat [ text "young<", ppr id, text ">" ]
583 -- needs to be kept in syn with Cmm.hs.GlobalReg
585 pprGlobalReg :: GlobalReg -> SDoc
588 VanillaReg n _ -> char 'R' <> int n
590 -- VanillaReg n VNonGcPtr -> char 'R' <> int n
591 -- VanillaReg n VGcPtr -> char 'P' <> int n
592 FloatReg n -> char 'F' <> int n
593 DoubleReg n -> char 'D' <> int n
594 LongReg n -> char 'L' <> int n
595 Sp -> ptext (sLit "Sp")
596 SpLim -> ptext (sLit "SpLim")
597 Hp -> ptext (sLit "Hp")
598 HpLim -> ptext (sLit "HpLim")
599 CurrentTSO -> ptext (sLit "CurrentTSO")
600 CurrentNursery -> ptext (sLit "CurrentNursery")
601 HpAlloc -> ptext (sLit "HpAlloc")
602 EagerBlackholeInfo -> ptext (sLit "stg_EAGER_BLACKHOLE_info")
603 GCEnter1 -> ptext (sLit "stg_gc_enter_1")
604 GCFun -> ptext (sLit "stg_gc_fun")
605 BaseReg -> ptext (sLit "BaseReg")
606 PicBaseReg -> ptext (sLit "PicBaseReg")
608 -- --------------------------------------------------------------------------
611 pprSection :: Section -> SDoc
612 pprSection s = case s of
613 Text -> section <+> doubleQuotes (ptext (sLit "text"))
614 Data -> section <+> doubleQuotes (ptext (sLit "data"))
615 ReadOnlyData -> section <+> doubleQuotes (ptext (sLit "readonly"))
616 ReadOnlyData16 -> section <+> doubleQuotes (ptext (sLit "readonly16"))
617 RelocatableReadOnlyData
618 -> section <+> doubleQuotes (ptext (sLit "relreadonly"))
619 UninitialisedData -> section <+> doubleQuotes (ptext (sLit "uninitialised"))
620 OtherSection s' -> section <+> doubleQuotes (text s')
622 section = ptext (sLit "section")
624 -----------------------------------------------------------------------------
626 commafy :: [SDoc] -> SDoc
627 commafy xs = fsep $ punctuate comma xs