put CmmReturnInfo into a CmmCall (and related types)

diff --git a/compiler/cmm/Cmm.hs b/compiler/cmm/Cmm.hs
index 442eb60..cbc60c2 100644 (file)
--- a/compiler/cmm/Cmm.hs
+++ b/compiler/cmm/Cmm.hs
@@ -12,7 +12,7 @@ module Cmm (
        CmmInfo(..), UpdateFrame(..),
         CmmInfoTable(..), ClosureTypeInfo(..), ProfilingInfo(..), ClosureTypeTag,
        GenBasicBlock(..), CmmBasicBlock, blockId, blockStmts, mapBlockStmts,
-        ReturnInfo(..),
+        CmmReturnInfo(..),
        CmmStmt(..), CmmActuals, CmmFormal, CmmFormals, CmmHintFormals,
         CmmSafety(..),
        CmmCallTarget(..),
@@ -141,8 +141,8 @@ data ClosureTypeInfo
       [Maybe LocalReg]  -- Forced stack parameters
       C_SRT
 
-data ReturnInfo = MayReturn
-                | NeverReturns
+data CmmReturnInfo = CmmMayReturn
+                   | CmmNeverReturns
 
 -- TODO: These types may need refinement
 data ProfilingInfo = ProfilingInfo CmmLit CmmLit -- closure_type, closure_desc
@@ -185,6 +185,7 @@ data CmmStmt
      CmmHintFormals             -- zero or more results
      CmmActuals                         -- zero or more arguments
      CmmSafety                  -- whether to build a continuation
+     CmmReturnInfo
 
   | CmmBranch BlockId             -- branch to another BB in this fn
 

diff --git a/compiler/cmm/CmmBrokenBlock.hs b/compiler/cmm/CmmBrokenBlock.hs
index cc968f1..b8ef5f9 100644 (file)
--- a/compiler/cmm/CmmBrokenBlock.hs
+++ b/compiler/cmm/CmmBrokenBlock.hs
@@ -143,6 +143,7 @@ data FinalStmt
                                 -- (redundant with ContinuationEntry)
       CmmActuals                -- ^ Arguments to call
       C_SRT                     -- ^ SRT for the continuation's info table
+      CmmReturnInfo             -- ^ Does the function return?
       Bool                      -- ^ True <=> GC block so ignore stack size
 
   | FinalSwitch                 -- ^ Same as a 'CmmSwitch'
@@ -258,7 +259,7 @@ breakBlock gc_block_idents uniques (BasicBlock ident stmts) entry =
 
             -- Detect this special case to remain an inverse of
             -- 'cmmBlockFromBrokenBlock'
-            [CmmCall target results arguments (CmmSafe srt),
+            [CmmCall target results arguments (CmmSafe srt) ret,
              CmmBranch next_id] ->
                 ([cont_info], [block])
                 where
@@ -266,15 +267,15 @@ breakBlock gc_block_idents uniques (BasicBlock ident stmts) entry =
                                ContFormat results srt
                                               (ident `elem` gc_block_idents))
                   block = do_call current_id entry accum_stmts exits next_id
-                                target results arguments srt
+                                target results arguments srt ret
 
             -- Break the block on safe calls (the main job of this function)
-            (CmmCall target results arguments (CmmSafe srt) : stmts) ->
+            (CmmCall target results arguments (CmmSafe srt) ret : stmts) ->
                 (cont_info : cont_infos, block : blocks)
                 where
                   next_id = BlockId $ head uniques
                   block = do_call current_id entry accum_stmts exits next_id
-                                  target results arguments srt
+                                  target results arguments srt ret
 
                   cont_info = (next_id,        -- Entry convention for the 
                                        -- continuation of the call
@@ -287,12 +288,12 @@ breakBlock gc_block_idents uniques (BasicBlock ident stmts) entry =
 
             -- Unsafe calls don't need a continuation
             -- but they do need to be expanded
-            (CmmCall target results arguments CmmUnsafe : stmts) ->
+            (CmmCall target results arguments CmmUnsafe ret : stmts) ->
                 breakBlock' remaining_uniques current_id entry exits
                             (accum_stmts ++
                              arg_stmts ++
                              caller_save ++
-                             [CmmCall target results new_args CmmUnsafe] ++
+                             [CmmCall target results new_args CmmUnsafe ret] ++
                              caller_load)
                             stmts
                 where
@@ -309,9 +310,9 @@ breakBlock gc_block_idents uniques (BasicBlock ident stmts) entry =
                             stmts
 
       do_call current_id entry accum_stmts exits next_id
-              target results arguments srt =
+              target results arguments srt ret =
           BrokenBlock current_id entry accum_stmts (next_id:exits)
-                      (FinalCall next_id target results arguments srt
+                      (FinalCall next_id target results arguments srt ret
                                      (current_id `elem` gc_block_idents))
 
       cond_branch_target (CmmCondBranch _ target) = [target]
@@ -350,7 +351,7 @@ adaptBlockToFormat :: [(BlockId, ContFormat)]
 adaptBlockToFormat formats unique
                    block@(BrokenBlock ident entry stmts targets
                                       exit@(FinalCall next target formals
-                                                      actuals srt is_gc)) =
+                                                      actuals srt ret is_gc)) =
     if format_formals == formals &&
        format_srt == srt &&
        format_is_gc == is_gc
@@ -367,7 +368,7 @@ adaptBlockToFormat formats unique
       revised_targets = adaptor_ident : delete next targets
       revised_exit = FinalCall
                        adaptor_ident -- ^ The only part that changed
-                       target formals actuals srt is_gc
+                       target formals actuals srt ret is_gc
 
       adaptor_block = mk_adaptor_block adaptor_ident
                   (ContinuationEntry (map fst formals) srt is_gc)
@@ -401,8 +402,8 @@ cmmBlockFromBrokenBlock (BrokenBlock ident _ stmts _ exit) =
             FinalReturn arguments -> [CmmReturn arguments]
             FinalJump target arguments -> [CmmJump target arguments]
             FinalSwitch expr targets -> [CmmSwitch expr targets]
-            FinalCall branch_target call_target results arguments srt _ ->
-                [CmmCall call_target results arguments (CmmSafe srt),
+            FinalCall branch_target call_target results arguments srt ret _ ->
+                [CmmCall call_target results arguments (CmmSafe srt) ret,
                  CmmBranch branch_target]
 
 -----------------------------------------------------------------------------

diff --git a/compiler/cmm/CmmCPS.hs b/compiler/cmm/CmmCPS.hs
index e68216a..534346e 100644 (file)
--- a/compiler/cmm/CmmCPS.hs
+++ b/compiler/cmm/CmmCPS.hs
@@ -355,8 +355,8 @@ continuationMaxStack formats (Continuation _ label _ False blocks) =
           argumentsSize (cmmExprRep . fst) args
       final_arg_size (FinalJump _ args) =
           argumentsSize (cmmExprRep . fst) args
-      final_arg_size (FinalCall next _ _ args _ True) = 0
-      final_arg_size (FinalCall next _ _ args _ False) =
+      final_arg_size (FinalCall next _ _ args _ _ True) = 0
+      final_arg_size (FinalCall next _ _ args _ _ False) =
           -- We have to account for the stack used when we build a frame
           -- for the *next* continuation from *this* continuation
           argumentsSize (cmmExprRep . fst) args +
@@ -369,7 +369,7 @@ continuationMaxStack formats (Continuation _ label _ False blocks) =
 
       stmt_arg_size (CmmJump _ args) =
           argumentsSize (cmmExprRep . fst) args
-      stmt_arg_size (CmmCall _ _ _ (CmmSafe _)) =
+      stmt_arg_size (CmmCall _ _ _ (CmmSafe _) _) =
           panic "Safe call in processFormats"
       stmt_arg_size (CmmReturn _) =
           panic "CmmReturn in processFormats"

diff --git a/compiler/cmm/CmmCPSGen.hs b/compiler/cmm/CmmCPSGen.hs
index 732c962..fc3c391 100644 (file)
--- a/compiler/cmm/CmmCPSGen.hs
+++ b/compiler/cmm/CmmCPSGen.hs
@@ -194,7 +194,7 @@ continuationToProc (max_stack, update_frame_size, formats) stack_use uniques
 
                         -- A regular Cmm function call
                         FinalCall next (CmmCallee target CmmCallConv)
-                            results arguments _ _ ->
+                            results arguments _ _ _ ->
                                 pack_continuation curr_format cont_format ++
                                 tail_call (curr_stack - cont_stack)
                                               target arguments
@@ -205,7 +205,7 @@ continuationToProc (max_stack, update_frame_size, formats) stack_use uniques
 
                         -- A safe foreign call
                         FinalCall next (CmmCallee target conv)
-                            results arguments _ _ ->
+                            results arguments _ _ _ ->
                                 target_stmts ++
                                 foreignCall call_uniques' (CmmCallee new_target conv)
                                             results arguments
@@ -215,7 +215,7 @@ continuationToProc (max_stack, update_frame_size, formats) stack_use uniques
 
                         -- A safe prim call
                         FinalCall next (CmmPrim target)
-                            results arguments _ _ ->
+                            results arguments _ _ _ ->
                                 foreignCall call_uniques (CmmPrim target)
                                             results arguments
 
@@ -229,12 +229,14 @@ foreignCall uniques call results arguments =
     [CmmCall (CmmCallee suspendThread CCallConv)
                 [ (id,PtrHint) ]
                 [ (CmmReg (CmmGlobal BaseReg), PtrHint) ]
-                CmmUnsafe,
-     CmmCall call results new_args CmmUnsafe,
+                CmmUnsafe
+                 CmmMayReturn,
+     CmmCall call results new_args CmmUnsafe CmmMayReturn,
      CmmCall (CmmCallee resumeThread CCallConv)
                  [ (new_base, PtrHint) ]
                 [ (CmmReg (CmmLocal id), PtrHint) ]
-                CmmUnsafe,
+                CmmUnsafe
+                 CmmMayReturn,
      -- Assign the result to BaseReg: we
      -- might now have a different Capability!
      CmmAssign (CmmGlobal BaseReg) (CmmReg (CmmLocal new_base))] ++

diff --git a/compiler/cmm/CmmLint.hs b/compiler/cmm/CmmLint.hs
index d8d6c9b..7069457 100644 (file)
--- a/compiler/cmm/CmmLint.hs
+++ b/compiler/cmm/CmmLint.hs
@@ -122,7 +122,7 @@ lintCmmStmt (CmmStore l r) = do
   lintCmmExpr l
   lintCmmExpr r
   return ()
-lintCmmStmt (CmmCall _target _res args _) = mapM_ (lintCmmExpr.fst) args
+lintCmmStmt (CmmCall _target _res args _ _) = mapM_ (lintCmmExpr.fst) args
 lintCmmStmt (CmmCondBranch e _id)   = lintCmmExpr e >> checkCond e >> return ()
 lintCmmStmt (CmmSwitch e _branches) = do
   erep <- lintCmmExpr e

diff --git a/compiler/cmm/CmmLive.hs b/compiler/cmm/CmmLive.hs
index 958ba81..3d87907 100644 (file)
--- a/compiler/cmm/CmmLive.hs
+++ b/compiler/cmm/CmmLive.hs
@@ -170,7 +170,7 @@ cmmStmtLive _ (CmmAssign reg expr) =
               (CmmGlobal _) -> id
 cmmStmtLive _ (CmmStore expr1 expr2) =
     cmmExprLive expr2 . cmmExprLive expr1
-cmmStmtLive _ (CmmCall target results arguments _) =
+cmmStmtLive _ (CmmCall target results arguments _ _) =
     target_liveness .
     foldr ((.) . cmmExprLive) id (map fst arguments) .
     addKilled (mkUniqSet $ cmmHintFormalsToLiveLocals results) where

diff --git a/compiler/cmm/CmmOpt.hs b/compiler/cmm/CmmOpt.hs
index b0ec5a1..9664b9b 100644 (file)
--- a/compiler/cmm/CmmOpt.hs
+++ b/compiler/cmm/CmmOpt.hs
@@ -139,7 +139,7 @@ lookForInline u expr (stmt:stmts)
 getStmtUses :: CmmStmt -> UniqFM Int
 getStmtUses (CmmAssign _ e) = getExprUses e
 getStmtUses (CmmStore e1 e2) = plusUFM_C (+) (getExprUses e1) (getExprUses e2)
-getStmtUses (CmmCall target _ es _)
+getStmtUses (CmmCall target _ es _ _)
    = plusUFM_C (+) (uses target) (getExprsUses (map fst es))
    where uses (CmmCallee e _) = getExprUses e
         uses _ = emptyUFM
@@ -160,8 +160,8 @@ getExprsUses es = foldr (plusUFM_C (+)) emptyUFM (map getExprUses es)
 inlineStmt :: Unique -> CmmExpr -> CmmStmt -> CmmStmt
 inlineStmt u a (CmmAssign r e) = CmmAssign r (inlineExpr u a e)
 inlineStmt u a (CmmStore e1 e2) = CmmStore (inlineExpr u a e1) (inlineExpr u a e2)
-inlineStmt u a (CmmCall target regs es srt)
-   = CmmCall (infn target) regs es' srt
+inlineStmt u a (CmmCall target regs es srt ret)
+   = CmmCall (infn target) regs es' srt ret
    where infn (CmmCallee fn cconv) = CmmCallee fn cconv
         infn (CmmPrim p) = CmmPrim p
         es' = [ (inlineExpr u a e, hint) | (e,hint) <- es ]

diff --git a/compiler/cmm/CmmParse.y b/compiler/cmm/CmmParse.y
index bce6f27..200ec38 100644 (file)
--- a/compiler/cmm/CmmParse.y
+++ b/compiler/cmm/CmmParse.y
@@ -339,9 +339,9 @@ stmt        :: { ExtCode }
        | 'if' bool_expr '{' body '}' else      
                { ifThenElse $2 $4 $6 }
 
-opt_never_returns :: { ReturnInfo }
-        :                               { MayReturn }
-        | 'never' 'returns'             { NeverReturns }
+opt_never_returns :: { CmmReturnInfo }
+        :                               { CmmMayReturn }
+        | 'never' 'returns'             { CmmNeverReturns }
 
 bool_expr :: { ExtFCode BoolExpr }
        : bool_op                       { $1 }
@@ -873,9 +873,9 @@ foreignCall
        -> [ExtFCode (CmmExpr,MachHint)]
        -> Maybe [GlobalReg]
         -> CmmSafety
-        -> ReturnInfo
+        -> CmmReturnInfo
         -> P ExtCode
-foreignCall conv_string results_code expr_code args_code vols safety _ret
+foreignCall conv_string results_code expr_code args_code vols safety ret
   = do  convention <- case conv_string of
           "C" -> return CCallConv
           "C--" -> return CmmCallConv
@@ -887,14 +887,14 @@ foreignCall conv_string results_code expr_code args_code vols safety _ret
          --code (stmtC (CmmCall (CmmCallee expr convention) results args safety))
           case convention of
             -- Temporary hack so at least some functions are CmmSafe
-            CmmCallConv -> code (stmtC (CmmCall (CmmCallee expr convention) results args safety))
+            CmmCallConv -> code (stmtC (CmmCall (CmmCallee expr convention) results args safety ret))
             _ -> case safety of
              CmmUnsafe ->
                 code (emitForeignCall' PlayRisky results 
-                   (CmmCallee expr convention) args vols NoC_SRT)
+                   (CmmCallee expr convention) args vols NoC_SRT ret)
               CmmSafe srt ->
                 code (emitForeignCall' (PlaySafe unused) results 
-                   (CmmCallee expr convention) args vols NoC_SRT) where
+                   (CmmCallee expr convention) args vols NoC_SRT ret) where
                unused = panic "not used by emitForeignCall'"
 
 primCall
@@ -913,10 +913,10 @@ primCall results_code name args_code vols safety
                case safety of
                  CmmUnsafe ->
                    code (emitForeignCall' PlayRisky results
-                     (CmmPrim p) args vols NoC_SRT)
+                     (CmmPrim p) args vols NoC_SRT CmmMayReturn)
                  CmmSafe srt ->
                    code (emitForeignCall' (PlaySafe unused) results 
-                     (CmmPrim p) args vols NoC_SRT) where
+                     (CmmPrim p) args vols NoC_SRT CmmMayReturn) where
                    unused = panic "not used by emitForeignCall'"
 
 doStore :: MachRep -> ExtFCode CmmExpr  -> ExtFCode CmmExpr -> ExtCode

diff --git a/compiler/cmm/PprC.hs b/compiler/cmm/PprC.hs
index 238fd61..a07d2b9 100644 (file)
--- a/compiler/cmm/PprC.hs
+++ b/compiler/cmm/PprC.hs
@@ -199,7 +199,7 @@ pprStmt stmt = case stmt of
        where
          rep = cmmExprRep src
 
-    CmmCall (CmmCallee fn cconv) results args safety ->
+    CmmCall (CmmCallee fn cconv) results args safety _ret ->
        -- Controversial: leave this out for now.
        -- pprUndef fn $$
 
@@ -220,7 +220,7 @@ pprStmt stmt = case stmt of
           ptext SLIT("#undef") <+> pprCLabel lbl
        pprUndef _ = empty
 
-    CmmCall (CmmPrim op) results args safety ->
+    CmmCall (CmmPrim op) results args safety _ret ->
        pprCall ppr_fn CCallConv results args safety
        where
        ppr_fn = pprCallishMachOp_for_C op
@@ -837,7 +837,7 @@ te_Lit _ = return ()
 te_Stmt :: CmmStmt -> TE ()
 te_Stmt (CmmAssign r e)                = te_Reg r >> te_Expr e
 te_Stmt (CmmStore l r)         = te_Expr l >> te_Expr r
-te_Stmt (CmmCall _ rs es _)    = mapM_ (te_temp.fst) rs >>
+te_Stmt (CmmCall _ rs es _ _)  = mapM_ (te_temp.fst) rs >>
                                  mapM_ (te_Expr.fst) es
 te_Stmt (CmmCondBranch e _)    = te_Expr e
 te_Stmt (CmmSwitch e _)                = te_Expr e

diff --git a/compiler/cmm/PprCmm.hs b/compiler/cmm/PprCmm.hs
index 2d3fd6a..72fde55 100644 (file)
--- a/compiler/cmm/PprCmm.hs
+++ b/compiler/cmm/PprCmm.hs
@@ -212,7 +212,7 @@ pprStmt stmt = case stmt of
 
     -- call "ccall" foo(x, y)[r1, r2];
     -- ToDo ppr volatile
-    CmmCall (CmmCallee fn cconv) results args safety ->
+    CmmCall (CmmCallee fn cconv) results args safety ret ->
         hcat [ if null results
                   then empty
                   else parens (commafy $ map ppr results) <>
@@ -220,14 +220,17 @@ pprStmt stmt = case stmt of
                ptext SLIT("call"), space, 
                doubleQuotes(ppr cconv), space,
                target fn, parens  ( commafy $ map ppr args ),
-               brackets (ppr safety), semi ]
+               brackets (ppr safety), 
+               case ret of CmmMayReturn -> empty
+                           CmmNeverReturns -> ptext SLIT(" never returns"),
+               semi ]
         where
             target (CmmLit lit) = pprLit lit
             target fn'          = parens (ppr fn')
 
-    CmmCall (CmmPrim op) results args safety ->
+    CmmCall (CmmPrim op) results args safety ret ->
         pprStmt (CmmCall (CmmCallee (CmmLit lbl) CCallConv)
-                        results args safety)
+                        results args safety ret)
         where
           lbl = CmmLabel (mkForeignLabel (mkFastString (show op)) Nothing False)
 

diff --git a/compiler/codeGen/CgForeignCall.hs b/compiler/codeGen/CgForeignCall.hs
index dd95994..9db66f6 100644 (file)
--- a/compiler/codeGen/CgForeignCall.hs
+++ b/compiler/codeGen/CgForeignCall.hs
@@ -73,7 +73,7 @@ emitForeignCall results (CCall (CCallSpec target cconv safety)) args live
   = do vols <- getVolatileRegs live
        srt <- getSRTInfo
        emitForeignCall' safety results
-               (CmmCallee cmm_target cconv) call_args (Just vols) srt
+         (CmmCallee cmm_target cconv) call_args (Just vols) srt CmmMayReturn
   where
       (call_args, cmm_target)
        = case target of
@@ -104,13 +104,14 @@ emitForeignCall'
        -> [(CmmExpr,MachHint)] -- arguments
        -> Maybe [GlobalReg]    -- live vars, in case we need to save them
         -> C_SRT                -- the SRT of the calls continuation
+        -> CmmReturnInfo
        -> Code
-emitForeignCall' safety results target args vols srt
+emitForeignCall' safety results target args vols srt ret
   | not (playSafe safety) = do
     temp_args <- load_args_into_temps args
     let (caller_save, caller_load) = callerSaveVolatileRegs vols
     stmtsC caller_save
-    stmtC (CmmCall target results temp_args CmmUnsafe)
+    stmtC (CmmCall target results temp_args CmmUnsafe ret)
     stmtsC caller_load
 
   | otherwise = do
@@ -131,12 +132,12 @@ emitForeignCall' safety results target args vols srt
     stmtC (CmmCall (CmmCallee suspendThread CCallConv) 
                        [ (id,PtrHint) ]
                        [ (CmmReg (CmmGlobal BaseReg), PtrHint) ] 
-                       CmmUnsafe)
-    stmtC (CmmCall temp_target results temp_args CmmUnsafe)
+                       CmmUnsafe ret)
+    stmtC (CmmCall temp_target results temp_args CmmUnsafe ret)
     stmtC (CmmCall (CmmCallee resumeThread CCallConv) 
                        [ (new_base, PtrHint) ]
                        [ (CmmReg (CmmLocal id), PtrHint) ]
-                       CmmUnsafe)
+                       CmmUnsafe ret)
     -- Assign the result to BaseReg: we
     -- might now have a different Capability!
     stmtC (CmmAssign (CmmGlobal BaseReg) (CmmReg (CmmLocal new_base)))

diff --git a/compiler/codeGen/CgHpc.hs b/compiler/codeGen/CgHpc.hs
index e846f0e..5992684 100644 (file)
--- a/compiler/codeGen/CgHpc.hs
+++ b/compiler/codeGen/CgHpc.hs
@@ -76,6 +76,7 @@ initHpc this_mod (HpcInfo tickCount hashNo)
                ]
                (Just [])
                NoC_SRT -- No SRT b/c we PlayRisky
+               CmmMayReturn
        }
   where
        mod_alloc = mkFastString "hs_hpc_module"

diff --git a/compiler/codeGen/CgPrimOp.hs b/compiler/codeGen/CgPrimOp.hs
index 049e12a..5ea5023 100644 (file)
--- a/compiler/codeGen/CgPrimOp.hs
+++ b/compiler/codeGen/CgPrimOp.hs
@@ -121,6 +121,7 @@ emitPrimOp [res] ParOp [arg] live
        [(CmmReg (CmmGlobal BaseReg), PtrHint), (arg,PtrHint)] 
        (Just vols)
         NoC_SRT -- No SRT b/c we do PlayRisky
+        CmmMayReturn
   where
        newspark = CmmLit (CmmLabel (mkRtsCodeLabel SLIT("newSpark")))
 
@@ -138,6 +139,7 @@ emitPrimOp [] WriteMutVarOp [mutv,var] live
                [(CmmReg (CmmGlobal BaseReg), PtrHint), (mutv,PtrHint)]
                (Just vols)
                 NoC_SRT -- No SRT b/c we do PlayRisky
+                CmmMayReturn
 
 --  #define sizzeofByteArrayzh(r,a) \
 --     r = (((StgArrWords *)(a))->words * sizeof(W_))
@@ -344,6 +346,7 @@ emitPrimOp [res] op args live
           [(a,NoHint) | a<-args]  -- ToDo: hints?
           (Just vols)
            NoC_SRT -- No SRT b/c we do PlayRisky
+           CmmMayReturn
 
    | Just mop <- translateOp op
    = let stmt = CmmAssign (CmmLocal res) (CmmMachOp mop args) in

diff --git a/compiler/codeGen/CgUtils.hs b/compiler/codeGen/CgUtils.hs
index 9ebcf90..eee5f8d 100644 (file)
--- a/compiler/codeGen/CgUtils.hs
+++ b/compiler/codeGen/CgUtils.hs
@@ -354,7 +354,7 @@ emitRtsCall' res fun args vols safe = do
             then getSRTInfo >>= (return . CmmSafe)
             else return CmmUnsafe
   stmtsC caller_save
-  stmtC (CmmCall target res args safety)
+  stmtC (CmmCall target res args safety CmmMayReturn)
   stmtsC caller_load
   where
     (caller_save, caller_load) = callerSaveVolatileRegs vols

diff --git a/compiler/nativeGen/AsmCodeGen.lhs b/compiler/nativeGen/AsmCodeGen.lhs
index 672ff69..3485d61 100644 (file)
--- a/compiler/nativeGen/AsmCodeGen.lhs
+++ b/compiler/nativeGen/AsmCodeGen.lhs
@@ -517,7 +517,7 @@ cmmStmtConFold stmt
            -> do addr' <- cmmExprConFold JumpReference addr
                  return $ CmmJump addr' regs
 
-       CmmCall target regs args srt
+       CmmCall target regs args srt returns
           -> do target' <- case target of
                              CmmCallee e conv -> do
                                e' <- cmmExprConFold CallReference e
@@ -526,7 +526,7 @@ cmmStmtConFold stmt
                  args' <- mapM (\(arg, hint) -> do
                                   arg' <- cmmExprConFold DataReference arg
                                   return (arg', hint)) args
-                return $ CmmCall target' regs args' srt
+                return $ CmmCall target' regs args' srt returns
 
         CmmCondBranch test dest
            -> do test' <- cmmExprConFold DataReference test

diff --git a/compiler/nativeGen/MachCodeGen.hs b/compiler/nativeGen/MachCodeGen.hs
index e6cb6fc..eb3a5cd 100644 (file)
--- a/compiler/nativeGen/MachCodeGen.hs
+++ b/compiler/nativeGen/MachCodeGen.hs
@@ -121,7 +121,7 @@ stmtToInstrs stmt = case stmt of
       | otherwise       -> assignMem_IntCode kind addr src
        where kind = cmmExprRep src
 
-    CmmCall target result_regs args _
+    CmmCall target result_regs args _ _
        -> genCCall target result_regs args
 
     CmmBranch id         -> genBranch id
@@ -3206,13 +3206,13 @@ outOfLineFloatOp mop res args
         
       if localRegRep res == F64
         then
-          stmtToInstrs (CmmCall target [(res,FloatHint)] args CmmUnsafe)
+          stmtToInstrs (CmmCall target [(res,FloatHint)] args CmmUnsafe CmmMayReturn)
         else do
           uq <- getUniqueNat
           let 
             tmp = LocalReg uq F64 KindNonPtr
           -- in
-          code1 <- stmtToInstrs (CmmCall target [(tmp,FloatHint)] args CmmUnsafe)
+          code1 <- stmtToInstrs (CmmCall target [(tmp,FloatHint)] args CmmUnsafe CmmMayReturn)
           code2 <- stmtToInstrs (CmmAssign (CmmLocal res) (CmmReg (CmmLocal tmp)))
           return (code1 `appOL` code2)
   where