diff options
| -rw-r--r-- | rts/AutoApply.h | 6 | ||||
| -rw-r--r-- | utils/genapply/Main.hs | 29 |
2 files changed, 29 insertions, 6 deletions
diff --git a/rts/AutoApply.h b/rts/AutoApply.h index 7c8af93942..4e441ca18b 100644 --- a/rts/AutoApply.h +++ b/rts/AutoApply.h @@ -90,13 +90,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 58bee53a39..b8208aeb0d 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 "}" @@ -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 "" ]), |