projects
/
ghc-hetmet.git
/ blobdiff
commit
grep
author
committer
pickaxe
?
search:
re
summary
|
shortlog
|
log
|
commit
|
commitdiff
|
tree
raw
|
inline
| side by side
Pointer Tagging
[ghc-hetmet.git]
/
compiler
/
codeGen
/
CgProf.hs
diff --git
a/compiler/codeGen/CgProf.hs
b/compiler/codeGen/CgProf.hs
index
27ee54c
..
651f0ea
100644
(file)
--- a/
compiler/codeGen/CgProf.hs
+++ b/
compiler/codeGen/CgProf.hs
@@
-20,7
+20,7
@@
module CgProf (
emitSetCCC, emitCCS,
-- Lag/drag/void stuff
emitSetCCC, emitCCS,
-- Lag/drag/void stuff
- ldvEnter, ldvRecordCreate
+ ldvEnter, ldvEnterClosure, ldvRecordCreate
) where
#include "HsVersions.h"
) where
#include "HsVersions.h"
@@
-242,9
+242,12
@@
enter_cost_centre closure_info ccs body
where
enc_ccs = CmmLit (mkCCostCentreStack ccs)
re_entrant = closureReEntrant closure_info
where
enc_ccs = CmmLit (mkCCostCentreStack ccs)
re_entrant = closureReEntrant closure_info
- node_ccs = costCentreFrom (CmmReg nodeReg)
+ node_ccs = costCentreFrom (cmmOffsetB (CmmReg nodeReg) (-node_tag))
is_box = isBox body
is_box = isBox body
+ -- if this is a function, then node will be tagged; we must subract the tag
+ node_tag = funTag closure_info
+
-- set the current CCS when entering a PAP
enterCostCentrePAP :: CmmExpr -> Code
enterCostCentrePAP closure =
-- set the current CCS when entering a PAP
enterCostCentrePAP :: CmmExpr -> Code
enterCostCentrePAP closure =
@@
-448,9
+451,14
@@
ldvRecordCreate closure = stmtC $ CmmStore (ldvWord closure) dynLdvInit
-- The closure is not IND or IND_OLDGEN because neither is considered for LDV
-- profiling.
--
-- The closure is not IND or IND_OLDGEN because neither is considered for LDV
-- profiling.
--
+ldvEnterClosure :: ClosureInfo -> Code
+ldvEnterClosure closure_info = ldvEnter (cmmOffsetB (CmmReg nodeReg) (-tag))
+ where tag = funTag closure_info
+ -- don't forget to substract node's tag
+
ldvEnter :: CmmExpr -> Code
-- Argument is a closure pointer
ldvEnter :: CmmExpr -> Code
-- Argument is a closure pointer
-ldvEnter cl_ptr
+ldvEnter cl_ptr
= ifProfiling $
-- if (era > 0) {
-- LDVW((c)) = (LDVW((c)) & LDV_CREATE_MASK) |
= ifProfiling $
-- if (era > 0) {
-- LDVW((c)) = (LDVW((c)) & LDV_CREATE_MASK) |
@@
-458,6
+466,7
@@
ldvEnter cl_ptr
emitIf (CmmMachOp mo_wordUGt [loadEra, CmmLit zeroCLit])
(stmtC (CmmStore ldv_wd new_ldv_wd))
where
emitIf (CmmMachOp mo_wordUGt [loadEra, CmmLit zeroCLit])
(stmtC (CmmStore ldv_wd new_ldv_wd))
where
+ -- don't forget to substract node's tag
ldv_wd = ldvWord cl_ptr
new_ldv_wd = cmmOrWord (cmmAndWord (CmmLoad ldv_wd wordRep)
(CmmLit (mkWordCLit lDV_CREATE_MASK)))
ldv_wd = ldvWord cl_ptr
new_ldv_wd = cmmOrWord (cmmAndWord (CmmLoad ldv_wd wordRep)
(CmmLit (mkWordCLit lDV_CREATE_MASK)))