% Code generation for tail calls.
\begin{code}
-{-# OPTIONS -w #-}
--- The above warning supression flag is a temporary kludge.
--- While working on this module you are encouraged to remove it and fix
--- any warnings in the module. See
--- http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#Warnings
--- for details
-
module CgTailCall (
cgTailCall, performTailCall,
performReturn, performPrimReturn,
import StgSyn
import PrimOp
import Outputable
+import StaticFlags
import Control.Monad
opt_node_asst | nodeMustPointToIt lf_info = node_asst
| otherwise = noStmts
; EndOfBlockInfo sp _ <- getEndOfBlockInfo
- ; this_pkg <- getThisPackage
- ; case (getCallMethod fun_name lf_info (length arg_amodes)) of
+ ; dflags <- getDynFlags
+ ; case (getCallMethod dflags fun_name fun_has_cafs lf_info (length arg_amodes)) of
-- Node must always point to things we enter
EnterIt -> do
-- A real constructor. Don't bother entering it,
-- just do the right sort of return instead.
-- As with any return, Node must point to it.
- ReturnCon con -> do
+ ReturnCon _ -> do
{ emitSimultaneously (node_asst `plusStmts` pending_assts)
; doFinalJump sp False emitReturnInstr }
}
}
where
- fun_name = idName (cgIdInfoId fun_info)
+ fun_id = cgIdInfoId fun_info
+ fun_name = idName fun_id
lf_info = cgIdInfoLF fun_info
+ fun_has_cafs = idCafInfo fun_id
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
-- CONSTR_NOCAF_STATIC (from ClosureType.h)
-}
-
+directCall :: VirtualSpOffset -> CLabel -> [(CgRep, CmmExpr)]
+ -> [(CgRep, CmmExpr)] -> CmmStmts
+ -> Code
directCall sp lbl args extra_args assts = do
let
-- First chunk of args go in registers
-> Code
performReturn finish_code
- = do { EndOfBlockInfo args_sp sequel <- getEndOfBlockInfo
+ = do { EndOfBlockInfo args_sp _sequel <- getEndOfBlockInfo
; doFinalJump args_sp False{-not a LNE-} finish_code }
-- ----------------------------------------------------------------------------
returnUnboxedTuple :: [(CgRep, CmmExpr)] -> Code
returnUnboxedTuple amodes
- = do { eob@(EndOfBlockInfo args_sp sequel) <- getEndOfBlockInfo
+ = do { (EndOfBlockInfo args_sp _sequel) <- getEndOfBlockInfo
; tickyUnboxedTupleReturn (length amodes)
; (final_sp, assts) <- pushUnboxedTuple args_sp amodes
; emitSimultaneously assts
pushReturnAddress :: EndOfBlockInfo -> Code
-pushReturnAddress (EndOfBlockInfo args_sp sequel@(CaseAlts lbl _ _))
+pushReturnAddress (EndOfBlockInfo args_sp (CaseAlts lbl _ _))
= do { sp_rel <- getSpRelOffset args_sp
; stmtC (CmmStore sp_rel (mkLblExpr lbl)) }