[commit: ghc] master: StgCmmCon: Do not generate moves from unused fields to local variables (cd50d23)

[git at git.haskell.org]

Repository : ssh://git@git.haskell.org/ghc

On branch  : master
Link       : http://ghc.haskell.org/trac/ghc/changeset/cd50d236a4b29a9932ce4e12972db1fdd69f31be/ghc

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

commit cd50d236a4b29a9932ce4e12972db1fdd69f31be
Author: Ömer Sinan Ağacan <omeragacan at gmail.com>
Date:   Fri May 27 05:18:47 2016 -0400

    StgCmmCon: Do not generate moves from unused fields to local variables
    
    Say we have a record like this:
    
        data Rec = Rec
          { f1 :: Int
          , f2 :: Int
          , f3 :: Int
          , f4 :: Int
          , f5 :: Int
          }
    
    Before this patch, the code generated for `f1` looked like this:
    
        f1_entry()
            {offset
               ...
               cJT:
                   _sI6::P64 = R1;
                   _sI7::P64 = P64[_sI6::P64 + 7];
                   _sI8::P64 = P64[_sI6::P64 + 15];
                   _sI9::P64 = P64[_sI6::P64 + 23];
                   _sIa::P64 = P64[_sI6::P64 + 31];
                   _sIb::P64 = P64[_sI6::P64 + 39];
                   R1 = _sI7::P64 & (-8);
                   Sp = Sp + 8;
                   call (I64[R1])(R1) args: 8, res: 0, upd: 8;
            }
    
    Note how all fields of the record are moved to local variables, even though
    they're never used. These moves make it to the final assembly:
    
        f1_info:
            ...
        _cJT:
            movq 7(%rbx),%rax
            movq 15(%rbx),%rcx
            movq 23(%rbx),%rcx
            movq 31(%rbx),%rcx
            movq 39(%rbx),%rbx
            movq %rax,%rbx
            andq $-8,%rbx
            addq $8,%rbp
            jmp *(%rbx)
    
    With this patch we stop generating these move instructions. Cmm becomes this:
    
        f1_entry()
            {offset
               ...
               cJT:
                   _sI6::P64 = R1;
                   _sI7::P64 = P64[_sI6::P64 + 7];
                   R1 = _sI7::P64 & (-8);
                   Sp = Sp + 8;
                   call (I64[R1])(R1) args: 8, res: 0, upd: 8;
            }
    
    Assembly becomes this:
    
        f1_info:
            ...
        _cJT:
            movq 7(%rbx),%rax
            movq %rax,%rbx
            andq $-8,%rbx
            addq $8,%rbp
            jmp *(%rbx)
    
    It turns out CmmSink already optimizes this, but it's better to generate
    better code in the first place.
    
    Reviewers: simonmar, simonpj, austin, bgamari
    
    Reviewed By: simonmar, simonpj
    
    Subscribers: rwbarton, thomie
    
    Differential Revision: https://phabricator.haskell.org/D2269


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

cd50d236a4b29a9932ce4e12972db1fdd69f31be
 compiler/codeGen/StgCmmCon.hs | 19 +++++++++++++------
 1 file changed, 13 insertions(+), 6 deletions(-)

diff --git a/compiler/codeGen/StgCmmCon.hs b/compiler/codeGen/StgCmmCon.hs
index 745dd72..04257dd 100644
--- a/compiler/codeGen/StgCmmCon.hs
+++ b/compiler/codeGen/StgCmmCon.hs
@@ -43,6 +43,7 @@ import PrelInfo
 import Outputable
 import Platform
 import Util
+import MonadUtils (mapMaybeM)
 
 import Control.Monad
 import Data.Char
@@ -258,12 +259,18 @@ bindConArgs (DataAlt con) base args
 
            -- The binding below forces the masking out of the tag bits
            -- when accessing the constructor field.
-           bind_arg :: (NonVoid Id, VirtualHpOffset) -> FCode LocalReg
-           bind_arg (arg, offset)
-               = do emit $ mkTaggedObjectLoad dflags (idToReg dflags arg) base offset tag
-                    bindArgToReg arg
-       mapM bind_arg args_w_offsets
+           bind_arg :: (NonVoid Id, VirtualHpOffset) -> FCode (Maybe LocalReg)
+           bind_arg (arg@(NonVoid b), offset)
+             | isDeadBinder b =
+                 -- Do not load unused fields from objects to local variables.
+                 -- (CmmSink can optimize this, but it's cheap and common enough
+                 -- to handle here)
+                 return Nothing
+             | otherwise      = do
+                 emit $ mkTaggedObjectLoad dflags (idToReg dflags arg) base offset tag
+                 Just <$> bindArgToReg arg
+
+       mapMaybeM bind_arg args_w_offsets
 
 bindConArgs _other_con _base args
   = ASSERT( null args ) return []
-