X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=compiler%2FcodeGen%2FCgExpr.lhs;h=e58fda7156bd8bc72d3d4e5daf85b8905da8934d;hp=fff2b3d564b20e808f12e69d0b19938c43014354;hb=9ff76535edb25ab7434284adddb5c64708ecb547;hpb=49c98d143c382a1341e1046f5ca00819a25691ba diff --git a/compiler/codeGen/CgExpr.lhs b/compiler/codeGen/CgExpr.lhs index fff2b3d..e58fda7 100644 --- a/compiler/codeGen/CgExpr.lhs +++ b/compiler/codeGen/CgExpr.lhs @@ -26,6 +26,7 @@ import CgTailCall import CgInfoTbls import CgForeignCall import CgPrimOp +import CgHpc import CgUtils import ClosureInfo import Cmm @@ -120,11 +121,8 @@ cgExpr (StgOpApp (StgFCallOp fcall _) stg_args res_ty) = do | (stg_arg, (rep,expr)) <- stg_args `zip` reps_n_amodes, nonVoidArg rep] - -- in arg_tmps <- mapM assignTemp arg_exprs - let - arg_hints = zip arg_tmps (map (typeHint.stgArgType) stg_args) - -- in + let arg_hints = zip arg_tmps (map (typeHint.stgArgType) stg_args) {- Now, allocate some result regs. -} @@ -143,7 +141,7 @@ cgExpr (StgOpApp (StgPrimOp TagToEnumOp) [arg] res_ty) -- so save in a temp if non-trivial ; this_pkg <- getThisPackage ; stmtC (CmmAssign nodeReg (tagToClosure this_pkg tycon amode')) - ; performReturn (emitAlgReturnCode tycon amode') } + ; performReturn emitReturnInstr } where -- If you're reading this code in the attempt to figure -- out why the compiler panic'ed here, it is probably because @@ -159,12 +157,12 @@ cgExpr x@(StgOpApp op@(StgPrimOp primop) args res_ty) | ReturnsPrim VoidRep <- result_info = do cgPrimOp [] primop args emptyVarSet - performReturn emitDirectReturnInstr + performReturn emitReturnInstr | ReturnsPrim rep <- result_info = do cgPrimOp [dataReturnConvPrim (primRepToCgRep rep)] primop args emptyVarSet - performReturn emitDirectReturnInstr + performReturn emitReturnInstr | ReturnsAlg tycon <- result_info, isUnboxedTupleTyCon tycon = do (reps, regs, _hints) <- newUnboxedTupleRegs res_ty @@ -177,7 +175,7 @@ cgExpr x@(StgOpApp op@(StgPrimOp primop) args res_ty) this_pkg <- getThisPackage cgPrimOp [tag_reg] primop args emptyVarSet stmtC (CmmAssign nodeReg (tagToClosure this_pkg tycon (CmmReg tag_reg))) - performReturn (emitAlgReturnCode tycon (CmmReg tag_reg)) + performReturn emitReturnInstr where result_info = getPrimOpResultInfo primop \end{code} @@ -252,6 +250,16 @@ cgExpr (StgSCC cc expr) = do emitSetCCC cc; cgExpr expr \end{code} %******************************************************** +%* * +%* Hpc Tick Boxes * +%* * +%******************************************************** + +\begin{code} +cgExpr (StgTick m n expr) = do cgTickBox m n; cgExpr expr +\end{code} + +%******************************************************** %* * %* Non-top-level bindings * %* *