X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Fcmm%2FCmmCPSGen.hs;h=dd1887f53af3f6f24c198a6340f10671455e2884;hb=3269b15da0e701820b765003eeb3b931560bf645;hp=0d409aba7096e119f30a82f55a0b365a45d4836a;hpb=30c122df62ec75f9ed7f392f24c2925675bf1d06;p=ghc-hetmet.git diff --git a/compiler/cmm/CmmCPSGen.hs b/compiler/cmm/CmmCPSGen.hs index 0d409ab..dd1887f 100644 --- a/compiler/cmm/CmmCPSGen.hs +++ b/compiler/cmm/CmmCPSGen.hs @@ -13,8 +13,7 @@ module CmmCPSGen ( ContinuationFormat(..), ) where -#include "HsVersions.h" - +import BlockId import Cmm import CLabel import CmmBrokenBlock -- Data types only @@ -59,7 +58,7 @@ data Continuation info = -- Right <=> Function or Proc point CLabel -- Used to generate both info & entry labels CmmFormalsWithoutKinds -- Argument locals live on entry (C-- procedure params) - Bool -- ^ True <=> GC block so ignore stack size + Bool -- True <=> GC block so ignore stack size [BrokenBlock] -- Code, may be empty. The first block is -- the entry point. The order is otherwise initially -- unimportant, but at some point the code gen will @@ -178,12 +177,12 @@ continuationToProc (max_stack, update_frame_size, formats) stack_use uniques main_stmts = case entry of FunctionEntry _ _ _ -> - -- Ugh, the statements for an update frame must come - -- *after* the GC check that was added at the beginning - -- of the CPS pass. So we have do edit the statements - -- a bit. This depends on the knowledge that the - -- statements in the first block are only the GC check. - -- That's fragile but it works for now. + -- The statements for an update frame must come /after/ + -- the GC check that was added at the beginning of the + -- CPS pass. So we have do edit the statements a bit. + -- This depends on the knowledge that the statements in + -- the first block are only the GC check. That's + -- fragile but it works for now. gc_stmts ++ stmts ++ update_stmts ++ postfix_stmts ControlEntry -> stmts ++ postfix_stmts ContinuationEntry _ _ _ -> stmts ++ postfix_stmts @@ -229,7 +228,7 @@ continuationToProc (max_stack, update_frame_size, formats) stack_use uniques foreignCall call_uniques (CmmPrim target) results arguments -formal_to_actual reg = CmmHinted (CmmReg (CmmLocal reg)) NoHint +formal_to_actual reg = CmmKinded (CmmReg (CmmLocal reg)) NoHint foreignCall :: [Unique] -> CmmCallTarget -> CmmFormals -> CmmActuals -> [CmmStmt] foreignCall uniques call results arguments = @@ -237,14 +236,14 @@ foreignCall uniques call results arguments = saveThreadState ++ caller_save ++ [CmmCall (CmmCallee suspendThread CCallConv) - [ CmmHinted id PtrHint ] - [ CmmHinted (CmmReg (CmmGlobal BaseReg)) PtrHint ] + [ CmmKinded id PtrHint ] + [ CmmKinded (CmmReg (CmmGlobal BaseReg)) PtrHint ] CmmUnsafe CmmMayReturn, CmmCall call results new_args CmmUnsafe CmmMayReturn, CmmCall (CmmCallee resumeThread CCallConv) - [ CmmHinted new_base PtrHint ] - [ CmmHinted (CmmReg (CmmLocal id)) PtrHint ] + [ CmmKinded new_base PtrHint ] + [ CmmKinded (CmmReg (CmmLocal id)) PtrHint ] CmmUnsafe CmmMayReturn, -- Assign the result to BaseReg: we @@ -252,7 +251,7 @@ foreignCall uniques call results arguments = CmmAssign (CmmGlobal BaseReg) (CmmReg (CmmLocal new_base))] ++ caller_load ++ loadThreadState tso_unique ++ - [CmmJump (CmmReg spReg) (map (formal_to_actual . hintlessCmm) results)] + [CmmJump (CmmReg spReg) (map (formal_to_actual . kindlessCmm) results)] where (_, arg_stmts, new_args) = loadArgsIntoTemps argument_uniques arguments @@ -265,8 +264,8 @@ foreignCall uniques call results arguments = -- ----------------------------------------------------------------------------- -- Save/restore the thread state in the TSO -suspendThread = CmmLit (CmmLabel (mkRtsCodeLabel SLIT("suspendThread"))) -resumeThread = CmmLit (CmmLabel (mkRtsCodeLabel SLIT("resumeThread"))) +suspendThread = CmmLit (CmmLabel (mkRtsCodeLabel (sLit "suspendThread"))) +resumeThread = CmmLit (CmmLabel (mkRtsCodeLabel (sLit "resumeThread"))) -- This stuff can't be done in suspendThread/resumeThread, because it -- refers to global registers which aren't available in the C world. @@ -364,12 +363,12 @@ tail_call spRel target arguments = store_arguments ++ adjust_sp_reg spRel ++ jump where store_arguments = [stack_put spRel expr offset - | ((CmmHinted expr _), StackParam offset) <- argument_formats] ++ + | ((CmmKinded expr _), StackParam offset) <- argument_formats] ++ [global_put expr global - | ((CmmHinted expr _), RegisterParam global) <- argument_formats] + | ((CmmKinded expr _), RegisterParam global) <- argument_formats] jump = [CmmJump target arguments] - argument_formats = assignArguments (cmmExprRep . hintlessCmm) arguments + argument_formats = assignArguments (cmmExprRep . kindlessCmm) arguments adjust_sp_reg spRel = if spRel == 0