Use "ReturnedTo" when generating safe foreign calls

1 files changed, 4 insertions, 17 deletions

diff --git a/compiler/codeGen/StgCmmMonad.hs b/compiler/codeGen/StgCmmMonad.hs
index eb6b9a988f..3d34cb9bdd 100644
--- a/compiler/codeGen/StgCmmMonad.hs
+++ b/compiler/codeGen/StgCmmMonad.hs
@@ -30,7 +30,7 @@ module StgCmmMonad (
 	getCodeR, getCode, getHeapUsage,
 
         mkCmmIfThenElse, mkCmmIfThen, mkCmmIfGoto,
-        mkCall, mkCmmCall, mkSafeCall,
+        mkCall, mkCmmCall,
 
         forkClosureBody, forkStatics, forkAlts, forkProc, codeOnly,
 
@@ -95,6 +95,9 @@ infixr 9 `thenFC`
 
 newtype FCode a = FCode (CgInfoDownwards -> CgState -> (a, CgState))
 
+instance Functor FCode where
+  fmap f (FCode g) = FCode $ \i s -> let (a,s') = g i s in (f a, s')
+
 instance Monad FCode where
 	(>>=) = thenFC
 	return = returnFC
@@ -792,22 +795,6 @@ mkCmmCall f results actuals updfr_off
    = mkCall f (NativeDirectCall, NativeReturn) results actuals updfr_off (0,[])
 
 
-mkSafeCall :: ForeignTarget -> [CmmFormal] -> [CmmActual]
-           -> UpdFrameOffset -> Bool
-           -> FCode CmmAGraph
-mkSafeCall   t fs as upd i = do
-  k <- newLabelC
-  let (_off, copyout) = copyInOflow NativeReturn (Young k) fs
-    -- see Note [safe foreign call convention]
-  return
-     (    mkStore (CmmStackSlot (Young k) (widthInBytes wordWidth))
-                  (CmmLit (CmmBlock k))
-      <*> mkLast (CmmForeignCall { tgt=t, res=fs, args=as, succ=k
-                                 , updfr=upd, intrbl=i })
-      <*> mkLabel k
-      <*> copyout
-     )
-
 -- ----------------------------------------------------------------------------
 -- CgStmts