compiler/cmm/ZipCfgCmmRep.hs

   1 -- This module is pure representation and should be imported only by
   2 -- clients that need to manipulate representation and know what
   3 -- they're doing.  Clients that need to create flow graphs should
   4 -- instead import MkZipCfgCmm.
   5
   6 module ZipCfgCmmRep
   7   ( CmmZ, CmmTopZ, CmmGraph, CmmBlock, CmmAGraph
   8   , Middle(..), Last(..), MidCallTarget(..), UpdFrameOffset
   9   , Convention(..), ForeignConvention(..), ForeignSafety(..)
  10   , ValueDirection(..), ForeignHint(..)
  11   , CmmBackwardFixedPoint, CmmForwardFixedPoint, pprHinted
  12   , insertBetween, mapExpMiddle, mapExpLast, mapExpDeepMiddle, mapExpDeepLast
  13   , foldExpMiddle, foldExpLast, foldExpDeepMiddle, foldExpDeepLast, joinOuts
  14   )
  15 where
  16
  17 import BlockId
  18 import CmmExpr
  19 import Cmm ( GenCmm(..), GenCmmTop(..), CmmStatic, CmmInfo
  20            , CallishMachOp(..), ForeignHint(..)
  21            , CmmActuals, CmmFormals, CmmHinted(..)
  22            , CmmStmt(..) -- imported in order to call ppr on Switch and to
  23                          -- implement pprCmmGraphLikeCmm
  24            )
  25 import DFMonad
  26 import PprCmm()
  27 import CmmTx
  28
  29 import CLabel
  30 import FastString
  31 import ForeignCall
  32 import qualified ZipCfg as Z
  33 import qualified ZipDataflow as DF
  34 import ZipCfg
  35 import MkZipCfg
  36 import Util
  37
  38 import BasicTypes
  39 import Maybes
  40 import Monad
  41 import Outputable
  42 import Prelude hiding (zip, unzip, last)
  43 import qualified Data.List as L
  44 import SMRep (ByteOff)
  45 import UniqSupply
  46
  47 ----------------------------------------------------------------------
  48 ----- Type synonyms and definitions
  49
  50 type CmmGraph                = LGraph Middle Last
  51 type CmmAGraph               = AGraph Middle Last
  52 type CmmBlock                = Block  Middle Last
  53 type CmmStackInfo            = (ByteOff, Maybe ByteOff)
  54   -- probably want a record; (SP offset on entry, update frame space)
  55 type CmmZ                    = GenCmm    CmmStatic CmmInfo (CmmStackInfo, CmmGraph)
  56 type CmmTopZ                 = GenCmmTop CmmStatic CmmInfo (CmmStackInfo, CmmGraph)
  57 type CmmBackwardFixedPoint a = DF.BackwardFixedPoint Middle Last a ()
  58 type CmmForwardFixedPoint  a = DF.ForwardFixedPoint  Middle Last a ()
  59
  60 type UpdFrameOffset = ByteOff
  61
  62 data Middle
  63   = MidComment FastString
  64
  65   | MidAssign CmmReg CmmExpr     -- Assign to register
  66
  67   | MidStore  CmmExpr CmmExpr    -- Assign to memory location.  Size is
  68                                  -- given by cmmExprType of the rhs.
  69
  70   | MidForeignCall               -- A foreign call; see Note [Foreign calls]
  71      ForeignSafety               -- Is it a safe or unsafe call?
  72      MidCallTarget               -- call target and convention
  73      CmmFormals                  -- zero or more results
  74      CmmActuals                  -- zero or more arguments
  75   deriving Eq
  76
  77 data Last
  78   = LastBranch BlockId  -- Goto another block in the same procedure
  79
  80   | LastCondBranch {            -- conditional branch
  81         cml_pred :: CmmExpr,
  82         cml_true, cml_false :: BlockId
  83     }
  84   | LastSwitch CmmExpr [Maybe BlockId]   -- Table branch
  85         -- The scrutinee is zero-based;
  86         --      zero -> first block
  87         --      one  -> second block etc
  88         -- Undefined outside range, and when there's a Nothing
  89   | LastCall {                   -- A call (native or safe foreign)
  90         cml_target  :: CmmExpr,  -- never a CmmPrim to a CallishMachOp!
  91         cml_cont    :: Maybe BlockId,
  92             -- BlockId of continuation (Nothing for return or tail call)
  93         cml_args    :: ByteOff,  -- byte offset for youngest outgoing arg
  94                                  -- (includes update frame, which must be younger)
  95         cml_ret_args:: ByteOff,  -- byte offset for youngest incoming arg
  96         cml_ret_off :: Maybe UpdFrameOffset}
  97           -- stack offset for return (update frames);
  98           -- The return offset should be Nothing only if we have to create
  99           -- a new call, e.g. for a procpoint, in which case it's an invariant
 100           -- that the call does not stand for a return or a tail call,
 101           -- and the successor does not need an info table.
 102
 103 data MidCallTarget      -- The target of a MidUnsafeCall
 104   = ForeignTarget       -- A foreign procedure
 105         CmmExpr                 -- Its address
 106         ForeignConvention       -- Its calling convention
 107
 108   | PrimTarget          -- A possibly-side-effecting machine operation
 109         CallishMachOp           -- Which one
 110   deriving Eq
 111
 112 data Convention
 113   = Native              -- Native C-- call/return
 114
 115   | Slow                -- Slow entry points: all args pushed on the stack
 116
 117   | GC                  -- Entry to the garbage collector: uses the node reg!
 118
 119   | PrimOp              -- Calling prim ops
 120
 121   | Foreign             -- Foreign call/return
 122         ForeignConvention
 123
 124   | Private
 125         -- Used for control transfers within a (pre-CPS) procedure All
 126         -- jump sites known, never pushed on the stack (hence no SRT)
 127         -- You can choose whatever calling convention you please
 128         -- (provided you make sure all the call sites agree)!
 129         -- This data type eventually to be extended to record the convention.
 130   deriving( Eq )
 131
 132 data ForeignConvention
 133   = ForeignConvention
 134         CCallConv               -- Which foreign-call convention
 135         [ForeignHint]           -- Extra info about the args
 136         [ForeignHint]           -- Extra info about the result
 137   deriving Eq
 138
 139 data ForeignSafety
 140   = Unsafe              -- unsafe call
 141   | Safe BlockId        -- making infotable requires: 1. label
 142          UpdFrameOffset --                            2. where the upd frame is
 143   deriving Eq
 144
 145 data ValueDirection = Arguments | Results
 146   -- Arguments go with procedure definitions, jumps, and arguments to calls
 147   -- Results go with returns and with results of calls.
 148   deriving Eq
 149
 150 {- Note [Foreign calls]
 151 ~~~~~~~~~~~~~~~~~~~~~~~
 152 A MidForeign call is used *all* foreign calls, both *unsafe* and *safe*.
 153 Unsafe ones are easy: think of them as a "fat machine instruction".
 154
 155 Safe ones are trickier.  A safe foreign call
 156      r = f(x)
 157 ultimately expands to
 158      push "return address"      -- Never used to return to;
 159                                 -- just points an info table
 160      save registers into TSO
 161      call suspendThread
 162      r = f(x)                   -- Make the call
 163      call resumeThread
 164      restore registers
 165      pop "return address"
 166 We cannot "lower" a safe foreign call to this sequence of Cmms, because
 167 after we've saved Sp all the Cmm optimiser's assumptions are broken.
 168 Furthermore, currently the smart Cmm constructors know the calling
 169 conventions for Haskell, the garbage collector, etc, and "lower" them
 170 so that a LastCall passes no parameters or results.  But the smart
 171 constructors do *not* (currently) know the foreign call conventions.
 172
 173 For these reasons use MidForeignCall for all calls. The only annoying thing
 174 is that a safe foreign call needs an info table.
 175 -}
 176
 177 ----------------------------------------------------------------------
 178 ----- Splicing between blocks
 179 -- Given a middle node, a block, and a successor BlockId,
 180 -- we can insert the middle node between the block and the successor.
 181 -- We return the updated block and a list of new blocks that must be added
 182 -- to the graph.
 183 -- The semantics is a bit tricky. We consider cases on the last node:
 184 -- o For a branch, we can just insert before the branch,
 185 --   but sometimes the optimizer does better if we actually insert
 186 --   a fresh basic block, enabling some common blockification.
 187 -- o For a conditional branch, switch statement, or call, we must insert
 188 --   a new basic block.
 189 -- o For a jump or return, this operation is impossible.
 190
 191 insertBetween :: MonadUnique m => CmmBlock -> [Middle] -> BlockId -> m (CmmBlock, [CmmBlock])
 192 insertBetween b ms succId = insert $ goto_end $ unzip b
 193   where insert (h, LastOther (LastBranch bid)) =
 194           if bid == succId then
 195             do (bid', bs) <- newBlocks
 196                return (zipht h (ZLast (LastOther (LastBranch bid'))), bs)
 197           else panic "tried invalid block insertBetween"
 198         insert (h, LastOther (LastCondBranch c t f)) =
 199           do (t', tbs) <- if t == succId then newBlocks else return $ (t, [])
 200              (f', fbs) <- if f == succId then newBlocks else return $ (f, [])
 201              return (zipht h $ ZLast $ LastOther (LastCondBranch c t' f'), tbs ++ fbs)
 202         insert (h, LastOther (LastSwitch e ks)) =
 203           do (ids, bs) <- mapAndUnzipM mbNewBlocks ks
 204              return (zipht h $ ZLast $ LastOther (LastSwitch e ids), join bs)
 205         insert (_, LastOther (LastCall {})) =
 206           panic "unimp: insertBetween after a call -- probably not a good idea"
 207         insert (_, LastExit) = panic "cannot insert after exit"
 208         newBlocks = do id <- liftM BlockId $ getUniqueM
 209                        return $ (id, [Block id $
 210                                    foldr ZTail (ZLast (LastOther (LastBranch succId))) ms])
 211         mbNewBlocks (Just k) = if k == succId then liftM lift newBlocks
 212                                else return (Just k, [])
 213         mbNewBlocks Nothing  = return (Nothing, [])
 214         lift (id, bs) = (Just id, bs)
 215
 216 ----------------------------------------------------------------------
 217 ----- Instance declarations for control flow
 218
 219 instance HavingSuccessors Last where
 220     succs = cmmSuccs
 221     fold_succs = fold_cmm_succs
 222
 223 instance LastNode Last where
 224     mkBranchNode id = LastBranch id
 225     isBranchNode (LastBranch _) = True
 226     isBranchNode _ = False
 227     branchNodeTarget (LastBranch id) = id
 228     branchNodeTarget _ = panic "asked for target of non-branch"
 229
 230 cmmSuccs :: Last -> [BlockId]
 231 cmmSuccs (LastBranch id)              = [id]
 232 cmmSuccs (LastCall _ Nothing   _ _ _) = []
 233 cmmSuccs (LastCall _ (Just id) _ _ _) = [id]
 234 cmmSuccs (LastCondBranch _ t f)       = [f, t]  -- meets layout constraint
 235 cmmSuccs (LastSwitch _ edges)         = catMaybes edges
 236
 237 fold_cmm_succs :: (BlockId -> a -> a) -> Last -> a -> a
 238 fold_cmm_succs  f (LastBranch id)              z = f id z
 239 fold_cmm_succs  _ (LastCall _ Nothing _ _ _)   z = z
 240 fold_cmm_succs  f (LastCall _ (Just id) _ _ _) z = f id z
 241 fold_cmm_succs  f (LastCondBranch _ te fe)     z = f te (f fe z)
 242 fold_cmm_succs  f (LastSwitch _ edges)         z = foldl (flip f) z $ catMaybes edges
 243
 244 ----------------------------------------------------------------------
 245 ----- Instance declarations for register use
 246
 247 instance UserOfLocalRegs Middle where
 248     foldRegsUsed f z m = middle m
 249       where middle (MidComment {})               = z
 250             middle (MidAssign _lhs expr)         = fold f z expr
 251             middle (MidStore addr rval)          = fold f (fold f z addr) rval
 252             middle (MidForeignCall _ tgt _ args) = fold f (fold f z tgt) args
 253             fold f z m = foldRegsUsed f z m  -- avoid monomorphism restriction
 254
 255 instance UserOfLocalRegs MidCallTarget where
 256   foldRegsUsed _f z (PrimTarget _)      = z
 257   foldRegsUsed f  z (ForeignTarget e _) = foldRegsUsed f z e
 258
 259 instance UserOfSlots MidCallTarget where
 260   foldSlotsUsed _f z (PrimTarget _)      = z
 261   foldSlotsUsed f  z (ForeignTarget e _) = foldSlotsUsed f z e
 262
 263 instance (UserOfLocalRegs a) => UserOfLocalRegs (Maybe a) where
 264   foldRegsUsed f z (Just x) = foldRegsUsed f z x
 265   foldRegsUsed _ z Nothing  = z
 266
 267 instance (UserOfSlots a) => UserOfSlots (Maybe a) where
 268   foldSlotsUsed f z (Just x) = foldSlotsUsed f z x
 269   foldSlotsUsed _ z Nothing  = z
 270
 271 instance UserOfLocalRegs Last where
 272     foldRegsUsed f z l = last l
 273       where last (LastBranch _id)       = z
 274             last (LastCall tgt _ _ _ _) = foldRegsUsed f z tgt
 275             last (LastCondBranch e _ _) = foldRegsUsed f z e
 276             last (LastSwitch e _tbl)    = foldRegsUsed f z e
 277
 278 instance DefinerOfLocalRegs Middle where
 279     foldRegsDefd f z m = middle m
 280       where middle (MidComment {})           = z
 281             middle (MidAssign lhs _)         = fold f z lhs
 282             middle (MidStore _ _)            = z
 283             middle (MidForeignCall _ _ fs _) = fold f z fs
 284             fold f z m = foldRegsDefd f z m  -- avoid monomorphism restriction
 285
 286 instance DefinerOfLocalRegs Last where
 287     foldRegsDefd _ z _ = z
 288
 289
 290 ----------------------------------------------------------------------
 291 ----- Instance declarations for stack slot use
 292
 293 instance UserOfSlots Middle where
 294     foldSlotsUsed f z m = middle m
 295       where middle (MidComment {})                   = z
 296             middle (MidAssign _lhs expr)             = fold f z expr
 297             middle (MidStore addr rval)              = fold f (fold f z addr) rval
 298             middle (MidForeignCall _ tgt _ress args) = fold f (fold f z tgt) args
 299             fold f z e = foldSlotsUsed f z e  -- avoid monomorphism restriction
 300
 301 instance UserOfSlots Last where
 302     foldSlotsUsed f z l = last l
 303       where last (LastBranch _id)       = z
 304             last (LastCall tgt _ _ _ _) = foldSlotsUsed f z tgt
 305             last (LastCondBranch e _ _) = foldSlotsUsed f z e
 306             last (LastSwitch e _tbl)    = foldSlotsUsed f z e
 307
 308 instance UserOfSlots l => UserOfSlots (ZLast l) where
 309     foldSlotsUsed f z (LastOther l) = foldSlotsUsed f z l
 310     foldSlotsUsed _ z LastExit      = z
 311
 312 instance DefinerOfSlots Middle where
 313     foldSlotsDefd f z m = middle m
 314       where middle (MidComment {})    = z
 315             middle (MidAssign _ _)    = z
 316             middle (MidForeignCall {}) = z
 317             middle (MidStore (CmmStackSlot a i) e) =
 318               f z (a, i, widthInBytes $ typeWidth $ cmmExprType e)
 319             middle (MidStore _ _)     = z
 320
 321 instance DefinerOfSlots Last where
 322     foldSlotsDefd _ z _ = z
 323
 324 instance DefinerOfSlots l => DefinerOfSlots (ZLast l) where
 325     foldSlotsDefd f z (LastOther l) = foldSlotsDefd f z l
 326     foldSlotsDefd _ z LastExit      = z
 327
 328 ----------------------------------------------------------------------
 329 ----- Code for manipulating Middle and Last nodes
 330
 331 mapExpMiddle :: (CmmExpr -> CmmExpr) -> Middle -> Middle
 332 mapExpMiddle _   m@(MidComment _)            = m
 333 mapExpMiddle exp   (MidAssign r e)           = MidAssign r (exp e)
 334 mapExpMiddle exp   (MidStore addr e)         = MidStore (exp addr) (exp e)
 335 mapExpMiddle exp   (MidForeignCall s tgt fs as) =
 336   MidForeignCall s (mapExpMidcall exp tgt) fs (map exp as)
 337
 338 foldExpMiddle :: (CmmExpr -> z -> z) -> Middle -> z -> z
 339 foldExpMiddle _   (MidComment _)              z = z
 340 foldExpMiddle exp (MidAssign _ e)             z = exp e z
 341 foldExpMiddle exp (MidStore addr e)           z = exp addr $ exp e z
 342 foldExpMiddle exp (MidForeignCall _ tgt _ as) z = foldExpMidcall exp tgt $ foldr exp z as
 343
 344 mapExpLast :: (CmmExpr -> CmmExpr) -> Last -> Last
 345 mapExpLast _   l@(LastBranch _)           = l
 346 mapExpLast exp (LastCondBranch e ti fi)   = LastCondBranch (exp e) ti fi
 347 mapExpLast exp (LastSwitch e tbl)         = LastSwitch (exp e) tbl
 348 mapExpLast exp (LastCall tgt mb_id o i s) = LastCall (exp tgt) mb_id o i s
 349
 350 foldExpLast :: (CmmExpr -> z -> z) -> Last -> z -> z
 351 foldExpLast _   (LastBranch _)         z = z
 352 foldExpLast exp (LastCondBranch e _ _) z = exp e z
 353 foldExpLast exp (LastSwitch e _)       z = exp e z
 354 foldExpLast exp (LastCall tgt _ _ _ _) z = exp tgt z
 355
 356 mapExpMidcall :: (CmmExpr -> CmmExpr) -> MidCallTarget -> MidCallTarget
 357 mapExpMidcall exp   (ForeignTarget e c) = ForeignTarget (exp e) c
 358 mapExpMidcall _   m@(PrimTarget _)      = m
 359
 360 foldExpMidcall :: (CmmExpr -> z -> z) -> MidCallTarget -> z -> z
 361 foldExpMidcall exp (ForeignTarget e _) z = exp e z
 362 foldExpMidcall _   (PrimTarget _)      z = z
 363
 364 -- Take a transformer on expressions and apply it recursively.
 365 wrapRecExp :: (CmmExpr -> CmmExpr) -> CmmExpr -> CmmExpr
 366 wrapRecExp f (CmmMachOp op es)    = f (CmmMachOp op $ map (wrapRecExp f) es)
 367 wrapRecExp f (CmmLoad addr ty)    = f (CmmLoad (wrapRecExp f addr) ty)
 368 wrapRecExp f e                    = f e
 369
 370 mapExpDeepMiddle :: (CmmExpr -> CmmExpr) -> Middle -> Middle
 371 mapExpDeepLast   :: (CmmExpr -> CmmExpr) -> Last   -> Last
 372 mapExpDeepMiddle f = mapExpMiddle $ wrapRecExp f
 373 mapExpDeepLast   f = mapExpLast   $ wrapRecExp f
 374
 375 -- Take a folder on expressions and apply it recursively.
 376 wrapRecExpf :: (CmmExpr -> z -> z) -> CmmExpr -> z -> z
 377 wrapRecExpf f e@(CmmMachOp _ es) z = foldr (wrapRecExpf f) (f e z) es
 378 wrapRecExpf f e@(CmmLoad addr _) z = wrapRecExpf f addr (f e z)
 379 wrapRecExpf f e                  z = f e z
 380
 381 foldExpDeepMiddle :: (CmmExpr -> z -> z) -> Middle -> z -> z
 382 foldExpDeepLast   :: (CmmExpr -> z -> z) -> Last   -> z -> z
 383 foldExpDeepMiddle f = foldExpMiddle $ wrapRecExpf f
 384 foldExpDeepLast   f = foldExpLast   $ wrapRecExpf f
 385
 386 ----------------------------------------------------------------------
 387 -- Compute the join of facts live out of a Last node. Useful for most backward
 388 -- analyses.
 389 joinOuts :: DataflowLattice a -> (BlockId -> a) -> Last -> a
 390 joinOuts lattice env l =
 391   let bot  = fact_bot lattice
 392       join x y = txVal $ fact_add_to lattice x y
 393   in case l of
 394        (LastBranch id)             -> env id
 395        (LastCall _ Nothing _ _ _)  -> bot
 396        (LastCall _ (Just k) _ _ _) -> env k
 397        (LastCondBranch _ t f)      -> join (env t) (env f)
 398        (LastSwitch _ tbl)          -> foldr join bot (map env $ catMaybes tbl)
 399
 400 ----------------------------------------------------------------------
 401 ----- Instance declarations for prettyprinting (avoids recursive imports)
 402
 403 instance Outputable Middle where
 404     ppr s = pprMiddle s
 405
 406 instance Outputable Last where
 407     ppr s = pprLast s
 408
 409 instance Outputable Convention where
 410     ppr = pprConvention
 411
 412 instance Outputable ForeignConvention where
 413     ppr = pprForeignConvention
 414
 415 instance Outputable ValueDirection where
 416     ppr Arguments = ptext $ sLit "args"
 417     ppr Results   = ptext $ sLit "results"
 418
 419 instance DF.DebugNodes Middle Last
 420
 421 debugPpr :: Bool
 422 debugPpr = debugIsOn
 423
 424 pprMiddle :: Middle -> SDoc
 425 pprMiddle stmt = pp_stmt <+> pp_debug
 426   where
 427     pp_stmt = case stmt of
 428         --  // text
 429         MidComment s -> text "//" <+> ftext s
 430
 431         -- reg = expr;
 432         MidAssign reg expr -> ppr reg <+> equals <+> ppr expr <> semi
 433
 434         -- rep[lv] = expr;
 435         MidStore lv expr -> rep <> brackets(ppr lv) <+> equals <+> ppr expr <> semi
 436             where
 437               rep = ppr ( cmmExprType expr )
 438
 439         -- call "ccall" foo(x, y)[r1, r2];
 440         -- ToDo ppr volatile
 441         MidForeignCall safety target results args ->
 442             hsep [ if null results
 443                       then empty
 444                       else parens (commafy $ map ppr results) <+> equals,
 445                       ppr_safety safety,
 446                    ptext $ sLit "call",
 447                    ppr_call_target target <> parens (commafy $ map ppr args) <> semi]
 448
 449     pp_debug =
 450       if not debugPpr then empty
 451       else text " //" <+>
 452            case stmt of
 453              MidComment     {} -> text "MidComment"
 454              MidAssign      {} -> text "MidAssign"
 455              MidStore       {} -> text "MidStore"
 456              MidForeignCall {} -> text "MidForeignCall"
 457
 458 ppr_fc :: ForeignConvention -> SDoc
 459 ppr_fc (ForeignConvention c _ _) = doubleQuotes (ppr c)
 460
 461 ppr_safety :: ForeignSafety -> SDoc
 462 ppr_safety (Safe bid upd) = text "safe<" <> ppr bid <> text ", " <> ppr upd <> text ">"
 463 ppr_safety Unsafe         = text "unsafe"
 464
 465 ppr_call_target :: MidCallTarget -> SDoc
 466 ppr_call_target (ForeignTarget fn c) = ppr_fc c <+> ppr_target fn
 467 ppr_call_target (PrimTarget op)      = ppr (CmmLabel (mkForeignLabel (mkFastString (show op)) Nothing False IsFunction))
 468
 469 ppr_target :: CmmExpr -> SDoc
 470 ppr_target t@(CmmLit _) = ppr t
 471 ppr_target fn'          = parens (ppr fn')
 472
 473 pprHinted :: Outputable a => CmmHinted a -> SDoc
 474 pprHinted (CmmHinted a NoHint)     = ppr a
 475 pprHinted (CmmHinted a AddrHint)   = doubleQuotes (text "address") <+> ppr a
 476 pprHinted (CmmHinted a SignedHint) = doubleQuotes (text "signed")  <+> ppr a
 477
 478 pprLast :: Last -> SDoc
 479 pprLast stmt = pp_stmt <+> pp_debug
 480   where
 481     pp_stmt = case stmt of
 482        LastBranch ident                -> ptext (sLit "goto") <+> ppr ident <> semi
 483        LastCondBranch expr t f         -> genFullCondBranch expr t f
 484        LastSwitch arg ids              -> ppr $ CmmSwitch arg ids
 485        LastCall tgt k out res updfr_off -> genBareCall tgt k out res updfr_off
 486
 487     pp_debug = text " //" <+> case stmt of
 488            LastBranch {} -> text "LastBranch"
 489            LastCondBranch {} -> text "LastCondBranch"
 490            LastSwitch {} -> text "LastSwitch"
 491            LastCall {} -> text "LastCall"
 492
 493 genBareCall :: CmmExpr -> Maybe BlockId -> ByteOff -> ByteOff ->
 494                           Maybe UpdFrameOffset -> SDoc
 495 genBareCall fn k out res updfr_off =
 496         hcat [ ptext (sLit "call"), space
 497              , pprFun fn, ptext (sLit "(...)"), space
 498              , ptext (sLit "returns to") <+> ppr k <+> parens (ppr out)
 499                                                    <+> parens (ppr res)
 500              , ptext (sLit " with update frame") <+> ppr updfr_off
 501              , semi ]
 502
 503 pprFun :: CmmExpr -> SDoc
 504 pprFun f@(CmmLit _) = ppr f
 505 pprFun f = parens (ppr f)
 506
 507 genFullCondBranch :: Outputable id => CmmExpr -> id -> id -> SDoc
 508 genFullCondBranch expr t f =
 509     hsep [ ptext (sLit "if")
 510          , parens(ppr expr)
 511          , ptext (sLit "goto")
 512          , ppr t <> semi
 513          , ptext (sLit "else goto")
 514          , ppr f <> semi
 515          ]
 516
 517 pprConvention :: Convention -> SDoc
 518 pprConvention (Native {})  = text "<native-convention>"
 519 pprConvention  Slow        = text "<slow-convention>"
 520 pprConvention  GC          = text "<gc-convention>"
 521 pprConvention  PrimOp      = text "<primop-convention>"
 522 pprConvention (Foreign c)  = ppr c
 523 pprConvention (Private {}) = text "<private-convention>"
 524
 525 pprForeignConvention :: ForeignConvention -> SDoc
 526 pprForeignConvention (ForeignConvention c as rs) = ppr c <> ppr as <> ppr rs
 527
 528 commafy :: [SDoc] -> SDoc
 529 commafy xs = hsep $ punctuate comma xs