X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Fcmm%2FCmmCPSGen.hs;h=3b93b0947e18647a4c9d0de15a6996d12559da8f;hb=0fbb3a5de71b28f24b46bc373551f738ab0b08eb;hp=01b9eb15e146e98c53049ff825d6a9b08fbdf89b;hpb=be0113bd76ee19c9c03b4b601e1861f1d40ff04c;p=ghc-hetmet.git diff --git a/compiler/cmm/CmmCPSGen.hs b/compiler/cmm/CmmCPSGen.hs index 01b9eb1..3b93b09 100644 --- a/compiler/cmm/CmmCPSGen.hs +++ b/compiler/cmm/CmmCPSGen.hs @@ -140,7 +140,7 @@ continuationToProc (max_stack, update_frame_size, formats) stack_use uniques arguments = map formal_to_actual (continuation_formals cont_format) in (new_next, [BasicBlock new_next $ - pack_continuation False curr_format cont_format ++ + pack_continuation curr_format cont_format ++ tail_call (curr_stack - cont_stack) (CmmLit $ CmmLabel $ toCLabel next) arguments]) @@ -201,7 +201,7 @@ continuationToProc (max_stack, update_frame_size, formats) stack_use uniques -- A regular Cmm function call FinalCall next (CmmForeignCall target CmmCallConv) results arguments _ _ -> - pack_continuation True curr_format cont_format ++ + pack_continuation curr_format cont_format ++ tail_call (curr_stack - cont_stack) target arguments where @@ -387,17 +387,11 @@ gc_stack_check gc_block max_frame_size gc_block] -pack_continuation :: Bool -- ^ Whether to set the top/header - -- of the stack. We only need to - -- set it if we are calling down - -- as opposed to continuation - -- adaptors. - -> ContinuationFormat -- ^ The current format +pack_continuation :: ContinuationFormat -- ^ The current format -> ContinuationFormat -- ^ The return point format -> [CmmStmt] -pack_continuation allow_header_set - (ContinuationFormat _ curr_id curr_frame_size _) - (ContinuationFormat _ cont_id cont_frame_size live_regs) +pack_continuation (ContinuationFormat _ curr_id curr_frame_size _) + (ContinuationFormat _ cont_id cont_frame_size live_regs) = pack_frame curr_frame_size cont_frame_size maybe_header continuation_args where continuation_args = map (maybe Nothing (Just . CmmReg . CmmLocal)) @@ -407,7 +401,7 @@ pack_continuation allow_header_set (Just x, Just y) -> x /= y _ -> isJust cont_id - maybe_header = if allow_header_set && needs_header_set + maybe_header = if needs_header_set then maybe Nothing (Just . CmmLit . CmmLabel . entryLblToInfoLbl) cont_id else Nothing