diff options
| author | Simon Marlow <marlowsd@gmail.com> | 2011-11-30 10:33:47 +0000 |
|---|---|---|
| committer | Simon Marlow <marlowsd@gmail.com> | 2011-11-30 11:33:16 +0000 |
| commit | 1fc25dfd0ba410b8100f2f910394ae041758c8c5 (patch) | |
| tree | 4773e1ea40a8b7bb816293ba0263ff5acac13836 /compiler/codeGen | |
| parent | b35a12aa910dcb90cfd7b40ca1fb6d89a0a63bc8 (diff) | |
| download | haskell-1fc25dfd0ba410b8100f2f910394ae041758c8c5.tar.gz | |
Further tweaks to the ccs primops
- add getCCSOf# :: a -> State# s -> (# State# s, Addr# #)
(returns the CCS attached to the supplied object)
- remove traceCcs# (obsoleted by getCCSOf#)
- rename getCCCS# to getCurrentCCS#
Diffstat (limited to 'compiler/codeGen')
| -rw-r--r-- | compiler/codeGen/CgPrimOp.hs | 9 | ||||
| -rw-r--r-- | compiler/codeGen/StgCmmPrim.hs | 9 |
2 files changed, 16 insertions, 2 deletions
diff --git a/compiler/codeGen/CgPrimOp.hs b/compiler/codeGen/CgPrimOp.hs index 72bbf6cc58..43a570d41e 100644 --- a/compiler/codeGen/CgPrimOp.hs +++ b/compiler/codeGen/CgPrimOp.hs @@ -38,6 +38,7 @@ import Module import Constants import Outputable import FastString +import StaticFlags -- --------------------------------------------------------------------------- -- Code generation for PrimOps @@ -155,7 +156,13 @@ emitPrimOp [res] SparkOp [arg] live = do where newspark = CmmLit (CmmLabel (mkCmmCodeLabel rtsPackageId (fsLit "newSpark"))) -emitPrimOp [res] GetCCCSOp [] _live +emitPrimOp [res] GetCCSOfOp [arg] _live + = stmtC (CmmAssign (CmmLocal res) val) + where + val | opt_SccProfilingOn = costCentreFrom (cmmUntag arg) + | otherwise = CmmLit zeroCLit + +emitPrimOp [res] GetCurrentCCSOp [_dummy_arg] _live = stmtC (CmmAssign (CmmLocal res) curCCS) emitPrimOp [res] ReadMutVarOp [mutv] _ diff --git a/compiler/codeGen/StgCmmPrim.hs b/compiler/codeGen/StgCmmPrim.hs index d546c38a90..a2337aee91 100644 --- a/compiler/codeGen/StgCmmPrim.hs +++ b/compiler/codeGen/StgCmmPrim.hs @@ -42,6 +42,7 @@ import Constants import Module import FastString import Outputable +import StaticFlags ------------------------------------------------------------------------ -- Primitive operations and foreign calls @@ -228,7 +229,13 @@ emitPrimOp [res] SparkOp [arg] [(CmmReg (CmmGlobal BaseReg), AddrHint), ((CmmReg (CmmLocal tmp)), AddrHint)] emit (mkAssign (CmmLocal res) (CmmReg (CmmLocal tmp))) -emitPrimOp [res] GetCCCSOp [] +emitPrimOp [res] GetCCSOfOp [arg] + = emit (mkAssign (CmmLocal res) val) + where + val | opt_SccProfilingOn = costCentreFrom (cmmUntag arg) + | otherwise = CmmLit zeroCLit + +emitPrimOp [res] GetCurrentCCSOp [_dummy_arg] = emit (mkAssign (CmmLocal res) curCCS) emitPrimOp [res] ReadMutVarOp [mutv] |