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
269 ppr_ar :: Outputable a => CmmHinted a -> SDoc
270 ppr_ar (CmmHinted ar k) = case cconv of
271 CmmCallConv -> ppr ar
273 pp_conv = case cconv of
275 _ -> ptext (sLit("foreign")) <+> doubleQuotes (ppr cconv)
277 -- Call a CallishMachOp, like sin or cos that might be implemented as a library call.
278 CmmCall (CmmPrim op) results args safety ret ->
279 pprStmt (CmmCall (CmmCallee (CmmLit lbl) CCallConv)
280 results args safety ret)
282 -- HACK: A CallishMachOp doesn't really correspond to a ForeignLabel, but we
283 -- use one to get the label printed.
284 lbl = CmmLabel (mkForeignLabel
285 (mkFastString (show op))
286 Nothing ForeignLabelInThisPackage IsFunction)
288 CmmBranch ident -> genBranch ident
289 CmmCondBranch expr ident -> genCondBranch expr ident
290 CmmJump expr params -> genJump expr params
291 CmmReturn params -> genReturn params
292 CmmSwitch arg ids -> genSwitch arg ids
294 instance Outputable ForeignHint where
296 ppr SignedHint = quotes(text "signed")
297 -- ppr AddrHint = quotes(text "address")
299 ppr AddrHint = (text "PtrHint")
301 -- Just look like a tuple, since it was a tuple before
302 -- ... is that a good idea? --Isaac Dupree
303 instance (Outputable a) => Outputable (CmmHinted a) where
304 ppr (CmmHinted a k) = ppr (a, k)
306 -- --------------------------------------------------------------------------
307 -- goto local label. [1], section 6.6
311 genBranch :: BlockId -> SDoc
313 ptext (sLit "goto") <+> ppr ident <> semi
315 -- --------------------------------------------------------------------------
316 -- Conditional. [1], section 6.4
318 -- if (expr) { goto lbl; }
320 genCondBranch :: CmmExpr -> BlockId -> SDoc
321 genCondBranch expr ident =
322 hsep [ ptext (sLit "if")
324 , ptext (sLit "goto")
325 , ppr ident <> semi ]
327 -- --------------------------------------------------------------------------
328 -- A tail call. [1], Section 6.9
330 -- jump foo(a, b, c);
332 genJump :: CmmExpr -> [CmmHinted CmmExpr] -> SDoc
334 hcat [ ptext (sLit "jump")
336 , if isTrivialCmmExpr expr
339 CmmLoad (CmmReg _) _ -> pprExpr expr
340 _ -> parens (pprExpr expr)
342 , parens ( commafy $ map ppr args )
346 -- --------------------------------------------------------------------------
347 -- Return from a function. [1], Section 6.8.2 of version 1.128
351 genReturn :: [CmmHinted CmmExpr] -> SDoc
353 hcat [ ptext (sLit "return")
355 , parens ( commafy $ map ppr args )
358 -- --------------------------------------------------------------------------
359 -- Tabled jump to local label
361 -- The syntax is from [1], section 6.5
363 -- switch [0 .. n] (expr) { case ... ; }
365 genSwitch :: CmmExpr -> [Maybe BlockId] -> SDoc
366 genSwitch expr maybe_ids
368 = let pairs = groupBy snds (zip [0 .. ] maybe_ids )
370 in hang (hcat [ ptext (sLit "switch [0 .. ")
371 , int (length maybe_ids - 1)
373 , if isTrivialCmmExpr expr
375 else parens (pprExpr expr)
378 4 (vcat ( map caseify pairs )) $$ rbrace
381 snds a b = (snd a) == (snd b)
383 caseify :: [(Int,Maybe BlockId)] -> SDoc
384 caseify ixs@((_,Nothing):_)
385 = ptext (sLit "/* impossible: ") <> hcat (intersperse comma (map (int.fst) ixs))
386 <> ptext (sLit " */")
388 = let (is,ids) = unzip as
389 in hsep [ ptext (sLit "case")
390 , hcat (punctuate comma (map int is))
391 , ptext (sLit ": goto")
392 , ppr (head [ id | Just id <- ids]) <> semi ]
394 -- --------------------------------------------------------------------------
398 pprExpr :: CmmExpr -> SDoc
402 pprExpr (CmmMachOp (MO_Add rep)
403 [CmmReg reg, CmmLit (CmmInt (fromIntegral i) rep)])
404 where rep = typeWidth (cmmRegType reg)
405 CmmLit lit -> pprLit lit
408 -- Here's the precedence table from CmmParse.y:
409 -- %nonassoc '>=' '>' '<=' '<' '!=' '=='
418 -- We just cope with the common operators for now, the rest will get
419 -- a default conservative behaviour.
421 -- %nonassoc '>=' '>' '<=' '<' '!=' '=='
422 pprExpr1, pprExpr7, pprExpr8 :: CmmExpr -> SDoc
423 pprExpr1 (CmmMachOp op [x,y]) | Just doc <- infixMachOp1 op
424 = pprExpr7 x <+> doc <+> pprExpr7 y
425 pprExpr1 e = pprExpr7 e
427 infixMachOp1, infixMachOp7, infixMachOp8 :: MachOp -> Maybe SDoc
429 infixMachOp1 (MO_Eq _) = Just (ptext (sLit "=="))
430 infixMachOp1 (MO_Ne _) = Just (ptext (sLit "!="))
431 infixMachOp1 (MO_Shl _) = Just (ptext (sLit "<<"))
432 infixMachOp1 (MO_U_Shr _) = Just (ptext (sLit ">>"))
433 infixMachOp1 (MO_U_Ge _) = Just (ptext (sLit ">="))
434 infixMachOp1 (MO_U_Le _) = Just (ptext (sLit "<="))
435 infixMachOp1 (MO_U_Gt _) = Just (char '>')
436 infixMachOp1 (MO_U_Lt _) = Just (char '<')
437 infixMachOp1 _ = Nothing
440 pprExpr7 (CmmMachOp (MO_Add rep1) [x, CmmLit (CmmInt i rep2)]) | i < 0
441 = pprExpr7 (CmmMachOp (MO_Sub rep1) [x, CmmLit (CmmInt (negate i) rep2)])
442 pprExpr7 (CmmMachOp op [x,y]) | Just doc <- infixMachOp7 op
443 = pprExpr7 x <+> doc <+> pprExpr8 y
444 pprExpr7 e = pprExpr8 e
446 infixMachOp7 (MO_Add _) = Just (char '+')
447 infixMachOp7 (MO_Sub _) = Just (char '-')
448 infixMachOp7 _ = Nothing
451 pprExpr8 (CmmMachOp op [x,y]) | Just doc <- infixMachOp8 op
452 = pprExpr8 x <+> doc <+> pprExpr9 y
453 pprExpr8 e = pprExpr9 e
455 infixMachOp8 (MO_U_Quot _) = Just (char '/')
456 infixMachOp8 (MO_Mul _) = Just (char '*')
457 infixMachOp8 (MO_U_Rem _) = Just (char '%')
458 infixMachOp8 _ = Nothing
460 pprExpr9 :: CmmExpr -> SDoc
463 CmmLit lit -> pprLit1 lit
464 CmmLoad expr rep -> ppr rep <> brackets( ppr expr )
465 CmmReg reg -> ppr reg
466 CmmRegOff reg off -> parens (ppr reg <+> char '+' <+> int off)
467 CmmStackSlot a off -> parens (ppr a <+> char '+' <+> int off)
468 CmmMachOp mop args -> genMachOp mop args
470 genMachOp :: MachOp -> [CmmExpr] -> SDoc
472 | Just doc <- infixMachOp mop = case args of
474 [x,y] -> pprExpr9 x <+> doc <+> pprExpr9 y
477 [x] -> doc <> pprExpr9 x
479 _ -> pprTrace "PprCmm.genMachOp: machop with strange number of args"
481 parens (hcat $ punctuate comma (map pprExpr args)))
484 | isJust (infixMachOp1 mop)
485 || isJust (infixMachOp7 mop)
486 || isJust (infixMachOp8 mop) = parens (pprExpr (CmmMachOp mop args))
488 | otherwise = char '%' <> ppr_op <> parens (commafy (map pprExpr args))
489 where ppr_op = text (map (\c -> if c == ' ' then '_' else c)
491 -- replace spaces in (show mop) with underscores,
494 -- Unsigned ops on the word size of the machine get nice symbols.
495 -- All else get dumped in their ugly format.
497 infixMachOp :: MachOp -> Maybe SDoc
500 MO_And _ -> Just $ char '&'
501 MO_Or _ -> Just $ char '|'
502 MO_Xor _ -> Just $ char '^'
503 MO_Not _ -> Just $ char '~'
504 MO_S_Neg _ -> Just $ char '-' -- there is no unsigned neg :)
507 -- --------------------------------------------------------------------------
509 -- To minimise line noise we adopt the convention that if the literal
510 -- has the natural machine word size, we do not append the type
512 pprLit :: CmmLit -> SDoc
513 pprLit lit = case lit of
515 hcat [ (if i < 0 then parens else id)(integer i)
516 , ppUnless (rep == wordWidth) $
517 space <> dcolon <+> ppr rep ]
519 CmmFloat f rep -> hsep [ rational f, dcolon, ppr rep ]
520 CmmLabel clbl -> pprCLabel clbl
521 CmmLabelOff clbl i -> pprCLabel clbl <> ppr_offset i
522 CmmLabelDiffOff clbl1 clbl2 i -> pprCLabel clbl1 <> char '-'
523 <> pprCLabel clbl2 <> ppr_offset i
524 CmmBlock id -> ppr id
525 CmmHighStackMark -> text "<highSp>"
527 pprLit1 :: CmmLit -> SDoc
528 pprLit1 lit@(CmmLabelOff {}) = parens (pprLit lit)
529 pprLit1 lit = pprLit lit
531 ppr_offset :: Int -> SDoc
534 | i>=0 = char '+' <> int i
535 | otherwise = char '-' <> int (-i)
537 -- --------------------------------------------------------------------------
539 -- Strings are printed as C strings, and we print them as I8[],
542 pprStatic :: CmmStatic -> SDoc
543 pprStatic s = case s of
544 CmmStaticLit lit -> nest 4 $ ptext (sLit "const") <+> pprLit lit <> semi
545 CmmUninitialised i -> nest 4 $ text "I8" <> brackets (int i)
546 CmmAlign i -> nest 4 $ text "align" <+> int i
547 CmmDataLabel clbl -> pprCLabel clbl <> colon
548 CmmString s' -> nest 4 $ text "I8[]" <+> text (show s')
550 -- --------------------------------------------------------------------------
551 -- Registers, whether local (temps) or global
553 pprReg :: CmmReg -> SDoc
556 CmmLocal local -> pprLocalReg local
557 CmmGlobal global -> pprGlobalReg global
560 -- We only print the type of the local reg if it isn't wordRep
562 pprLocalReg :: LocalReg -> SDoc
563 pprLocalReg (LocalReg uniq rep)
564 -- = ppr rep <> char '_' <> ppr uniq
566 = char '_' <> ppr uniq <>
567 (if isWord32 rep -- && not (isGcPtrType rep) -- Temp Jan08 -- sigh
568 then dcolon <> ptr <> ppr rep
569 else dcolon <> ptr <> ppr rep)
573 -- then doubleQuotes (text "ptr")
577 pprArea :: Area -> SDoc
578 pprArea (RegSlot r) = hcat [ text "slot<", ppr r, text ">" ]
579 pprArea (CallArea id) = pprAreaId id
581 pprAreaId :: AreaId -> SDoc
582 pprAreaId Old = text "old"
583 pprAreaId (Young id) = hcat [ text "young<", ppr id, text ">" ]
585 -- needs to be kept in syn with Cmm.hs.GlobalReg
587 pprGlobalReg :: GlobalReg -> SDoc
590 VanillaReg n _ -> char 'R' <> int n
592 -- VanillaReg n VNonGcPtr -> char 'R' <> int n
593 -- VanillaReg n VGcPtr -> char 'P' <> int n
594 FloatReg n -> char 'F' <> int n
595 DoubleReg n -> char 'D' <> int n
596 LongReg n -> char 'L' <> int n
597 Sp -> ptext (sLit "Sp")
598 SpLim -> ptext (sLit "SpLim")
599 Hp -> ptext (sLit "Hp")
600 HpLim -> ptext (sLit "HpLim")
601 CurrentTSO -> ptext (sLit "CurrentTSO")
602 CurrentNursery -> ptext (sLit "CurrentNursery")
603 HpAlloc -> ptext (sLit "HpAlloc")
604 EagerBlackholeInfo -> ptext (sLit "stg_EAGER_BLACKHOLE_info")
605 GCEnter1 -> ptext (sLit "stg_gc_enter_1")
606 GCFun -> ptext (sLit "stg_gc_fun")
607 BaseReg -> ptext (sLit "BaseReg")
608 PicBaseReg -> ptext (sLit "PicBaseReg")
610 -- --------------------------------------------------------------------------
613 pprSection :: Section -> SDoc
614 pprSection s = case s of
615 Text -> section <+> doubleQuotes (ptext (sLit "text"))
616 Data -> section <+> doubleQuotes (ptext (sLit "data"))
617 ReadOnlyData -> section <+> doubleQuotes (ptext (sLit "readonly"))
618 ReadOnlyData16 -> section <+> doubleQuotes (ptext (sLit "readonly16"))
619 RelocatableReadOnlyData
620 -> section <+> doubleQuotes (ptext (sLit "relreadonly"))
621 UninitialisedData -> section <+> doubleQuotes (ptext (sLit "uninitialised"))
622 OtherSection s' -> section <+> doubleQuotes (text s')
624 section = ptext (sLit "section")
626 -----------------------------------------------------------------------------
628 commafy :: [SDoc] -> SDoc
629 commafy xs = fsep $ punctuate comma xs