import Cmm
import CmmUtils
import CLabel
+import BasicTypes
import ForeignCall
-import Unique
import Outputable
import FastString
-- Temp Jan08
import SMRep
import ClosureInfo
-#include "../includes/StgFun.h"
+#include "../includes/rts/storage/FunTypes.h"
pprCmms :: (Outputable info, Outputable g) => [GenCmm CmmStatic info g] -> SDoc
-----------------------------------------------------------------------------
pprCmm :: (Outputable d, Outputable info, Outputable g) => GenCmm d info g -> SDoc
-pprCmm (Cmm tops) = vcat $ intersperse (text "") $ map pprTop tops
+pprCmm (Cmm tops) = vcat $ intersperse blankLine $ map pprTop tops
-- --------------------------------------------------------------------------
-- Top level `procedure' blocks.
pprTop (CmmProc info lbl params graph )
- = vcat [ pprCLabel lbl <> parens (commafy $ map ppr params) <+> lbrace
+ = vcat [ pprCLabel lbl <> parens (commafy $ map ppr params)
, nest 8 $ lbrace <+> ppr info $$ rbrace
, nest 4 $ ppr graph
, rbrace ]
pprInfo :: CmmInfo -> SDoc
pprInfo (CmmInfo _gc_target update_frame CmmNonInfoTable) =
vcat [{-ptext (sLit "gc_target: ") <>
- maybe (ptext (sLit "<none>")) pprBlockId gc_target,-}
+ maybe (ptext (sLit "<none>")) ppr gc_target,-}
ptext (sLit "update_frame: ") <>
maybe (ptext (sLit "<none>")) pprUpdateFrame update_frame]
pprInfo (CmmInfo _gc_target update_frame
- (CmmInfoTable (ProfilingInfo closure_type closure_desc) tag info)) =
+ (CmmInfoTable stat_clos (ProfilingInfo closure_type closure_desc) tag info)) =
vcat [{-ptext (sLit "gc_target: ") <>
- maybe (ptext (sLit "<none>")) pprBlockId gc_target,-}
+ maybe (ptext (sLit "<none>")) ppr gc_target,-}
+ ptext (sLit "has static closure: ") <> ppr stat_clos <+>
ptext (sLit "update_frame: ") <>
maybe (ptext (sLit "<none>")) pprUpdateFrame update_frame,
ptext (sLit "type: ") <> pprLit closure_type,
-- lbl: stmt ; stmt ; ..
pprBBlock :: Outputable stmt => GenBasicBlock stmt -> SDoc
pprBBlock (BasicBlock ident stmts) =
- hang (pprBlockId ident <> colon) 4 (vcat (map ppr stmts))
+ hang (ppr ident <> colon) 4 (vcat (map ppr stmts))
-- --------------------------------------------------------------------------
-- Statements. C-- usually, exceptions to this should be obvious.
CmmCallConv -> empty
_ -> ptext (sLit("foreign")) <+> doubleQuotes (ppr cconv)
+ -- Call a CallishMachOp, like sin or cos that might be implemented as a library call.
CmmCall (CmmPrim op) results args safety ret ->
pprStmt (CmmCall (CmmCallee (CmmLit lbl) CCallConv)
results args safety ret)
where
- lbl = CmmLabel (mkForeignLabel (mkFastString (show op)) Nothing False)
+ -- HACK: A CallishMachOp doesn't really correspond to a ForeignLabel, but we
+ -- use one to get the label printed.
+ lbl = CmmLabel (mkForeignLabel
+ (mkFastString (show op))
+ Nothing ForeignLabelInThisPackage IsFunction)
CmmBranch ident -> genBranch ident
CmmCondBranch expr ident -> genCondBranch expr ident
--
genBranch :: BlockId -> SDoc
genBranch ident =
- ptext (sLit "goto") <+> pprBlockId ident <> semi
+ ptext (sLit "goto") <+> ppr ident <> semi
-- --------------------------------------------------------------------------
-- Conditional. [1], section 6.4
hsep [ ptext (sLit "if")
, parens(ppr expr)
, ptext (sLit "goto")
- , pprBlockId ident <> semi ]
+ , ppr ident <> semi ]
-- --------------------------------------------------------------------------
-- A tail call. [1], Section 6.9
in hsep [ ptext (sLit "case")
, hcat (punctuate comma (map int is))
, ptext (sLit ": goto")
- , pprBlockId (head [ id | Just id <- ids]) <> semi ]
+ , ppr (head [ id | Just id <- ids]) <> semi ]
-- --------------------------------------------------------------------------
-- Expressions
pprLit lit = case lit of
CmmInt i rep ->
hcat [ (if i < 0 then parens else id)(integer i)
- , (if rep == wordWidth
- then empty
- else space <> dcolon <+> ppr rep) ]
+ , ppUnless (rep == wordWidth) $
+ space <> dcolon <+> ppr rep ]
CmmFloat f rep -> hsep [ rational f, dcolon, ppr rep ]
CmmLabel clbl -> pprCLabel clbl
CmmLabelOff clbl i -> pprCLabel clbl <> ppr_offset i
CmmLabelDiffOff clbl1 clbl2 i -> pprCLabel clbl1 <> char '-'
<> pprCLabel clbl2 <> ppr_offset i
+ CmmBlock id -> ppr id
+ CmmHighStackMark -> text "<highSp>"
pprLit1 :: CmmLit -> SDoc
pprLit1 lit@(CmmLabelOff {}) = parens (pprLit lit)
where
section = ptext (sLit "section")
--- --------------------------------------------------------------------------
--- Basic block ids
---
-pprBlockId :: BlockId -> SDoc
-pprBlockId b = ppr $ getUnique b
-
-----------------------------------------------------------------------------
commafy :: [SDoc] -> SDoc