remove remaining redundancies from ZipCfgCmmRep
authorNorman Ramsey <nr@eecs.harvard.edu>
Wed, 12 Sep 2007 16:58:51 +0000 (16:58 +0000)
committerNorman Ramsey <nr@eecs.harvard.edu>
Wed, 12 Sep 2007 16:58:51 +0000 (16:58 +0000)
  -- LastBranch no longer takes parameters
  -- LastJump and LastReturn no longer carry CmmActuals;
     instead, those are carried by a CopyOut in the same basic block

compiler/cmm/CmmContFlowOpt.hs
compiler/cmm/CmmCvt.hs
compiler/cmm/CmmLiveZ.hs
compiler/cmm/CmmProcPointZ.hs
compiler/cmm/CmmSpillReload.hs
compiler/cmm/Dataflow.hs
compiler/cmm/MkZipCfgCmm.hs
compiler/cmm/PprCmmZ.hs
compiler/cmm/ZipCfgCmmRep.hs

index 022b2dd..8f4e3f5 100644 (file)
@@ -85,7 +85,7 @@ branchChainElimZ g@(G.LGraph eid _)
     lookup id = G.lookupBlockEnv env id `orElse` id 
 
 isLoneBranchZ :: CmmBlock -> Either (G.BlockId, G.BlockId) CmmBlock
     lookup id = G.lookupBlockEnv env id `orElse` id 
 
 isLoneBranchZ :: CmmBlock -> Either (G.BlockId, G.BlockId) CmmBlock
-isLoneBranchZ (G.Block id (G.ZLast (G.LastOther (LastBranch target []))))
+isLoneBranchZ (G.Block id (G.ZLast (G.LastOther (LastBranch target))))
     | id /= target  = Left (id,target)
 isLoneBranchZ other = Right other
    -- ^ An infinite loop is not a link in a branch chain!
     | id /= target  = Left (id,target)
 isLoneBranchZ other = Right other
    -- ^ An infinite loop is not a link in a branch chain!
@@ -94,7 +94,7 @@ replaceLabelsZ :: BlockEnv G.BlockId -> CmmGraph -> CmmGraph
 replaceLabelsZ env = replace_eid . G.map_nodes id id last
   where
     replace_eid (G.LGraph eid blocks) = G.LGraph (lookup eid) blocks
 replaceLabelsZ env = replace_eid . G.map_nodes id id last
   where
     replace_eid (G.LGraph eid blocks) = G.LGraph (lookup eid) blocks
-    last (LastBranch id args)         = LastBranch (lookup id) args
+    last (LastBranch id)              = LastBranch (lookup id)
     last (LastCondBranch e ti fi)     = LastCondBranch e (lookup ti) (lookup fi)
     last (LastSwitch e tbl)           = LastSwitch e (map (fmap lookup) tbl)
     last (LastCall tgt (Just id))     = LastCall tgt (Just $ lookup id) 
     last (LastCondBranch e ti fi)     = LastCondBranch e (lookup ti) (lookup fi)
     last (LastSwitch e tbl)           = LastSwitch e (map (fmap lookup) tbl)
     last (LastCall tgt (Just id))     = LastCall tgt (Just $ lookup id) 
index ae336b5..7beeb6b 100644 (file)
@@ -95,8 +95,7 @@ ofZgraph g = ListGraph $ swallow blocks
           last id prev' out l n =
             let endblock stmt = block' id (stmt : prev') : swallow n in
             case l of
           last id prev' out l n =
             let endblock stmt = block' id (stmt : prev') : swallow n in
             case l of
-              LastBranch _ (_:_) -> panic "unrepresentable branch"
-              LastBranch tgt [] ->
+              LastBranch tgt ->
                   case n of
                     G.Block id' t : bs
                         | tgt == id', unique_pred id' 
                   case n of
                     G.Block id' t : bs
                         | tgt == id', unique_pred id' 
@@ -116,8 +115,8 @@ ofZgraph g = ListGraph $ swallow blocks
                                  tail id (CmmCondBranch e'   fid : prev') Nothing t bs
                     _ -> let instrs' = CmmBranch fid : CmmCondBranch expr tid : prev'
                          in block' id instrs' : swallow n
                                  tail id (CmmCondBranch e'   fid : prev') Nothing t bs
                     _ -> let instrs' = CmmBranch fid : CmmCondBranch expr tid : prev'
                          in block' id instrs' : swallow n
-              LastJump expr params -> endblock $ CmmJump expr params 
-              LastReturn params    -> endblock $ CmmReturn params
+              LastJump expr        -> endblock $ with_out out $ CmmJump expr
+              LastReturn           -> endblock $ with_out out $ CmmReturn 
               LastSwitch arg ids   -> endblock $ CmmSwitch arg $ ids
               LastCall e cont
                   | Just (conv, args) <- out
               LastSwitch arg ids   -> endblock $ CmmSwitch arg $ ids
               LastCall e cont
                   | Just (conv, args) <- out
@@ -137,6 +136,8 @@ ofZgraph g = ListGraph $ swallow blocks
                             in  tail id (delayed : call : prev') Nothing t bs
                          | otherwise -> panic "unrepairable call"
                   | otherwise -> panic "call with no CopyOut"
                             in  tail id (delayed : call : prev') Nothing t bs
                          | otherwise -> panic "unrepairable call"
                   | otherwise -> panic "call with no CopyOut"
+          with_out (Just (_conv, actuals)) f = f actuals
+          with_out Nothing f = pprPanic "unrepairable data flow to" (ppr $ f [])
           findCopyIn (G.ZTail (CopyIn _ ress srt) _) = (ress, srt)
           findCopyIn (G.ZTail _ t) = findCopyIn t
           findCopyIn (G.ZLast _) = panic "missing CopyIn after call"
           findCopyIn (G.ZTail (CopyIn _ ress srt) _) = (ress, srt)
           findCopyIn (G.ZTail _ t) = findCopyIn t
           findCopyIn (G.ZLast _) = panic "missing CopyIn after call"
index 8a5d36c..2b502d5 100644 (file)
@@ -67,9 +67,9 @@ middleLiveness m = middle m
 
 lastLiveness :: Last -> (BlockId -> CmmLive) -> CmmLive
 lastLiveness l env = last l
 
 lastLiveness :: Last -> (BlockId -> CmmLive) -> CmmLive
 lastLiveness l env = last l
-  where last (LastReturn ress)       = gen ress emptyUniqSet
-        last (LastJump e args)       = gen e $ gen args emptyUniqSet
-        last (LastBranch id args)    = gen args $ env id
+  where last (LastReturn)            = emptyUniqSet
+        last (LastJump e)            = gen e $ emptyUniqSet
+        last (LastBranch id)         = env id
         last (LastCall tgt (Just k)) = gen tgt $ env k
         last (LastCall tgt Nothing)  = gen tgt $ emptyUniqSet
         last (LastCondBranch e t f)  = gen e $ unionUniqSets (env t) (env f)
         last (LastCall tgt (Just k)) = gen tgt $ env k
         last (LastCall tgt Nothing)  = gen tgt $ emptyUniqSet
         last (LastCondBranch e t f)  = gen e $ unionUniqSets (env t) (env f)
index e250bf3..ac016a7 100644 (file)
@@ -246,7 +246,7 @@ addProcPointProtocols procPoints formals g =
               let (Block _ t) = lookupBlockEnv (lg_blocks g) id `orElse`
                                 panic "jump out of graph"
               in case t of
               let (Block _ t) = lookupBlockEnv (lg_blocks g) id `orElse`
                                 panic "jump out of graph"
               in case t of
-                   ZTail (CopyIn {}) (ZLast (LastOther (LastBranch pee [])))
+                   ZTail (CopyIn {}) (ZLast (LastOther (LastBranch pee)))
                        | elemBlockSet pee procPoints -> Just pee
                    _ -> Nothing
           init_protocols = fold_blocks maybe_add_proto emptyBlockEnv g
                        | elemBlockSet pee procPoints -> Just pee
                    _ -> Nothing
           init_protocols = fold_blocks maybe_add_proto emptyBlockEnv g
index 7d4f42c..63e0058 100644 (file)
@@ -113,9 +113,9 @@ middleDualLiveness live (NotSpillOrReload m) = changeRegs (middleLiveness m) liv
 
 lastDualLiveness :: (BlockId -> DualLive) -> Last -> DualLive
 lastDualLiveness env l = last l
 
 lastDualLiveness :: (BlockId -> DualLive) -> Last -> DualLive
 lastDualLiveness env l = last l
-  where last (LastReturn ress)       = changeRegs (gen ress) empty
-        last (LastJump e args)       = changeRegs (gen e . gen args) empty
-        last (LastBranch id args)    = changeRegs (gen args) $ env id
+  where last (LastReturn)            = empty
+        last (LastJump e)            = changeRegs (gen e) empty
+        last (LastBranch id)         = env id
         last (LastCall tgt Nothing)  = changeRegs (gen tgt) empty
         last (LastCall tgt (Just k)) = 
             -- nothing can be live in registers at this point
         last (LastCall tgt Nothing)  = changeRegs (gen tgt) empty
         last (LastCall tgt (Just k)) = 
             -- nothing can be live in registers at this point
index 35cf266..35fdebb 100644 (file)
@@ -1,9 +1,4 @@
-{-# OPTIONS -w #-}
--- The above warning supression flag is a temporary kludge.
--- While working on this module you are encouraged to remove it and fix
--- any warnings in the module. See
---     http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#Warnings
--- for details
+{-# OPTIONS -Wall -fno-warn-name-shadowing #-}
 
 module Dataflow (
         fixedpoint
 
 module Dataflow (
         fixedpoint
index 9a92f6f..6ddec3d 100644 (file)
@@ -69,13 +69,18 @@ mkComment fs              = mkMiddle $ MidComment fs
 mkAssign l r              = mkMiddle $ MidAssign l r
 mkStore  l r              = mkMiddle $ MidStore  l r
 
 mkAssign l r              = mkMiddle $ MidAssign l r
 mkStore  l r              = mkMiddle $ MidStore  l r
 
-mkJump e args             = mkLast   $ LastJump e args
 mkCbranch pred ifso ifnot = mkLast   $ LastCondBranch pred ifso ifnot
 mkCbranch pred ifso ifnot = mkLast   $ LastCondBranch pred ifso ifnot
-mkReturn actuals          = mkLast   $ LastReturn actuals
 mkSwitch e tbl            = mkLast   $ LastSwitch e tbl
 
 mkUnsafeCall tgt results actuals = mkMiddle $ MidUnsafeCall tgt results actuals
 
 mkSwitch e tbl            = mkLast   $ LastSwitch e tbl
 
 mkUnsafeCall tgt results actuals = mkMiddle $ MidUnsafeCall tgt results actuals
 
+cmmArgConv, cmmResConv :: Convention
+cmmArgConv = ConventionStandard CmmCallConv Arguments
+cmmResConv = ConventionStandard CmmCallConv Arguments
+
+mkJump e actuals = mkMiddle (CopyOut cmmArgConv actuals) <*> mkLast (LastJump e)
+mkReturn actuals = mkMiddle (CopyOut cmmResConv actuals) <*> mkLast LastReturn
+
 mkFinalCall  f conv actuals =
     mkMiddle (CopyOut (ConventionStandard conv Arguments) actuals) <*>
     mkLast   (LastCall f Nothing)
 mkFinalCall  f conv actuals =
     mkMiddle (CopyOut (ConventionStandard conv Arguments) actuals) <*>
     mkLast   (LastCall f Nothing)
index 18302d8..e9b2d6c 100644 (file)
@@ -47,13 +47,12 @@ pprCmmGraphLikeCmm g = vcat (swallow blocks)
           last id prev' out l n =
               let endblock stmt = block' id (stmt : prev') : swallow n in
               case l of
           last id prev' out l n =
               let endblock stmt = block' id (stmt : prev') : swallow n in
               case l of
-                G.LastBranch tgt [] ->
+                G.LastBranch tgt ->
                     case n of
                       Z.Block id' t : bs
                           | tgt == id', unique_pred id' 
                           -> tail id prev' out t bs  -- optimize out redundant labels
                       _ -> endblock (ppr $ CmmBranch tgt)
                     case n of
                       Z.Block id' t : bs
                           | tgt == id', unique_pred id' 
                           -> tail id prev' out t bs  -- optimize out redundant labels
                       _ -> endblock (ppr $ CmmBranch tgt)
-                l@(G.LastBranch {}) -> endblock $ with_out out l
                 l@(G.LastCondBranch expr tid fid) ->
                   let ft id = text "// fall through to " <> ppr id in
                   case n of
                 l@(G.LastCondBranch expr tid fid) ->
                   let ft id = text "// fall through to " <> ppr id in
                   case n of
@@ -123,6 +122,8 @@ with_out (Just (conv, args)) l = last l
                     case k of Nothing -> ptext SLIT(" never returns")
                               Just _ -> empty,
                     semi ]
                     case k of Nothing -> ptext SLIT(" never returns")
                               Just _ -> empty,
                     semi ]
+          last (G.LastReturn) = ppr (CmmReturn args)
+          last (G.LastJump e) = ppr (CmmJump e args)
           last l = ppr (G.CopyOut conv args) $$ ppr l
           ppr_target (CmmLit lit) = pprLit lit
           ppr_target fn'          = parens (ppr fn')
           last l = ppr (G.CopyOut conv args) $$ ppr l
           ppr_target (CmmLit lit) = pprLit lit
           ppr_target fn'          = parens (ppr fn')
index 135a219..03fc759 100644 (file)
@@ -15,8 +15,8 @@ where
 
 import CmmExpr
 import Cmm ( GenCmm(..), GenCmmTop(..), CmmStatic, CmmInfo
 
 import CmmExpr
 import Cmm ( GenCmm(..), GenCmmTop(..), CmmStatic, CmmInfo
-           , CmmCallTarget(..), CmmActuals, CmmFormalsWithoutKinds, CmmFormals
-           , CmmStmt(CmmJump, CmmSwitch) -- imported in order to call ppr
+           , CmmCallTarget(..), CmmActuals, CmmFormals
+           , CmmStmt(CmmSwitch) -- imported in order to call ppr
            )
 import PprCmm()
 
            )
 import PprCmm()
 
@@ -33,6 +33,9 @@ import Maybes
 import Outputable
 import Prelude hiding (zip, unzip, last)
 
 import Outputable
 import Prelude hiding (zip, unzip, last)
 
+----------------------------------------------------------------------
+----- Type synonyms and definitions
+
 type CmmGraph  = LGraph Middle Last
 type CmmAGraph = AGraph Middle Last
 type CmmBlock  = Block  Middle Last
 type CmmGraph  = LGraph Middle Last
 type CmmAGraph = AGraph Middle Last
 type CmmBlock  = Block  Middle Last
@@ -53,35 +56,38 @@ data Middle
      CmmFormals                  -- zero or more results
      CmmActuals                  -- zero or more arguments
 
      CmmFormals                  -- zero or more results
      CmmActuals                  -- zero or more arguments
 
-  | CopyIn    -- Move parameters or results from conventional locations to registers
-              -- Note [CopyIn invariant]
+  | CopyIn    -- Move incoming parameters or results from conventional
+              -- locations to registers.  Note [CopyIn invariant]
         Convention 
         CmmFormals      -- eventually [CmmKind] will be used only for foreign
                         -- calls and will migrate into 'Convention' (helping to
         Convention 
         CmmFormals      -- eventually [CmmKind] will be used only for foreign
                         -- calls and will migrate into 'Convention' (helping to
-                        -- drain "the swamp")
+                        -- drain "the swamp"), leaving this as [LocalReg]
         C_SRT           -- Static things kept alive by this block
         C_SRT           -- Static things kept alive by this block
+
   | CopyOut Convention CmmActuals
   | CopyOut Convention CmmActuals
+              -- Move outgoing parameters or results from registers to
+              -- conventional locations.  Every 'LastReturn',
+              -- 'LastJump', or 'LastCall' must be dominated by a
+              -- matching 'CopyOut' in the same basic block.
+              -- As above, '[CmmKind]' will migrate into the foreign calling
+              -- convention, leaving the actuals as '[CmmExpr]'.
 
 data Last
 
 data Last
-  = LastReturn CmmActuals          -- Return from a function,
-                                  -- with these return values.
-
-  | LastJump   CmmExpr CmmActuals
-        -- Tail call to another procedure
-
-  | LastBranch BlockId CmmFormalsWithoutKinds
-        -- To another block in the same procedure
-        -- The parameters are unused at present.
-
-  | LastCall {                   -- A call (native or safe foreign)
-        cml_target :: CmmExpr,   -- never a CmmPrim to a CallishMachOp!
-        cml_next   :: Maybe BlockId }  -- BlockId of continuation, if call returns
+  = LastBranch BlockId  -- Goto another block in the same procedure
 
   | LastCondBranch {            -- conditional branch
         cml_pred :: CmmExpr,
         cml_true, cml_false :: BlockId
     }
 
 
   | LastCondBranch {            -- conditional branch
         cml_pred :: CmmExpr,
         cml_true, cml_false :: BlockId
     }
 
+  | LastReturn          -- Return from a function; values in a previous CopyOut node
+
+  | LastJump CmmExpr    -- Tail call to another procedure; args in a CopyOut node
+
+  | LastCall {                   -- A call (native or safe foreign)
+        cml_target :: CmmExpr,   -- never a CmmPrim to a CallishMachOp!
+        cml_cont   :: Maybe BlockId }  -- BlockId of continuation, if call returns
+
   | LastSwitch CmmExpr [Maybe BlockId]   -- Table branch
         -- The scrutinee is zero-based; 
         --      zero -> first block
   | LastSwitch CmmExpr [Maybe BlockId]   -- Table branch
         -- The scrutinee is zero-based; 
         --      zero -> first block
@@ -91,11 +97,12 @@ data Last
 data Convention
   = ConventionStandard CCallConv ValueDirection
   | ConventionPrivate
 data Convention
   = ConventionStandard CCallConv ValueDirection
   | ConventionPrivate
-                -- Used for control transfers within a (pre-CPS) procedure
-                -- All jump sites known, never pushed on the stack (hence no SRT)
-                -- You can choose whatever calling convention
-                -- you please (provided you make sure
-                -- all the call sites agree)!
+                -- Used for control transfers within a (pre-CPS) procedure All
+                -- jump sites known, never pushed on the stack (hence no SRT)
+                -- You can choose whatever calling convention you please
+                -- (provided you make sure all the call sites agree)!
+                -- This data type eventually to be extended to record the convention. 
+
   deriving Eq
 
 data ValueDirection = Arguments | Results
   deriving Eq
 
 data ValueDirection = Arguments | Results
@@ -106,29 +113,31 @@ data ValueDirection = Arguments | Results
 {-
 Note [CopyIn invariant]
 ~~~~~~~~~~~~~~~~~~~~~~~
 {-
 Note [CopyIn invariant]
 ~~~~~~~~~~~~~~~~~~~~~~~
-In principle, CopyIn ought to be a First node, but in practice, the
+One might wish for CopyIn to be a First node, but in practice, the
 possibility raises all sorts of hairy issues with graph splicing,
 rewriting, and so on.  In the end, NR finds it better to make the
 possibility raises all sorts of hairy issues with graph splicing,
 rewriting, and so on.  In the end, NR finds it better to make the
-placement of CopyIn a dynamic invariant.  This change will complicate
-the dataflow fact for the proc-point calculation, but it should make
-things easier in many other respects.  
+placement of CopyIn a dynamic invariant; it should normally be the first
+Middle node in the basic block in which it occurs.
 -}
 
 -}
 
+----------------------------------------------------------------------
+----- Instance declarations for control flow
+
 instance HavingSuccessors Last where
     succs = cmmSuccs
     fold_succs = fold_cmm_succs
 
 instance LastNode Last where
 instance HavingSuccessors Last where
     succs = cmmSuccs
     fold_succs = fold_cmm_succs
 
 instance LastNode Last where
-    mkBranchNode id = LastBranch id []
-    isBranchNode (LastBranch _ []) = True
+    mkBranchNode id = LastBranch id
+    isBranchNode (LastBranch _) = True
     isBranchNode _ = False
     isBranchNode _ = False
-    branchNodeTarget (LastBranch id []) = id
+    branchNodeTarget (LastBranch id) = id
     branchNodeTarget _ = panic "asked for target of non-branch"
 
 cmmSuccs :: Last -> [BlockId]
 cmmSuccs (LastReturn {})        = []
 cmmSuccs (LastJump {})          = [] 
     branchNodeTarget _ = panic "asked for target of non-branch"
 
 cmmSuccs :: Last -> [BlockId]
 cmmSuccs (LastReturn {})        = []
 cmmSuccs (LastJump {})          = [] 
-cmmSuccs (LastBranch id _)      = [id]
+cmmSuccs (LastBranch id)        = [id]
 cmmSuccs (LastCall _ (Just id)) = [id]
 cmmSuccs (LastCall _ Nothing)   = []
 cmmSuccs (LastCondBranch _ t f) = [f, t]  -- meets layout constraint
 cmmSuccs (LastCall _ (Just id)) = [id]
 cmmSuccs (LastCall _ Nothing)   = []
 cmmSuccs (LastCondBranch _ t f) = [f, t]  -- meets layout constraint
@@ -137,15 +146,15 @@ cmmSuccs (LastSwitch _ edges)   = catMaybes edges
 fold_cmm_succs :: (BlockId -> a -> a) -> Last -> a -> a
 fold_cmm_succs _f (LastReturn {})          z = z
 fold_cmm_succs _f (LastJump {})            z = z
 fold_cmm_succs :: (BlockId -> a -> a) -> Last -> a -> a
 fold_cmm_succs _f (LastReturn {})          z = z
 fold_cmm_succs _f (LastJump {})            z = z
-fold_cmm_succs  f (LastBranch id _)        z = f id z
+fold_cmm_succs  f (LastBranch id)          z = f id z
 fold_cmm_succs  f (LastCall _ (Just id))   z = f id z
 fold_cmm_succs _f (LastCall _ Nothing)     z = z
 fold_cmm_succs  f (LastCondBranch _ te fe) z = f te (f fe z)
 fold_cmm_succs  f (LastSwitch _ edges)     z = foldl (flip f) z $ catMaybes edges
 
 
 fold_cmm_succs  f (LastCall _ (Just id))   z = f id z
 fold_cmm_succs _f (LastCall _ Nothing)     z = z
 fold_cmm_succs  f (LastCondBranch _ te fe) z = f te (f fe z)
 fold_cmm_succs  f (LastSwitch _ edges)     z = foldl (flip f) z $ catMaybes edges
 
 
-----------------------------------------------------------------
--- prettyprinting (avoids recursive imports)
+----------------------------------------------------------------------
+----- Instance declarations for prettyprinting (avoids recursive imports)
 
 instance Outputable Middle where
     ppr s = pprMiddle s
 
 instance Outputable Middle where
     ppr s = pprMiddle s
@@ -175,9 +184,8 @@ pprMiddle stmt = (case stmt of
              ptext SLIT("foreign") <+> doubleQuotes(ppr conv) <+> ptext SLIT("...")
 
     CopyOut conv args ->
              ptext SLIT("foreign") <+> doubleQuotes(ppr conv) <+> ptext SLIT("...")
 
     CopyOut conv args ->
-        if null args then empty
-        else ptext SLIT("CopyOut") <+> doubleQuotes(ppr conv) <+>
-             parens (commafy (map pprHinted args))
+        ptext SLIT("next, pass") <+> doubleQuotes(ppr conv) <+>
+        parens (commafy (map pprHinted args))
 
     --  // text
     MidComment s -> text "//" <+> ftext s
 
     --  // text
     MidComment s -> text "//" <+> ftext s
@@ -230,12 +238,12 @@ pprHinted (a, FloatHint)  = doubleQuotes (text "float")   <+> ppr a
 
 pprLast :: Last -> SDoc    
 pprLast stmt = (case stmt of
 
 pprLast :: Last -> SDoc    
 pprLast stmt = (case stmt of
-    LastBranch ident args     -> genBranchWithArgs ident args
+    LastBranch ident          -> ptext SLIT("goto") <+> ppr ident <> semi
     LastCondBranch expr t f   -> genFullCondBranch expr t f
     LastCondBranch expr t f   -> genFullCondBranch expr t f
-    LastJump expr params      -> ppr $ CmmJump expr params
-    LastReturn results        -> hcat [ ptext SLIT("return"), space
-                                      , parens ( commafy $ map pprHinted results )
-                                      , semi ]
+    LastJump expr             -> hcat [ ptext SLIT("jump"), space, pprFun expr
+                                      , ptext SLIT("(...)"), semi]
+    LastReturn                -> hcat [ ptext SLIT("return"), space 
+                                      , ptext SLIT("(...)"), semi]
     LastSwitch arg ids        -> ppr $ CmmSwitch arg ids
     LastCall tgt k            -> genBareCall tgt k
   ) <>
     LastSwitch arg ids        -> ppr $ CmmSwitch arg ids
     LastCall tgt k            -> genBareCall tgt k
   ) <>
@@ -251,20 +259,16 @@ pprLast stmt = (case stmt of
 
 genBareCall :: CmmExpr -> Maybe BlockId -> SDoc
 genBareCall fn k =
 
 genBareCall :: CmmExpr -> Maybe BlockId -> SDoc
 genBareCall fn k =
-        hcat [ ptext SLIT("foreign"), space
-             , doubleQuotes(ptext SLIT("<convention from CopyOut>")), space
-             , target fn, parens  ( ptext SLIT("<parameters from CopyOut>") ), space
+        hcat [ ptext SLIT("call"), space
+             , pprFun fn, ptext SLIT("(...)"), space
              , case k of Nothing -> ptext SLIT("never returns")
                          Just k -> ptext SLIT("returns to") <+> ppr k
              , semi ]
         where
              , case k of Nothing -> ptext SLIT("never returns")
                          Just k -> ptext SLIT("returns to") <+> ppr k
              , semi ]
         where
-            target t@(CmmLit _) = ppr t
-            target fn'          = parens (ppr fn')
 
 
-genBranchWithArgs :: (Outputable id, Outputable arg) => id -> [arg] -> SDoc
-genBranchWithArgs ident [] = ptext SLIT("goto") <+> ppr ident <> semi
-genBranchWithArgs ident args = ptext SLIT("goto") <+> ppr ident <+>
-                               parens (commafy (map ppr args)) <> semi
+pprFun :: CmmExpr -> SDoc
+pprFun f@(CmmLit _) = ppr f
+pprFun f = parens (ppr f)
 
 genFullCondBranch :: Outputable id => CmmExpr -> id -> id -> SDoc
 genFullCondBranch expr t f =
 
 genFullCondBranch :: Outputable id => CmmExpr -> id -> id -> SDoc
 genFullCondBranch expr t f =