[commit: ghc] ghc-8.0: Properly track live registers when saving the CCCS. (31c11d0)

[git at git.haskell.org]

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

On branch  : ghc-8.0
Link       : http://ghc.haskell.org/trac/ghc/changeset/31c11d06e3a9d3f362e585e2c65d59a331623b2b/ghc

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

commit 31c11d06e3a9d3f362e585e2c65d59a331623b2b
Author: Geoffrey Mainland <mainland at apeiron.net>
Date:   Thu Jan 28 09:58:37 2016 -0500

    Properly track live registers when saving the CCCS.
    
    Summary:
    When saving the CCCS, we now correctly track the set of live registers and pass
    them to the jump_SAVE_CCCS macro. This is now a variadic macro, but variadic
    macros are supported by GCC since 3.0 and by all versions of clang, so this
    should not be a problem.
    
    Test Plan:
    ./validate with the following build options:
    
    ```
    BuildFlavour = quick-llvm
    SRC_HC_OPTS_STAGE1 = -fllvm-fill-undef-with-garbage
    ```
    
    Reviewers: bgamari, simonmar, austin, rwbarton, simonpj
    
    Subscribers: thomie
    
    Differential Revision: https://phabricator.haskell.org/D1864
    
    GHC Trac Issues: #11487
    
    (cherry picked from commit 6544f8de1ed575378f14b82a2eaa06cab58b2d65)


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

31c11d06e3a9d3f362e585e2c65d59a331623b2b
 rts/AutoApply.h        |  6 +++---
 utils/genapply/Main.hs | 29 ++++++++++++++++++++++++++---
 2 files changed, 29 insertions(+), 6 deletions(-)

diff --git a/rts/AutoApply.h b/rts/AutoApply.h
index 74af74b..601e35f 100644
--- a/rts/AutoApply.h
+++ b/rts/AutoApply.h
@@ -78,13 +78,13 @@
 
 // Jump to target, saving CCCS and restoring it on return
 #if defined(PROFILING)
-#define jump_SAVE_CCCS(target)                  \
+#define jump_SAVE_CCCS(target,...)              \
     Sp(-1) = CCCS;                              \
     Sp(-2) = stg_restore_cccs_info;             \
     Sp_adj(-2);                                 \
-    jump (target) [R1]
+    jump (target) [__VA_ARGS__]
 #else
-#define jump_SAVE_CCCS(target) jump (target) [R1]
+#define jump_SAVE_CCCS(target,...) jump (target) [__VA_ARGS__]
 #endif
 
 #endif /* APPLY_H */
diff --git a/utils/genapply/Main.hs b/utils/genapply/Main.hs
index 10fc1a6..3d28fec 100644
--- a/utils/genapply/Main.hs
+++ b/utils/genapply/Main.hs
@@ -157,7 +157,28 @@ mkJump :: RegStatus -- Registerised status
        -> [ArgRep]  -- Jump arguments
        -> Doc
 mkJump regstatus jump live args =
-    text "jump" <+> jump <+> brackets (hcat (punctuate comma (map text regs)))
+    text "jump" <+> jump <+> brackets (hcat (punctuate comma liveRegs))
+  where
+    liveRegs = mkJumpLiveRegs regstatus live args
+
+-- Make a jump, saving CCCS and restoring it on return
+mkJumpSaveCCCS :: RegStatus -- Registerised status
+               -> Doc       -- Jump target
+               -> [Reg]     -- Registers that are definitely live
+               -> [ArgRep]  -- Jump arguments
+               -> Doc
+mkJumpSaveCCCS regstatus jump live args =
+    text "jump_SAVE_CCCS" <> parens (hcat (punctuate comma (jump : liveRegs)))
+  where
+    liveRegs = mkJumpLiveRegs regstatus live args
+
+-- Calculate live registers for a jump
+mkJumpLiveRegs :: RegStatus -- Registerised status
+               -> [Reg]     -- Registers that are definitely live
+               -> [ArgRep]  -- Jump arguments
+               -> [Doc]
+mkJumpLiveRegs regstatus live args =
+    map text regs
   where
     (reg_locs, _, _) = assignRegs regstatus 0 args
     regs             = (nub . sort) (live ++ map fst reg_locs)
@@ -318,7 +339,8 @@ genMkPAP regstatus macro jump live ticker disamb
                 else empty,
             if is_fun_case then mb_tag_node arity else empty,
             if overflow_regs
-                then text "jump_SAVE_CCCS" <> parens (text jump) <> semi
+                then mkJumpSaveCCCS
+                       regstatus (text jump) live (take arity args) <> semi
                 else mkJump regstatus (text jump) live (if no_load_regs then [] else args) <> semi
             ]) $$
            text "}"
@@ -741,7 +763,8 @@ genApply regstatus args =
           -- overwritten by an indirection, so we must enter the original
           -- info pointer we read, don't read it again, because it might
           -- not be enterable any more.
-          text "jump_SAVE_CCCS(%ENTRY_CODE(info));",
+          mkJumpSaveCCCS
+            regstatus (text "%ENTRY_CODE(info)") ["R1"] args <> semi,
             -- see Note [jump_SAVE_CCCS]
           text ""
          ]),