summaryrefslogtreecommitdiff
path: root/compiler/codeGen/CgTailCall.lhs
diff options
context:
space:
mode:
authorSimon Marlow <simonmar@microsoft.com>2007-02-28 13:07:14 +0000
committerSimon Marlow <simonmar@microsoft.com>2007-02-28 13:07:14 +0000
commit9ff76535edb25ab7434284adddb5c64708ecb547 (patch)
tree3f2fb3ec0b66cd1c85d73a56e92e36b57de1b362 /compiler/codeGen/CgTailCall.lhs
parent6a7778b95a726f460288123d0539310bb66302f4 (diff)
downloadhaskell-9ff76535edb25ab7434284adddb5c64708ecb547.tar.gz
Remove vectored returns.
We recently discovered that they aren't a win any more, and just cost code size.
Diffstat (limited to 'compiler/codeGen/CgTailCall.lhs')
-rw-r--r--compiler/codeGen/CgTailCall.lhs52
1 files changed, 8 insertions, 44 deletions
diff --git a/compiler/codeGen/CgTailCall.lhs b/compiler/codeGen/CgTailCall.lhs
index c65ec1c4b5..22cecb7249 100644
--- a/compiler/codeGen/CgTailCall.lhs
+++ b/compiler/codeGen/CgTailCall.lhs
@@ -8,7 +8,6 @@
module CgTailCall (
cgTailCall, performTailCall,
performReturn, performPrimReturn,
- emitKnownConReturnCode, emitAlgReturnCode,
returnUnboxedTuple, ccallReturnUnboxedTuple,
pushUnboxedTuple,
tailCallPrimOp,
@@ -33,9 +32,7 @@ import CmmUtils
import CLabel
import Type
import Id
-import DataCon
import StgSyn
-import TyCon
import PrimOp
import Outputable
@@ -124,14 +121,14 @@ performTailCall fun_info arg_amodes pending_assts
-- As with any return, Node must point to it.
ReturnIt -> do
{ emitSimultaneously (node_asst `plusStmts` pending_assts)
- ; doFinalJump sp False emitDirectReturnInstr }
+ ; doFinalJump sp False emitReturnInstr }
-- 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
{ emitSimultaneously (node_asst `plusStmts` pending_assts)
- ; doFinalJump sp False (emitKnownConReturnCode con) }
+ ; doFinalJump sp False emitReturnInstr }
JumpToIt lbl -> do
{ emitSimultaneously (opt_node_asst `plusStmts` pending_assts)
@@ -218,17 +215,17 @@ doFinalJump final_sp is_let_no_escape jump_code
-- and do the jump
; jump_code }
--- -----------------------------------------------------------------------------
+-- ----------------------------------------------------------------------------
-- A general return (just a special case of doFinalJump, above)
-performReturn :: Code -- The code to execute to actually do the return
+performReturn :: Code -- The code to execute to actually do the return
-> Code
performReturn finish_code
= do { EndOfBlockInfo args_sp sequel <- getEndOfBlockInfo
; doFinalJump args_sp False{-not a LNE-} finish_code }
--- -----------------------------------------------------------------------------
+-- ----------------------------------------------------------------------------
-- Primitive Returns
-- Just load the return value into the right register, and return.
@@ -237,34 +234,10 @@ performPrimReturn :: CgRep -> CmmExpr -- The thing to return
performPrimReturn rep amode
= do { whenC (not (isVoidArg rep))
(stmtC (CmmAssign ret_reg amode))
- ; performReturn emitDirectReturnInstr }
+ ; performReturn emitReturnInstr }
where
ret_reg = dataReturnConvPrim rep
--- -----------------------------------------------------------------------------
--- Algebraic constructor returns
-
--- Constructor is built on the heap; Node is set.
--- All that remains is to do the right sort of jump.
-
-emitKnownConReturnCode :: DataCon -> Code
-emitKnownConReturnCode con
- = emitAlgReturnCode (dataConTyCon con)
- (CmmLit (mkIntCLit (dataConTagZ con)))
- -- emitAlgReturnCode requires zero-indexed tag
-
-emitAlgReturnCode :: TyCon -> CmmExpr -> Code
--- emitAlgReturnCode is used both by emitKnownConReturnCode,
--- and by by PrimOps that return enumerated types (i.e.
--- all the comparison operators).
-emitAlgReturnCode tycon tag
- = do { case ctrlReturnConvAlg tycon of
- VectoredReturn fam_sz -> do { tickyVectoredReturn fam_sz
- ; emitVectoredReturnInstr tag }
- UnvectoredReturn _ -> emitDirectReturnInstr
- }
-
-
-- ---------------------------------------------------------------------------
-- Unboxed tuple returns
@@ -285,7 +258,7 @@ returnUnboxedTuple amodes
; tickyUnboxedTupleReturn (length amodes)
; (final_sp, assts) <- pushUnboxedTuple args_sp amodes
; emitSimultaneously assts
- ; doFinalJump final_sp False{-not a LNE-} emitDirectReturnInstr }
+ ; doFinalJump final_sp False{-not a LNE-} emitReturnInstr }
pushUnboxedTuple :: VirtualSpOffset -- Sp at which to start pushing
-> [(CgRep, CmmExpr)] -- amodes of the components
@@ -375,19 +348,10 @@ tailCallPrimOp op args
pushReturnAddress :: EndOfBlockInfo -> Code
-pushReturnAddress (EndOfBlockInfo args_sp sequel@(CaseAlts lbl _ _ False))
+pushReturnAddress (EndOfBlockInfo args_sp sequel@(CaseAlts lbl _ _))
= do { sp_rel <- getSpRelOffset args_sp
; stmtC (CmmStore sp_rel (mkLblExpr lbl)) }
--- For a polymorphic case, we have two return addresses to push: the case
--- return, and stg_seq_frame_info which turns a possible vectored return
--- into a direct one.
-pushReturnAddress (EndOfBlockInfo args_sp sequel@(CaseAlts lbl _ _ True))
- = do { sp_rel <- getSpRelOffset (args_sp-1)
- ; stmtC (CmmStore sp_rel (mkLblExpr lbl))
- ; sp_rel <- getSpRelOffset args_sp
- ; stmtC (CmmStore sp_rel (CmmLit (CmmLabel mkSeqInfoLabel))) }
-
pushReturnAddress _ = nopC
-- -----------------------------------------------------------------------------