Repository : ssh://darcs.haskell.org//srv/darcs/ghc On branch : master
http://hackage.haskell.org/trac/ghc/changeset/82c9f3f0f42e917b113d2174f468e86074b895cc >--------------------------------------------------------------- commit 82c9f3f0f42e917b113d2174f468e86074b895cc Author: Edward Z. Yang <[email protected]> Date: Thu Jul 7 20:48:48 2011 -0400 Port 'Add two new primops seq# and spark#' (be54417) to new codegen. Signed-off-by: Edward Z. Yang <[email protected]> >--------------------------------------------------------------- compiler/codeGen/StgCmmExpr.hs | 20 ++++++++++++++++++++ compiler/codeGen/StgCmmPrim.hs | 12 ++++++++++++ 2 files changed, 32 insertions(+), 0 deletions(-) diff --git a/compiler/codeGen/StgCmmExpr.hs b/compiler/codeGen/StgCmmExpr.hs index eee4a08..0edcbe4 100644 --- a/compiler/codeGen/StgCmmExpr.hs +++ b/compiler/codeGen/StgCmmExpr.hs @@ -71,6 +71,10 @@ cgExpr (StgLetNoEscape _ _ binds expr) = cgExpr (StgCase expr _live_vars _save_vars bndr srt alt_type alts) = cgCase expr bndr srt alt_type alts +{- seq# a s ==> a -} +cgExpr (StgOpApp (StgPrimOp SeqOp) [StgVarArg a, _] _res_ty) = + cgIdApp a [] + cgExpr (StgLam {}) = panic "cgExpr: StgLam" ------------------------------------------------------------------------ @@ -322,6 +326,22 @@ cgCase scrut@(StgApp v []) _ _ (PrimAlt _) _ ; emit $ mkComment $ mkFastString "should be unreachable code" ; emit $ withFreshLabel "l" (\l -> mkLabel l <*> mkBranch l)} +{- +case seq# a s of v + (# s', a' #) -> e + +==> + +case a of v + (# s', a' #) -> e + +(taking advantage of the fact that the return convention for (# State#, a #) +is the same as the return convention for just 'a') +-} +cgCase (StgOpApp (StgPrimOp SeqOp) [StgVarArg a, _] _) bndr srt alt_type alts + = -- handle seq#, same return convention as vanilla 'a'. + cgCase (StgApp a []) bndr srt alt_type alts + cgCase scrut bndr srt alt_type alts = -- the general case do { up_hp_usg <- getVirtHp -- Upstream heap usage diff --git a/compiler/codeGen/StgCmmPrim.hs b/compiler/codeGen/StgCmmPrim.hs index 1a6d05e..c71d285 100644 --- a/compiler/codeGen/StgCmmPrim.hs +++ b/compiler/codeGen/StgCmmPrim.hs @@ -210,6 +210,18 @@ emitPrimOp [res] ParOp [arg] (CmmLit (CmmLabel (mkCmmCodeLabel rtsPackageId (fsLit "newSpark")))) [(CmmReg (CmmGlobal BaseReg), AddrHint), (arg,AddrHint)] +emitPrimOp [res] SparkOp [arg] + = 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 <- assignTemp arg + emitCCall + [] + (CmmLit (CmmLabel (mkCmmCodeLabel rtsPackageId (fsLit "newSpark")))) + [(CmmReg (CmmGlobal BaseReg), AddrHint), ((CmmReg (CmmLocal tmp)), AddrHint)] + emit (mkAssign (CmmLocal res) (CmmReg (CmmLocal tmp))) + emitPrimOp [res] ReadMutVarOp [mutv] = emit (mkAssign (CmmLocal res) (cmmLoadIndexW mutv fixedHdrSize gcWord)) _______________________________________________ Cvs-ghc mailing list [email protected] http://www.haskell.org/mailman/listinfo/cvs-ghc
