Repository : ssh://darcs.haskell.org//srv/darcs/ghc On branch : newcg
http://hackage.haskell.org/trac/ghc/changeset/ca7a31acaa6c0a19c435ae4016db9879f28db6aa >--------------------------------------------------------------- commit ca7a31acaa6c0a19c435ae4016db9879f28db6aa Author: Simon Marlow <[email protected]> Date: Wed Mar 7 14:54:41 2012 +0000 refactoring only >--------------------------------------------------------------- compiler/cmm/CmmLayoutStack.hs | 100 +++++++++++++++++++++++++++------------- 1 files changed, 68 insertions(+), 32 deletions(-) diff --git a/compiler/cmm/CmmLayoutStack.hs b/compiler/cmm/CmmLayoutStack.hs index 87f495a..f6ce5a2 100644 --- a/compiler/cmm/CmmLayoutStack.hs +++ b/compiler/cmm/CmmLayoutStack.hs @@ -141,13 +141,6 @@ layout :: BlockSet -- proc points layout procpoints liveness entry entry_args final_stackmaps final_hwm blocks = go blocks init_stackmap entry_args [] where - sp_high = final_hwm - entry_args - -- The stack check value is adjusted by the Sp offset on - -- entry to the proc, which is entry_args. We are - -- assuming that we only do a stack check at the - -- beginning of a proc, and we don't modify Sp before the - -- check. - (updfr, cont_info) = collectContInfo blocks init_stackmap = mapSingleton entry StackMap{ sm_sp = entry_args @@ -195,42 +188,80 @@ layout procpoints liveness entry entry_args final_stackmaps final_hwm blocks -- middle3 -- some more middle nodes from handleLastNode -- last1 -- the last node -- - -- The next step is to manifest Sp: turn all the CmmStackSlots - -- into CmmLoads from Sp. The adjustment for middle1/middle2 - -- will be different from that for middle3/last1, because the - -- Sp adjustment intervenes. - -- - let area_off = getAreaOff final_stackmaps + let middle_pre = blockToList $ foldl blockSnoc middle1 middle2 - adj_pre_sp, adj_post_sp :: CmmNode e x -> CmmNode e x - adj_pre_sp = mapExpDeep (areaToSp sp0 sp_high area_off) - adj_post_sp = mapExpDeep (areaToSp (sp0 - sp_off) sp_high area_off) + sp_high = final_hwm - entry_args + -- The stack check value is adjusted by the Sp offset on + -- entry to the proc, which is entry_args. We are + -- assuming that we only do a stack check at the + -- beginning of a proc, and we don't modify Sp before the + -- check. - middle_pre = maybeAddSpAdj sp_off $ - blockFromList $ - map adj_pre_sp $ - elimStackStores stack0 final_stackmaps area_off $ - blockToList $ - foldl blockSnoc middle1 middle2 + final_blocks = manifestSp final_stackmaps stack0 sp0 sp_high entry0 + middle_pre sp_off middle3 last1 fixup_blocks - middle_post = map adj_post_sp middle3 + stackmaps' = mapUnion acc_stackmaps out - final_middle = foldl blockSnoc middle_pre middle_post - final_last = optStackCheck (adj_post_sp last1) + hwm' = maximum (acc_hwm : (sp0 - sp_off) : map sm_sp (mapElems out)) - newblock = blockJoin entry0 final_middle final_last + pprTrace "layout(wibble)" (ppr out) $ return () - fixup_blocks' = map (blockMapNodes3 (id, adj_post_sp, id)) - fixup_blocks + go bs stackmaps' hwm' (final_blocks ++ acc_blocks) - stackmaps' = mapUnion acc_stackmaps out - hwm' = maximum (acc_hwm : map sm_sp (mapElems out)) +-- ----------------------------------------------------------------------------- - pprTrace "layout(out)" (ppr out) $ return () +-- | Manifest Sp: turn all the CmmStackSlots into CmmLoads from Sp. The +-- block looks like this: +-- +-- middle_pre -- some middle nodes +-- Sp = Sp + sp_off -- Sp adjustment goes here +-- middle_post -- some more middle nodes, after the Sp adjustment +-- last -- the last node +-- +-- And we have some extra blocks too (that don't contain Sp adjustments) +-- +-- The adjustment for middle_pre will be different from that for +-- middle_post, because the Sp adjustment intervenes. +-- +manifestSp + :: BlockEnv StackMap -- StackMaps for other blocks + -> StackMap -- StackMap for this block + -> ByteOff -- Sp on entry to the block + -> ByteOff -- SpHigh + -> CmmNode C O -- first node + -> [CmmNode O O] -- middle_pre + -> ByteOff -- sp_off + -> [CmmNode O O] -- middle_post + -> CmmNode O C -- last node + -> [CmmBlock] -- new blocks + -> [CmmBlock] -- final blocks with Sp manifest + +manifestSp stackmaps stack0 sp0 sp_high + first middle_pre sp_off middle_post last fixup_blocks + = blockJoin first final_middle final_last : fixup_blocks' + where + area_off = getAreaOff stackmaps + + adj_pre_sp, adj_post_sp :: CmmNode e x -> CmmNode e x + adj_pre_sp = mapExpDeep (areaToSp sp0 sp_high area_off) + adj_post_sp = mapExpDeep (areaToSp (sp0 - sp_off) sp_high area_off) + + middle_pre' = maybeAddSpAdj sp_off $ + blockFromList $ + map adj_pre_sp $ + elimStackStores stack0 stackmaps area_off $ + middle_pre + + middle_post' = map adj_post_sp middle_post - go bs stackmaps' hwm' (newblock : fixup_blocks' ++ acc_blocks) + final_middle = foldl blockSnoc middle_pre' middle_post' + final_last = optStackCheck (adj_post_sp last) + fixup_blocks' = map (blockMapNodes3 (id, adj_post_sp, id)) fixup_blocks + + +-- ----------------------------------------------------------------------------- -- | Eliminate stores of the form -- @@ -445,6 +476,11 @@ handleLastNode procpoints liveness cont_info stackmaps , [CmmBlock] , BlockEnv StackMap ) +-- handleProcPoints +-- | Just l <- future_continuation +-- , nub $ filter (`setMember` procpoints) $ successors last == [l] +-- = + handleProcPoints = do pps <- mapM handleProcPoint (successors last) let lbl_map :: LabelMap Label _______________________________________________ Cvs-ghc mailing list [email protected] http://www.haskell.org/mailman/listinfo/cvs-ghc
