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