diff options
| author | Simon Marlow <marlowsd@gmail.com> | 2011-11-29 14:05:17 +0000 |
|---|---|---|
| committer | Simon Marlow <marlowsd@gmail.com> | 2011-11-29 14:22:28 +0000 |
| commit | 1f7433b7b998dda4dde6d09f22a37f637745c079 (patch) | |
| tree | a19c5247c1d7a4816afc8fbe7d15374209c39e6c /compiler/codeGen | |
| parent | 1ed0dfa1fe8d50ece73ee9872aa045998ef6f0f5 (diff) | |
| download | haskell-1f7433b7b998dda4dde6d09f22a37f637745c079.tar.gz | |
Add a new primop: getCCCS# :: State# s -> (# State# s, Addr# #)
Returns a pointer to the current cost-centre stack when profiling,
NULL otherwise.
Diffstat (limited to 'compiler/codeGen')
| -rw-r--r-- | compiler/codeGen/CgPrimOp.hs | 2 | ||||
| -rw-r--r-- | compiler/codeGen/StgCmmPrim.hs | 3 |
2 files changed, 5 insertions, 0 deletions
diff --git a/compiler/codeGen/CgPrimOp.hs b/compiler/codeGen/CgPrimOp.hs index 6fe934b54c..72bbf6cc58 100644 --- a/compiler/codeGen/CgPrimOp.hs +++ b/compiler/codeGen/CgPrimOp.hs @@ -155,6 +155,8 @@ emitPrimOp [res] SparkOp [arg] live = do where newspark = CmmLit (CmmLabel (mkCmmCodeLabel rtsPackageId (fsLit "newSpark"))) +emitPrimOp [res] GetCCCSOp [] _live + = stmtC (CmmAssign (CmmLocal res) curCCS) emitPrimOp [res] ReadMutVarOp [mutv] _ = stmtC (CmmAssign (CmmLocal res) (cmmLoadIndexW mutv fixedHdrSize gcWord)) diff --git a/compiler/codeGen/StgCmmPrim.hs b/compiler/codeGen/StgCmmPrim.hs index f8cc4256f4..d546c38a90 100644 --- a/compiler/codeGen/StgCmmPrim.hs +++ b/compiler/codeGen/StgCmmPrim.hs @@ -228,6 +228,9 @@ emitPrimOp [res] SparkOp [arg] [(CmmReg (CmmGlobal BaseReg), AddrHint), ((CmmReg (CmmLocal tmp)), AddrHint)] emit (mkAssign (CmmLocal res) (CmmReg (CmmLocal tmp))) +emitPrimOp [res] GetCCCSOp [] + = emit (mkAssign (CmmLocal res) curCCS) + emitPrimOp [res] ReadMutVarOp [mutv] = emit (mkAssign (CmmLocal res) (cmmLoadIndexW mutv fixedHdrSize gcWord)) |