compiler/cmm/PprCmm.hs

   1 ----------------------------------------------------------------------------
   2 --
   3 -- Pretty-printing of Cmm as (a superset of) C--
   4 --
   5 -- (c) The University of Glasgow 2004-2006
   6 --
   7 -----------------------------------------------------------------------------
   8
   9 --
  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.
  13 --
  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.
  19 --
  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
  24 -- cases:
  25 --      1) if a value has wordRep type, the type is not appended in the
  26 --      output.
  27 --      2) MachOps that operate over wordRep type are printed in a
  28 --      C-style, rather than as their internal MachRep name.
  29 --
  30 -- These conventions produce much more readable Cmm output.
  31 --
  32 -- A useful example pass over Cmm is in nativeGen/MachCodeGen.hs
  33 --
  34
  35 module PprCmm
  36     ( writeCmms, pprCmms, pprCmm, pprStmt, pprExpr,
  37       pprSection, pprStatic, pprLit
  38     )
  39 where
  40
  41 import BlockId
  42 import Cmm
  43 import CmmUtils
  44 import CLabel
  45 import BasicTypes
  46
  47
  48 import ForeignCall
  49 import Outputable
  50 import FastString
  51
  52 import Data.List
  53 import System.IO
  54 import Data.Maybe
  55
  56 -- Temp Jan08
  57 import SMRep
  58 import ClosureInfo
  59 #include "../includes/rts/storage/FunTypes.h"
  60
  61
  62 pprCmms :: (Outputable info, Outputable g) => [GenCmm CmmStatic info g] -> SDoc
  63 pprCmms cmms = pprCode CStyle (vcat (intersperse separator $ map ppr cmms))
  64         where
  65           separator = space $$ ptext (sLit "-------------------") $$ space
  66
  67 writeCmms :: Handle -> [Cmm] -> IO ()
  68 writeCmms handle cmms = printForC handle (pprCmms cmms)
  69
  70 -----------------------------------------------------------------------------
  71
  72 instance (Outputable d, Outputable info, Outputable g)
  73     => Outputable (GenCmm d info g) where
  74     ppr c = pprCmm c
  75
  76 instance (Outputable d, Outputable info, Outputable i)
  77         => Outputable (GenCmmTop d info i) where
  78     ppr t = pprTop t
  79
  80 instance (Outputable instr) => Outputable (ListGraph instr) where
  81     ppr (ListGraph blocks) = vcat (map ppr blocks)
  82
  83 instance (Outputable instr) => Outputable (GenBasicBlock instr) where
  84     ppr b = pprBBlock b
  85
  86 instance Outputable CmmStmt where
  87     ppr s = pprStmt s
  88
  89 instance Outputable CmmExpr where
  90     ppr e = pprExpr e
  91
  92 instance Outputable CmmReg where
  93     ppr e = pprReg e
  94
  95 instance Outputable CmmLit where
  96     ppr l = pprLit l
  97
  98 instance Outputable LocalReg where
  99     ppr e = pprLocalReg e
 100
 101 instance Outputable Area where
 102     ppr e = pprArea e
 103
 104 instance Outputable GlobalReg where
 105     ppr e = pprGlobalReg e
 106
 107 instance Outputable CmmStatic where
 108     ppr e = pprStatic e
 109
 110 instance Outputable CmmInfo where
 111     ppr e = pprInfo e
 112
 113
 114
 115 -----------------------------------------------------------------------------
 116
 117 pprCmm :: (Outputable d, Outputable info, Outputable g) => GenCmm d info g -> SDoc
 118 pprCmm (Cmm tops) = vcat $ intersperse blankLine $ map pprTop tops
 119
 120 -- --------------------------------------------------------------------------
 121 -- Top level `procedure' blocks.
 122 --
 123 pprTop  :: (Outputable d, Outputable info, Outputable i)
 124         => GenCmmTop d info i -> SDoc
 125
 126 pprTop (CmmProc info lbl params graph )
 127
 128   = vcat [ pprCLabel lbl <> parens (commafy $ map ppr params)
 129          , nest 8 $ lbrace <+> ppr info $$ rbrace
 130          , nest 4 $ ppr graph
 131          , rbrace ]
 132
 133 -- --------------------------------------------------------------------------
 134 -- We follow [1], 4.5
 135 --
 136 --      section "data" { ... }
 137 --
 138 pprTop (CmmData section ds) =
 139     (hang (pprSection section <+> lbrace) 4 (vcat (map ppr ds)))
 140     $$ rbrace
 141
 142 -- --------------------------------------------------------------------------
 143 instance Outputable CmmSafety where
 144   ppr CmmUnsafe = ptext (sLit "_unsafe_call_")
 145   ppr (CmmSafe srt) = ppr srt
 146
 147 -- --------------------------------------------------------------------------
 148 -- Info tables. The current pretty printer needs refinement
 149 -- but will work for now.
 150 --
 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),
 170           pprTypeInfo info]
 171
 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),
 177           pprLit descr]
 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,
 182 -- Temp Jan08
 183           ptext (sLit ("fun_type: ")) <> integer (toInteger (argDescrType _args)),
 184
 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
 188          ]
 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]
 199
 200 -- Temp Jan08
 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
 207
 208 -- Temp Jan08
 209 isBigLiveness :: Liveness -> Bool
 210 isBigLiveness (BigLiveness _)   = True
 211 isBigLiveness (SmallLiveness _) = False
 212
 213
 214 pprUpdateFrame :: UpdateFrame -> SDoc
 215 pprUpdateFrame (UpdateFrame expr args) =
 216     hcat [ ptext (sLit "jump")
 217          , space
 218          , if isTrivialCmmExpr expr
 219                 then pprExpr expr
 220                 else case expr of
 221                     CmmLoad (CmmReg _) _ -> pprExpr expr
 222                     _ -> parens (pprExpr expr)
 223          , space
 224          , parens  ( commafy $ map ppr args ) ]
 225
 226
 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))
 233
 234 -- --------------------------------------------------------------------------
 235 -- Statements. C-- usually, exceptions to this should be obvious.
 236 --
 237 pprStmt :: CmmStmt -> SDoc
 238 pprStmt stmt = case stmt of
 239
 240     -- ;
 241     CmmNop -> semi
 242
 243     --  // text
 244     CmmComment s -> text "//" <+> ftext s
 245
 246     -- reg = expr;
 247     CmmAssign reg expr -> ppr reg <+> equals <+> ppr expr <> semi
 248
 249     -- rep[lv] = expr;
 250     CmmStore lv expr -> rep <> brackets(ppr lv) <+> equals <+> ppr expr <> semi
 251         where
 252           rep = ppr ( cmmExprType expr )
 253
 254     -- call "ccall" foo(x, y)[r1, r2];
 255     -- ToDo ppr volatile
 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")
 263              ] <> semi
 264         where
 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
 270                             _           -> ppr (ar,k)
 271           pp_conv = case cconv of
 272                       CmmCallConv -> empty
 273                       _           -> ptext (sLit("foreign")) <+> doubleQuotes (ppr cconv)
 274
 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)
 279         where
 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)
 285
 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
 291
 292 instance Outputable ForeignHint where
 293   ppr NoHint     = empty
 294   ppr SignedHint = quotes(text "signed")
 295 --  ppr AddrHint   = quotes(text "address")
 296 -- Temp Jan08
 297   ppr AddrHint   = (text "PtrHint")
 298
 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)
 303
 304 -- --------------------------------------------------------------------------
 305 -- goto local label. [1], section 6.6
 306 --
 307 --     goto lbl;
 308 --
 309 genBranch :: BlockId -> SDoc
 310 genBranch ident =
 311     ptext (sLit "goto") <+> ppr ident <> semi
 312
 313 -- --------------------------------------------------------------------------
 314 -- Conditional. [1], section 6.4
 315 --
 316 --     if (expr) { goto lbl; }
 317 --
 318 genCondBranch :: CmmExpr -> BlockId -> SDoc
 319 genCondBranch expr ident =
 320     hsep [ ptext (sLit "if")
 321          , parens(ppr expr)
 322          , ptext (sLit "goto")
 323          , ppr ident <> semi ]
 324
 325 -- --------------------------------------------------------------------------
 326 -- A tail call. [1], Section 6.9
 327 --
 328 --     jump foo(a, b, c);
 329 --
 330 genJump :: CmmExpr -> [CmmHinted CmmExpr] -> SDoc
 331 genJump expr args =
 332     hcat [ ptext (sLit "jump")
 333          , space
 334          , if isTrivialCmmExpr expr
 335                 then pprExpr expr
 336                 else case expr of
 337                     CmmLoad (CmmReg _) _ -> pprExpr expr
 338                     _ -> parens (pprExpr expr)
 339          , space
 340          , parens  ( commafy $ map ppr args )
 341          , semi ]
 342
 343
 344 -- --------------------------------------------------------------------------
 345 -- Return from a function. [1], Section 6.8.2 of version 1.128
 346 --
 347 --     return (a, b, c);
 348 --
 349 genReturn :: [CmmHinted CmmExpr] -> SDoc
 350 genReturn args =
 351     hcat [ ptext (sLit "return")
 352          , space
 353          , parens  ( commafy $ map ppr args )
 354          , semi ]
 355
 356 -- --------------------------------------------------------------------------
 357 -- Tabled jump to local label
 358 --
 359 -- The syntax is from [1], section 6.5
 360 --
 361 --      switch [0 .. n] (expr) { case ... ; }
 362 --
 363 genSwitch :: CmmExpr -> [Maybe BlockId] -> SDoc
 364 genSwitch expr maybe_ids
 365
 366     = let pairs = groupBy snds (zip [0 .. ] maybe_ids )
 367
 368       in hang (hcat [ ptext (sLit "switch [0 .. ")
 369                     , int (length maybe_ids - 1)
 370                     , ptext (sLit "] ")
 371                     , if isTrivialCmmExpr expr
 372                         then pprExpr expr
 373                         else parens (pprExpr expr)
 374                     , ptext (sLit " {")
 375                     ])
 376             4 (vcat ( map caseify pairs )) $$ rbrace
 377
 378     where
 379       snds a b = (snd a) == (snd b)
 380
 381       caseify :: [(Int,Maybe BlockId)] -> SDoc
 382       caseify ixs@((_,Nothing):_)
 383         = ptext (sLit "/* impossible: ") <> hcat (intersperse comma (map (int.fst) ixs))
 384                 <> ptext (sLit " */")
 385       caseify as
 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 ]
 391
 392 -- --------------------------------------------------------------------------
 393 -- Expressions
 394 --
 395
 396 pprExpr :: CmmExpr -> SDoc
 397 pprExpr e
 398     = case e of
 399         CmmRegOff reg i ->
 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
 404         _other     -> pprExpr1 e
 405
 406 -- Here's the precedence table from CmmParse.y:
 407 -- %nonassoc '>=' '>' '<=' '<' '!=' '=='
 408 -- %left '|'
 409 -- %left '^'
 410 -- %left '&'
 411 -- %left '>>' '<<'
 412 -- %left '-' '+'
 413 -- %left '/' '*' '%'
 414 -- %right '~'
 415
 416 -- We just cope with the common operators for now, the rest will get
 417 -- a default conservative behaviour.
 418
 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
 424
 425 infixMachOp1, infixMachOp7, infixMachOp8 :: MachOp -> Maybe SDoc
 426
 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
 436
 437 -- %left '-' '+'
 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
 443
 444 infixMachOp7 (MO_Add _)  = Just (char '+')
 445 infixMachOp7 (MO_Sub _)  = Just (char '-')
 446 infixMachOp7 _           = Nothing
 447
 448 -- %left '/' '*' '%'
 449 pprExpr8 (CmmMachOp op [x,y]) | Just doc <- infixMachOp8 op
 450    = pprExpr8 x <+> doc <+> pprExpr9 y
 451 pprExpr8 e = pprExpr9 e
 452
 453 infixMachOp8 (MO_U_Quot _) = Just (char '/')
 454 infixMachOp8 (MO_Mul _)    = Just (char '*')
 455 infixMachOp8 (MO_U_Rem _)  = Just (char '%')
 456 infixMachOp8 _             = Nothing
 457
 458 pprExpr9 :: CmmExpr -> SDoc
 459 pprExpr9 e =
 460    case e of
 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
 467
 468 genMachOp :: MachOp -> [CmmExpr] -> SDoc
 469 genMachOp mop args
 470    | Just doc <- infixMachOp mop = case args of
 471         -- dyadic
 472         [x,y] -> pprExpr9 x <+> doc <+> pprExpr9 y
 473
 474         -- unary
 475         [x]   -> doc <> pprExpr9 x
 476
 477         _     -> pprTrace "PprCmm.genMachOp: machop with strange number of args"
 478                           (pprMachOp mop <+>
 479                             parens (hcat $ punctuate comma (map pprExpr args)))
 480                           empty
 481
 482    | isJust (infixMachOp1 mop)
 483    || isJust (infixMachOp7 mop)
 484    || isJust (infixMachOp8 mop)  = parens (pprExpr (CmmMachOp mop args))
 485
 486    | otherwise = char '%' <> ppr_op <> parens (commafy (map pprExpr args))
 487         where ppr_op = text (map (\c -> if c == ' ' then '_' else c)
 488                                  (show mop))
 489                 -- replace spaces in (show mop) with underscores,
 490
 491 --
 492 -- Unsigned ops on the word size of the machine get nice symbols.
 493 -- All else get dumped in their ugly format.
 494 --
 495 infixMachOp :: MachOp -> Maybe SDoc
 496 infixMachOp mop
 497         = case mop of
 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 :)
 503             _ -> Nothing
 504
 505 -- --------------------------------------------------------------------------
 506 -- Literals.
 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
 509 --
 510 pprLit :: CmmLit -> SDoc
 511 pprLit lit = case lit of
 512     CmmInt i rep ->
 513         hcat [ (if i < 0 then parens else id)(integer i)
 514              , ppUnless (rep == wordWidth) $
 515                space <> dcolon <+> ppr rep ]
 516
 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>"
 524
 525 pprLit1 :: CmmLit -> SDoc
 526 pprLit1 lit@(CmmLabelOff {}) = parens (pprLit lit)
 527 pprLit1 lit                  = pprLit lit
 528
 529 ppr_offset :: Int -> SDoc
 530 ppr_offset i
 531     | i==0      = empty
 532     | i>=0      = char '+' <> int i
 533     | otherwise = char '-' <> int (-i)
 534
 535 -- --------------------------------------------------------------------------
 536 -- Static data.
 537 --      Strings are printed as C strings, and we print them as I8[],
 538 --      following C--
 539 --
 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')
 547
 548 -- --------------------------------------------------------------------------
 549 -- Registers, whether local (temps) or global
 550 --
 551 pprReg :: CmmReg -> SDoc
 552 pprReg r
 553     = case r of
 554         CmmLocal  local  -> pprLocalReg  local
 555         CmmGlobal global -> pprGlobalReg global
 556
 557 --
 558 -- We only print the type of the local reg if it isn't wordRep
 559 --
 560 pprLocalReg :: LocalReg -> SDoc
 561 pprLocalReg (LocalReg uniq rep)
 562 --   = ppr rep <> char '_' <> ppr uniq
 563 -- Temp Jan08
 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)
 568    where
 569      ptr = empty
 570          --if isGcPtrType rep
 571          --      then doubleQuotes (text "ptr")
 572          --      else empty
 573
 574 -- Stack areas
 575 pprArea :: Area -> SDoc
 576 pprArea (RegSlot r)   = hcat [ text "slot<", ppr r, text ">" ]
 577 pprArea (CallArea id) = pprAreaId id
 578
 579 pprAreaId :: AreaId -> SDoc
 580 pprAreaId Old        = text "old"
 581 pprAreaId (Young id) = hcat [ text "young<", ppr id, text ">" ]
 582
 583 -- needs to be kept in syn with Cmm.hs.GlobalReg
 584 --
 585 pprGlobalReg :: GlobalReg -> SDoc
 586 pprGlobalReg gr
 587     = case gr of
 588         VanillaReg n _ -> char 'R' <> int n
 589 -- Temp Jan08
 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")
 607
 608 -- --------------------------------------------------------------------------
 609 -- data sections
 610 --
 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')
 621  where
 622     section = ptext (sLit "section")
 623
 624 -----------------------------------------------------------------------------
 625
 626 commafy :: [SDoc] -> SDoc
 627 commafy xs = fsep $ punctuate comma xs