Commit ca7a31ac authored by Simon Marlow's avatar Simon Marlow

refactoring only

parent 93e42a68
......@@ -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 ()
go bs stackmaps' hwm' (newblock : fixup_blocks' ++ acc_blocks)
-- | 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
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
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment