X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Fcmm%2FMkZipCfgCmm.hs;h=6ddec3d28deb57465791ed4e330a60d49d839a37;hb=569348e87434f2a8d9e18dccac8b4a563b4eb363;hp=6792559aeea80be52a6a8937dd06eb92924caa5b;hpb=c0a5a5d2e41341046aaf37c1d2155372e7ed3ee8;p=ghc-hetmet.git diff --git a/compiler/cmm/MkZipCfgCmm.hs b/compiler/cmm/MkZipCfgCmm.hs index 6792559..6ddec3d 100644 --- a/compiler/cmm/MkZipCfgCmm.hs +++ b/compiler/cmm/MkZipCfgCmm.hs @@ -41,9 +41,9 @@ type CmmTopZ = GenCmmTop CmmStatic CmmInfo CmmGraph mkNop :: CmmAGraph mkAssign :: CmmReg -> CmmExpr -> CmmAGraph mkStore :: CmmExpr -> CmmExpr -> CmmAGraph -mkCall :: CmmCallTarget -> CmmFormals -> CmmActuals -> C_SRT -> CmmAGraph +mkCall :: CmmExpr -> CCallConv -> CmmFormals -> CmmActuals -> C_SRT -> CmmAGraph mkUnsafeCall :: CmmCallTarget -> CmmFormals -> CmmActuals -> CmmAGraph -mkFinalCall :: CmmCallTarget -> CmmActuals -> CmmAGraph -- never returns +mkFinalCall :: CmmExpr -> CCallConv -> CmmActuals -> CmmAGraph -- never returns mkJump :: CmmExpr -> CmmActuals -> CmmAGraph mkCbranch :: CmmExpr -> BlockId -> BlockId -> CmmAGraph mkSwitch :: CmmExpr -> [Maybe BlockId] -> CmmAGraph @@ -69,16 +69,25 @@ mkComment fs = mkMiddle $ MidComment fs 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 -mkReturn actuals = mkLast $ LastReturn actuals mkSwitch e tbl = mkLast $ LastSwitch e tbl mkUnsafeCall tgt results actuals = mkMiddle $ MidUnsafeCall tgt results actuals -mkFinalCall tgt actuals = mkLast $ LastCall tgt actuals Nothing -mkCall tgt results actuals srt = - withFreshLabel "call successor" $ \k -> - mkLast (LastCall tgt actuals (Just k)) <*> - mkLabel k <*> - mkMiddle (CopyIn (Result CmmCallConv) results srt) +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) + +mkCall f conv results actuals srt = + withFreshLabel "call successor" $ \k -> + mkMiddle (CopyOut (ConventionStandard conv Arguments) actuals) <*> + mkLast (LastCall f (Just k)) <*> + mkLabel k <*> + mkMiddle (CopyIn (ConventionStandard conv Results) results srt)