Properly track live registers when saving the CCCS.
authorGeoffrey Mainland <mainland@apeiron.net>
Thu, 28 Jan 2016 14:58:37 +0000 (09:58 -0500)
committerGeoffrey Mainland <mainland@apeiron.net>
Sun, 31 Jan 2016 18:01:31 +0000 (13:01 -0500)
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

rts/AutoApply.h
utils/genapply/Main.hs

index 7c8af93..4e441ca 100644 (file)
 
 // 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 */
index 58bee53..b8208ae 100644 (file)
@@ -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 "}"
@@ -740,7 +762,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 ""
          ]),