X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Fcmm%2FMkZipCfgCmm.hs;h=97860299b9c2c6b569c66cfbcc56564e39939f3a;hb=5d1c70a506f366eca47464f2a354de8cc0d9a795;hp=29d8daf4c9a832b1cfe2f462795cb1fb4699b008;hpb=e239aa2329416a2822fcc03c4ed486c7d28739e1;p=ghc-hetmet.git diff --git a/compiler/cmm/MkZipCfgCmm.hs b/compiler/cmm/MkZipCfgCmm.hs index 29d8daf..9786029 100644 --- a/compiler/cmm/MkZipCfgCmm.hs +++ b/compiler/cmm/MkZipCfgCmm.hs @@ -60,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 @@ -259,14 +259,15 @@ mkReturnSimple actuals updfr_off = mkFinalCall f _ actuals updfr_off = lastWithArgs Call old NativeCall actuals updfr_off $ toCall f Nothing updfr_off 0 -mkCmmCall f results actuals = mkCall f NativeCall 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 = - pprTrace "mkCall" (ppr f <+> ppr actuals <+> ppr results <+> ppr conv) $ +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)