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