X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=compiler%2Fcmm%2FMkZipCfgCmm.hs;h=97860299b9c2c6b569c66cfbcc56564e39939f3a;hp=88adaaebf1fa52b877d5dec29819db7fdb8f91f7;hb=5d1c70a506f366eca47464f2a354de8cc0d9a795;hpb=31a9d04804d9cacda35695c5397590516b964964

diff --git a/compiler/cmm/MkZipCfgCmm.hs b/compiler/cmm/MkZipCfgCmm.hs
index 88adaae..9786029 100644
--- a/compiler/cmm/MkZipCfgCmm.hs
+++ b/compiler/cmm/MkZipCfgCmm.hs
@@ -35,6 +35,7 @@ import PprCmm()
 import FastString
 import ForeignCall
 import MkZipCfg
+import Outputable
 import Panic 
 import SMRep (ByteOff) 
 import StaticFlags 
@@ -59,7 +60,7 @@ mkAssign     :: CmmReg  -> CmmExpr -> CmmAGraph
 mkStore      :: CmmExpr -> CmmExpr -> CmmAGraph
 
 ---------- Calls
-mkCall       :: CmmExpr -> Convention -> CmmFormals -> CmmActuals ->
+mkCall       :: CmmExpr -> (Convention, Convention) -> CmmFormals -> CmmActuals ->
                   UpdFrameOffset -> CmmAGraph
 mkCmmCall    :: CmmExpr ->              CmmFormals -> CmmActuals ->
                   UpdFrameOffset -> CmmAGraph
@@ -243,28 +244,30 @@ toCall :: CmmExpr -> Maybe BlockId -> UpdFrameOffset -> ByteOff -> ByteOff -> La
 toCall e cont updfr_off res_space arg_space =
   LastCall e cont arg_space res_space (Just updfr_off)
 mkJump e actuals updfr_off =
-  lastWithArgs Jump old Native actuals updfr_off $ toCall e Nothing updfr_off 0
+  lastWithArgs Jump old NativeCall actuals updfr_off $ toCall e Nothing updfr_off 0
 mkJumpGC e actuals updfr_off =
   lastWithArgs Jump old GC actuals updfr_off $ toCall e Nothing updfr_off 0
 mkForeignJump conv e actuals updfr_off =
   lastWithArgs Jump old conv actuals updfr_off $ toCall e Nothing updfr_off 0
 mkReturn e actuals updfr_off =
-  lastWithArgs Ret  old Native actuals updfr_off $ toCall e Nothing updfr_off 0
+  lastWithArgs Ret  old NativeReturn actuals updfr_off $ toCall e Nothing updfr_off 0
     -- where e = CmmLoad (CmmStackSlot (CallArea Old) updfr_off) gcWord
 mkReturnSimple actuals updfr_off =
-  lastWithArgs Ret  old Native actuals updfr_off $ toCall e Nothing updfr_off 0
+  lastWithArgs Ret  old NativeReturn actuals updfr_off $ toCall e Nothing updfr_off 0
     where e = CmmLoad (CmmStackSlot (CallArea Old) updfr_off) gcWord
 
 mkFinalCall f _ actuals updfr_off =
-  lastWithArgs Call old Native actuals updfr_off $ toCall f Nothing updfr_off 0
+  lastWithArgs Call old NativeCall actuals updfr_off $ toCall f Nothing updfr_off 0
 
-mkCmmCall f results actuals = mkCall f Native results actuals
+mkCmmCall f results actuals = mkCall f (NativeCall, NativeReturn) results actuals
 
 -- I'm dropping the SRT, but that should be okay: we plan to reconstruct it later.
-mkCall f conv results actuals updfr_off =
+mkCall f (callConv, retConv) results actuals updfr_off =
+ pprTrace "mkCall" (ppr f <+> ppr actuals <+> ppr results <+> ppr callConv <+>
+                    ppr retConv) $
   withFreshLabel "call successor" $ \k ->
     let area = CallArea $ Young k
-        (off, copyin) = copyInOflow conv False area results
-        copyout = lastWithArgs Call area conv actuals updfr_off 
+        (off, copyin) = copyInOflow retConv False area results
+        copyout = lastWithArgs Call area callConv actuals updfr_off 
                                (toCall f (Just k) updfr_off off)
     in (copyout <*> mkLabel k <*> copyin)