X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=compiler%2FcodeGen%2FCgTailCall.lhs;h=89c050406f746f34fc105aca66d894fc3ac3fc67;hp=e4f79a7aa6bde56706eb66fe7ea5d47d12abfd7e;hb=cbbee4e8727c583daf32d9bf17f00afaa839ef10;hpb=fd12b167cd246087858d50ab66840274ef609f79

diff --git a/compiler/codeGen/CgTailCall.lhs b/compiler/codeGen/CgTailCall.lhs
index e4f79a7..89c0504 100644
--- a/compiler/codeGen/CgTailCall.lhs
+++ b/compiler/codeGen/CgTailCall.lhs
@@ -11,6 +11,7 @@ module CgTailCall (
 	returnUnboxedTuple, ccallReturnUnboxedTuple,
 	pushUnboxedTuple,
 	tailCallPrimOp,
+        tailCallPrimCall,
 
 	pushReturnAddress
     ) where
@@ -35,6 +36,7 @@ import Id
 import StgSyn
 import PrimOp
 import Outputable
+import StaticFlags
 
 import Control.Monad
 
@@ -183,7 +185,10 @@ performTailCall fun_info arg_amodes pending_assts
     untag_node = CmmAssign nodeReg (cmmUntag (CmmReg nodeReg))
     -- Test if closure is a constructor
     maybeSwitchOnCons enterClosure eob
-              | EndOfBlockInfo _ (CaseAlts lbl _ _) <- eob
+              | EndOfBlockInfo _ (CaseAlts lbl _ _) <- eob,
+                not opt_SccProfilingOn
+                -- we can't shortcut when profiling is on, because we have
+                -- to enter a closure to mark it as "used" for LDV profiling
               = do { is_constr <- newLabelC
                    -- Is the pointer tagged?
                    -- Yes, jump to switch statement
@@ -378,13 +383,21 @@ ccallReturnUnboxedTuple amodes before_jump
 -- Calling an out-of-line primop
 
 tailCallPrimOp :: PrimOp -> [StgArg] -> Code
-tailCallPrimOp op args
+tailCallPrimOp op
+ = tailCallPrim (mkRtsPrimOpLabel op)
+
+tailCallPrimCall :: PrimCall -> [StgArg] -> Code
+tailCallPrimCall primcall
+ = tailCallPrim (mkPrimCallLabel primcall)
+
+tailCallPrim :: CLabel -> [StgArg] -> Code
+tailCallPrim lbl args
  = do	{	-- We're going to perform a normal-looking tail call, 
 		-- except that *all* the arguments will be in registers.
 		-- Hence the ASSERT( null leftovers )
 	  arg_amodes <- getArgAmodes args
 	; let (arg_regs, leftovers) = assignPrimOpCallRegs arg_amodes
-	      jump_to_primop = jumpToLbl (mkRtsPrimOpLabel op)
+	      jump_to_primop = jumpToLbl lbl
 
 	; ASSERT(null leftovers) -- no stack-resident args
  	  emitSimultaneously (assignToRegs arg_regs)