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