X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Fcmm%2FCmmCPSGen.hs;h=fc3c39146fec5af264a665c94ab894cb934c3051;hb=f8c572418898d4c0e703f6d67510c9c37b51cc6e;hp=6c9b5a5d9a18100029a677e4a964bc527590099e;hpb=95e67967d9abbef73e8d355d0e168759b4ee0590;p=ghc-hetmet.git diff --git a/compiler/cmm/CmmCPSGen.hs b/compiler/cmm/CmmCPSGen.hs index 6c9b5a5..fc3c391 100644 --- a/compiler/cmm/CmmCPSGen.hs +++ b/compiler/cmm/CmmCPSGen.hs @@ -15,8 +15,9 @@ import MachOp import CmmUtils import CmmCallConv -import CgProf (curCCS, curCCSAddr) -import CgUtils (cmmOffsetW) +import CgProf +import CgUtils +import CgInfoTbls import SMRep import ForeignCall @@ -192,8 +193,8 @@ continuationToProc (max_stack, update_frame_size, formats) stack_use uniques tail_call curr_stack target arguments -- A regular Cmm function call - FinalCall next (CmmForeignCall target CmmCallConv) - results arguments _ _ -> + FinalCall next (CmmCallee target CmmCallConv) + results arguments _ _ _ -> pack_continuation curr_format cont_format ++ tail_call (curr_stack - cont_stack) target arguments @@ -203,10 +204,10 @@ continuationToProc (max_stack, update_frame_size, formats) stack_use uniques cont_stack = continuation_frame_size cont_format -- A safe foreign call - FinalCall next (CmmForeignCall target conv) - results arguments _ _ -> + FinalCall next (CmmCallee target conv) + results arguments _ _ _ -> target_stmts ++ - foreignCall call_uniques' (CmmForeignCall new_target conv) + foreignCall call_uniques' (CmmCallee new_target conv) results arguments where (call_uniques', target_stmts, new_target) = @@ -214,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 @@ -225,15 +226,17 @@ foreignCall uniques call results arguments = arg_stmts ++ saveThreadState ++ caller_save ++ - [CmmCall (CmmForeignCall suspendThread CCallConv) + [CmmCall (CmmCallee suspendThread CCallConv) [ (id,PtrHint) ] [ (CmmReg (CmmGlobal BaseReg), PtrHint) ] - CmmUnsafe, - CmmCall call results new_args CmmUnsafe, - CmmCall (CmmForeignCall resumeThread CCallConv) + 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))] ++