diff options
| author | Simon Peyton Jones <simonpj@microsoft.com> | 2011-06-30 14:49:14 +0100 |
|---|---|---|
| committer | Simon Peyton Jones <simonpj@microsoft.com> | 2011-06-30 14:49:14 +0100 |
| commit | bfbf3858110b1e16b2efd89f691e426b03e52343 (patch) | |
| tree | 7f8b2aa422c9a372b0c8034670a058025b5dcbdc /compiler/codeGen/CgPrimOp.hs | |
| parent | a347cd7c384eb255b5507a40840205d052f137c6 (diff) | |
| parent | e49dae36a00b2af8f6ad583dd24f9bacf5711242 (diff) | |
| download | haskell-bfbf3858110b1e16b2efd89f691e426b03e52343.tar.gz | |
Merge branch 'master' of http://darcs.haskell.org/ghc
Diffstat (limited to 'compiler/codeGen/CgPrimOp.hs')
| -rw-r--r-- | compiler/codeGen/CgPrimOp.hs | 20 |
1 files changed, 20 insertions, 0 deletions
diff --git a/compiler/codeGen/CgPrimOp.hs b/compiler/codeGen/CgPrimOp.hs index 87ed25c041..c2a57a40d2 100644 --- a/compiler/codeGen/CgPrimOp.hs +++ b/compiler/codeGen/CgPrimOp.hs @@ -127,8 +127,28 @@ emitPrimOp [res] ParOp [arg] live NoC_SRT -- No SRT b/c we do PlayRisky CmmMayReturn where + newspark = CmmLit (CmmLabel (mkCmmCodeLabel rtsPackageId (fsLit "newSpark"))) + +emitPrimOp [res] SparkOp [arg] live = do + -- returns the value of arg in res. We're going to therefore + -- refer to arg twice (once to pass to newSpark(), and once to + -- assign to res), so put it in a temporary. + tmp <- newTemp bWord + stmtC (CmmAssign (CmmLocal tmp) arg) + + vols <- getVolatileRegs live + emitForeignCall' PlayRisky [] + (CmmCallee newspark CCallConv) + [ (CmmHinted (CmmReg (CmmGlobal BaseReg)) AddrHint) + , (CmmHinted arg AddrHint) ] + (Just vols) + NoC_SRT -- No SRT b/c we do PlayRisky + CmmMayReturn + stmtC (CmmAssign (CmmLocal res) (CmmReg (CmmLocal tmp))) + where newspark = CmmLit (CmmLabel (mkCmmCodeLabel rtsPackageId (fsLit "newSpark"))) + emitPrimOp [res] ReadMutVarOp [mutv] _ = stmtC (CmmAssign (CmmLocal res) (cmmLoadIndexW mutv fixedHdrSize gcWord)) |