[commit: ghc] newcg: refactoring only (ca7a31a)

[Simon Marlow]

Repository : ssh://darcs.haskell.org//srv/darcs/ghc

On branch  : newcg

http://hackage.haskell.org/trac/ghc/changeset/ca7a31acaa6c0a19c435ae4016db9879f28db6aa

>---------------------------------------------------------------

commit ca7a31acaa6c0a19c435ae4016db9879f28db6aa
Author: Simon Marlow <marlowsd at gmail.com>
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