Skip to content

GHC
GHC
Commit 9ff76535 authored by Simon Marlow's avatar Simon Marlow
Browse files
Options

Remove vectored returns. 

We recently discovered that they aren't a win any more, and just cost
code size.
parent 6a7778b9
Hide whitespace changes
Inline Side-by-side
Showing with 156 additions and 704 deletions
compiler/cmm/CLabel.hs
View file @ 9ff76535
......@@ -48,7 +48,6 @@ module CLabel (
mkSplitMarkerLabel,
mkDirty_MUT_VAR_Label,
mkUpdInfoLabel,
mkSeqInfoLabel,
mkIndStaticInfoLabel,
mkMainCapabilityLabel,
mkMAP_FROZEN_infoLabel,
......@@ -358,7 +357,6 @@ mkPlainModuleInitLabel this_pkg mod
mkSplitMarkerLabel = RtsLabel (RtsCode SLIT("__stg_split_marker"))
mkDirty_MUT_VAR_Label = RtsLabel (RtsCode SLIT("dirty_MUT_VAR"))
mkUpdInfoLabel = RtsLabel (RtsInfo SLIT("stg_upd_frame"))
mkSeqInfoLabel = RtsLabel (RtsInfo SLIT("stg_seq_frame"))
mkIndStaticInfoLabel = RtsLabel (RtsInfo SLIT("stg_IND_STATIC"))
mkMainCapabilityLabel = RtsLabel (RtsData SLIT("MainCapability"))
mkMAP_FROZEN_infoLabel = RtsLabel (RtsInfo SLIT("stg_MUT_ARR_PTRS_FROZEN0"))
......
compiler/cmm/CmmParse.y
View file @ 9ff76535
......@@ -230,12 +230,8 @@ info :: { ExtFCode (CLabel, [CmmLit],[CmmLit]) }
-- selector, closure type, description, type
{ basicInfo $3 (mkIntCLit (fromIntegral $5)) 0 $7 $9 $11 }
| 'INFO_TABLE_RET' '(' NAME ',' INT ',' INT ',' INT maybe_vec ')'
{ retInfo $3 $5 $7 $9 $10 }
maybe_vec :: { [CmmLit] }
: {- empty -} { [] }
| ',' NAME maybe_vec { CmmLabel (mkRtsCodeLabelFS $2) : $3 }
| 'INFO_TABLE_RET' '(' NAME ',' INT ',' INT ',' INT ')'
{ retInfo $3 $5 $7 $9 }
body :: { ExtCode }
: {- empty -} { return () }
......@@ -473,8 +469,7 @@ exprMacros = listToUFM [
( FSLIT("GET_FUN_INFO"), \ [x] -> funInfoTable (closureInfoPtr x) ),
( FSLIT("INFO_TYPE"), \ [x] -> infoTableClosureType x ),
( FSLIT("INFO_PTRS"), \ [x] -> infoTablePtrs x ),
( FSLIT("INFO_NPTRS"), \ [x] -> infoTableNonPtrs x ),
( FSLIT("RET_VEC"), \ [info, conZ] -> retVec info conZ )
( FSLIT("INFO_NPTRS"), \ [x] -> infoTableNonPtrs x )
]
-- we understand a subset of C-- primitives:
......@@ -709,11 +704,11 @@ forkLabelledCodeEC ec = do
stmts <- getCgStmtsEC ec
code (forkCgStmts stmts)
retInfo name size live_bits cl_type vector = do
retInfo name size live_bits cl_type = do
let liveness = smallLiveness (fromIntegral size) (fromIntegral live_bits)
info_lbl = mkRtsRetInfoLabelFS name
(info1,info2) = mkRetInfoTable info_lbl liveness NoC_SRT
(fromIntegral cl_type) vector
(fromIntegral cl_type)
return (info_lbl, info1, info2)
stdInfo name ptrs nptrs srt_bitmap cl_type desc_str ty_str =
......
compiler/codeGen/CgCallConv.hs
View file @ 9ff76535
......@@ -25,8 +25,6 @@ module CgCallConv (
constructSlowCall, slowArgs, slowCallPattern,
-- Returns
CtrlReturnConvention(..),
ctrlReturnConvAlg,
dataReturnConvPrim,
getSequelAmode
) where
......@@ -48,7 +46,6 @@ import CmmUtils
import Maybes
import Id
import Name
import TyCon
import Bitmap
import Util
import StaticFlags
......@@ -215,10 +212,6 @@ constructSlowCall amodes
stg_ap_pat = mkRtsApFastLabel arg_pat
(arg_pat, these, rest) = matchSlowPattern amodes
enterRtsRetLabel arg_pat
| tablesNextToCode = mkRtsRetInfoLabel arg_pat
| otherwise = mkRtsRetLabel arg_pat
-- | 'slowArgs' takes a list of function arguments and prepares them for
-- pushing on the stack for "extra" arguments to a function which requires
-- fewer arguments than we currently have.
......@@ -257,26 +250,6 @@ slowCallPattern _ = panic "CgStackery.slowCallPattern"
--
-------------------------------------------------------------------------
-- A @CtrlReturnConvention@ says how {\em control} is returned.
data CtrlReturnConvention
= VectoredReturn Int -- size of the vector table (family size)
| UnvectoredReturn Int -- family size
ctrlReturnConvAlg :: TyCon -> CtrlReturnConvention
ctrlReturnConvAlg tycon
= case (tyConFamilySize tycon) of
size -> -- we're supposed to know...
if (size > (1::Int) && size <= mAX_FAMILY_SIZE_FOR_VEC_RETURNS) then
VectoredReturn size
else
UnvectoredReturn size
-- NB: unvectored returns Include size 0 (no constructors), so that
-- the following perverse code compiles (it crashed GHC in 5.02)
-- data T1
-- data T2 = T2 !T1 Int
-- The only value of type T1 is bottom, which never returns anyway.
dataReturnConvPrim :: CgRep -> CmmReg
dataReturnConvPrim PtrArg = CmmGlobal (VanillaReg 1)
dataReturnConvPrim NonPtrArg = CmmGlobal (VanillaReg 1)
......@@ -287,7 +260,7 @@ dataReturnConvPrim VoidArg = panic "dataReturnConvPrim: void"
-- getSequelAmode returns an amode which refers to an info table. The info
-- table will always be of the RET(_VEC)?_(BIG|SMALL) kind. We're careful
-- table will always be of the RET_(BIG|SMALL) kind. We're careful
-- not to handle real code pointers, just in case we're compiling for
-- an unregisterised/untailcallish architecture, where info pointers and
-- code pointers aren't the same.
......@@ -304,9 +277,8 @@ getSequelAmode
OnStack -> do { sp_rel <- getSpRelOffset virt_sp
; returnFC (CmmLoad sp_rel wordRep) }
UpdateCode -> returnFC (CmmLit (CmmLabel mkUpdInfoLabel))
CaseAlts lbl _ _ True -> returnFC (CmmLit (CmmLabel mkSeqInfoLabel))
CaseAlts lbl _ _ False -> returnFC (CmmLit (CmmLabel lbl))
UpdateCode -> returnFC (CmmLit (CmmLabel mkUpdInfoLabel))
CaseAlts lbl _ _ -> returnFC (CmmLit (CmmLabel lbl))
}
-------------------------------------------------------------------------
......
compiler/codeGen/CgCase.lhs
View file @ 9ff76535
......@@ -197,7 +197,7 @@ cgCase (StgApp fun args)
(do { deAllocStackTop retAddrSizeW
; cgEvalAlts maybe_cc_slot bndr srt alt_type alts })
; setEndOfBlockInfo (maybeReserveSeqFrame alt_type scrut_eob_info)
; setEndOfBlockInfo scrut_eob_info
(performTailCall fun_info arg_amodes save_assts) }
\end{code}
......@@ -234,8 +234,7 @@ cgCase expr live_in_whole_case live_in_alts bndr srt alt_type alts
(do { deAllocStackTop retAddrSizeW
; cgEvalAlts maybe_cc_slot bndr srt alt_type alts })
; setEndOfBlockInfo (maybeReserveSeqFrame alt_type scrut_eob_info)
(cgExpr expr)
; setEndOfBlockInfo scrut_eob_info (cgExpr expr)
}
\end{code}
......@@ -265,13 +264,6 @@ consequence of this is that activation records on the stack don't
follow the layout of closures when we're profiling. The CCS could be
anywhere within the record).
\begin{code}
maybeReserveSeqFrame PolyAlt (EndOfBlockInfo args_sp (CaseAlts amode stuff bndr _))
= EndOfBlockInfo (args_sp + retAddrSizeW) (CaseAlts amode stuff bndr True)
maybeReserveSeqFrame other scrut_eob_info = scrut_eob_info
\end{code}
%************************************************************************
%* *
Inline primops
......@@ -380,8 +372,8 @@ cgEvalAlts cc_slot bndr srt alt_type@(PrimAlt tycon) alts
; restoreCurrentCostCentre cc_slot True
; cgPrimAlts GCMayHappen alt_type reg alts }
; lbl <- emitDirectReturnTarget (idName bndr) abs_c srt
; returnFC (CaseAlts lbl Nothing bndr False) }
; lbl <- emitReturnTarget (idName bndr) abs_c srt
; returnFC (CaseAlts lbl Nothing bndr) }
cgEvalAlts cc_slot bndr srt (UbxTupAlt _) [(con,args,_,rhs)]
= -- Unboxed tuple case
......@@ -392,7 +384,7 @@ cgEvalAlts cc_slot bndr srt (UbxTupAlt _) [(con,args,_,rhs)]
ASSERT2( case con of { DataAlt _ -> True; other -> False },
text "cgEvalAlts: dodgy case of unboxed tuple type" )
do { -- forkAbsC for the RHS, so that the envt is
-- not changed for the emitDirectReturn call
-- not changed for the emitReturn call
abs_c <- forkProc $ do
{ (live_regs, ptrs, nptrs, _) <- bindUnboxedTupleComponents args
-- Restore the CC *after* binding the tuple components,
......@@ -402,8 +394,8 @@ cgEvalAlts cc_slot bndr srt (UbxTupAlt _) [(con,args,_,rhs)]
-- and finally the code for the alternative
; unbxTupleHeapCheck live_regs ptrs nptrs noStmts
(cgExpr rhs) }
; lbl <- emitDirectReturnTarget (idName bndr) abs_c srt
; returnFC (CaseAlts lbl Nothing bndr False) }
; lbl <- emitReturnTarget (idName bndr) abs_c srt
; returnFC (CaseAlts lbl Nothing bndr) }
cgEvalAlts cc_slot bndr srt alt_type alts
= -- Algebraic and polymorphic case
......@@ -422,13 +414,13 @@ cgEvalAlts cc_slot bndr srt alt_type alts
; (alts, mb_deflt) <- cgAlgAlts GCMayHappen cc_slot alt_type alts
; (lbl, branches) <- emitAlgReturnTarget (idName bndr)
alts mb_deflt srt ret_conv
alts mb_deflt srt fam_sz
; returnFC (CaseAlts lbl branches bndr False) }
; returnFC (CaseAlts lbl branches bndr) }
where
ret_conv = case alt_type of
AlgAlt tc -> ctrlReturnConvAlg tc
PolyAlt -> UnvectoredReturn 0
fam_sz = case alt_type of
AlgAlt tc -> tyConFamilySize tc
PolyAlt -> 0
\end{code}
......
compiler/codeGen/CgCon.lhs
View file @ 9ff76535
......@@ -295,7 +295,7 @@ cgReturnDataCon con amodes
= ASSERT( amodes `lengthIs` dataConRepArity con )
do { EndOfBlockInfo _ sequel <- getEndOfBlockInfo
; case sequel of
CaseAlts _ (Just (alts, deflt_lbl)) bndr _
CaseAlts _ (Just (alts, deflt_lbl)) bndr
-> -- Ho! We know the constructor so we can
-- go straight to the right alternative
case assocMaybe alts (dataConTagZ con) of {
......@@ -317,7 +317,7 @@ cgReturnDataCon con amodes
other_sequel -- The usual case
| isUnboxedTupleCon con -> returnUnboxedTuple amodes
| otherwise -> build_it_then (emitKnownConReturnCode con)
| otherwise -> build_it_then emitReturnInstr
}
where
jump_to lbl = stmtC (CmmJump (CmmLit lbl) [])
......@@ -434,7 +434,7 @@ cgDataCon data_con
body_code = do {
-- NB: We don't set CC when entering data (WDP 94/06)
tickyReturnOldCon (length arg_things)
; performReturn (emitKnownConReturnCode data_con) }
; performReturn emitReturnInstr }
-- noStmts: Ptr to thing already in Node
; whenC (not (isNullaryRepDataCon data_con))
......@@ -442,6 +442,4 @@ cgDataCon data_con
-- Dynamic-Closure first, to reduce forward references
; emit_info static_cl_info tickyEnterStaticCon }
where
\end{code}
compiler/codeGen/CgExpr.lhs
View file @ 9ff76535
......@@ -141,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
......@@ -157,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
......@@ -175,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}
......
compiler/codeGen/CgInfoTbls.hs
View file @ 9ff76535
......@@ -11,8 +11,8 @@ module CgInfoTbls (
emitInfoTableAndCode,
dataConTagZ,
getSRTInfo,
emitDirectReturnTarget, emitAlgReturnTarget,
emitDirectReturnInstr, emitVectoredReturnInstr,
emitReturnTarget, emitAlgReturnTarget,
emitReturnInstr,
mkRetInfoTable,
mkStdInfoTable,
stdInfoTableSizeB,
......@@ -21,8 +21,7 @@ module CgInfoTbls (
getConstrTag,
infoTable, infoTableClosureType,
infoTablePtrs, infoTableNonPtrs,
funInfoTable,
retVec
funInfoTable
) where
......@@ -43,10 +42,8 @@ import StgSyn
import Name
import DataCon
import Unique
import DynFlags
import StaticFlags
import ListSetOps
import Maybes
import Constants
......@@ -173,7 +170,6 @@ mkFunGenInfoExtraBits fun_type arity srt_label liveness slow_entry
--
-- Tables next to code:
--
-- <reversed vector table>
-- <srt slot>
-- <standard info table>
-- ret-addr --> <entry code (if any)>
......@@ -183,69 +179,25 @@ mkFunGenInfoExtraBits fun_type arity srt_label liveness slow_entry
-- ret-addr --> <ptr to entry code>
-- <standard info table>
-- <srt slot>
-- <forward vector table>
--
-- * The vector table is only present for vectored returns
--
-- * The SRT slot is only there if either
-- (a) there is SRT info to record, OR
-- (b) if the return is vectored
-- The latter (b) is necessary so that the vector is in a
-- predictable place
vectorSlot :: CmmExpr -> CmmExpr -> CmmExpr
-- Get the vector slot from the info pointer
vectorSlot info_amode zero_indexed_tag
| tablesNextToCode
= cmmOffsetExprW (cmmOffsetW info_amode (- (stdInfoTableSizeW + 2)))
(cmmNegate zero_indexed_tag)
-- The "2" is one for the SRT slot, and one more
-- to get to the first word of the vector
| otherwise
= cmmOffsetExprW (cmmOffsetW info_amode (stdInfoTableSizeW + 2))
zero_indexed_tag
-- The "2" is one for the entry-code slot and one for the SRT slot
retVec :: CmmExpr -> CmmExpr -> CmmExpr
-- Get a return vector from the info pointer
retVec info_amode zero_indexed_tag
= let slot = vectorSlot info_amode zero_indexed_tag
table_slot = CmmLoad slot wordRep
#if defined(x86_64_TARGET_ARCH)
offset_slot = CmmMachOp (MO_S_Conv I32 I64) [CmmLoad slot I32]
-- offsets are 32-bits on x86-64, due to the inability of
-- the tools to handle 64-bit PC-relative relocations. See also
-- PprMach.pprDataItem, and InfoTables.h:OFFSET_FIELD().
#else
offset_slot = table_slot
#endif
in if tablesNextToCode
then CmmMachOp (MO_Add wordRep) [offset_slot, info_amode]
else table_slot
-- * The SRT slot is only there is SRT info to record
emitReturnTarget
:: Name
-> CgStmts -- The direct-return code (if any)
-- (empty for vectored returns)
-> [CmmLit] -- Vector of return points
-- (empty for non-vectored returns)
-> SRT
-> FCode CLabel
emitReturnTarget name stmts vector srt
emitReturnTarget name stmts srt
= do { live_slots <- getLiveStackSlots
; liveness <- buildContLiveness name live_slots
; srt_info <- getSRTInfo name srt
; let
cl_type = case (null vector, isBigLiveness liveness) of
(True, True) -> rET_BIG
(True, False) -> rET_SMALL
(False, True) -> rET_VEC_BIG
(False, False) -> rET_VEC_SMALL
cl_type | isBigLiveness liveness = rET_BIG
| otherwise = rET_SMALL
(std_info, extra_bits) =
mkRetInfoTable info_lbl liveness srt_info cl_type vector
mkRetInfoTable info_lbl liveness srt_info cl_type
; blks <- cgStmtsToBlocks stmts
; emitInfoTableAndCode info_lbl std_info extra_bits args blks
......@@ -261,112 +213,43 @@ mkRetInfoTable
-> Liveness -- liveness
-> C_SRT -- SRT Info
-> Int -- type (eg. rET_SMALL)
-> [CmmLit] -- vector
-> ([CmmLit],[CmmLit])
mkRetInfoTable info_lbl liveness srt_info cl_type vector
= (std_info, extra_bits)
mkRetInfoTable info_lbl liveness srt_info cl_type
= (std_info, srt_slot)
where
(srt_label, srt_len) = srtLabelAndLength srt_info info_lbl
srt_slot | need_srt = [srt_label]
| otherwise = []
need_srt = needsSRT srt_info || not (null vector)
-- If there's a vector table then we must allocate
-- an SRT slot, so that the vector table is at a
-- known offset from the info pointer
srt_slot | needsSRT srt_info = [srt_label]
| otherwise = []
liveness_lit = makeRelativeRefTo info_lbl $ mkLivenessCLit liveness
std_info = mkStdInfoTable zeroCLit zeroCLit cl_type srt_len liveness_lit
extra_bits = srt_slot ++ map (makeRelativeRefTo info_lbl) vector
emitDirectReturnTarget
:: Name
-> CgStmts -- The direct-return code
-> SRT
-> FCode CLabel
emitDirectReturnTarget name code srt
= emitReturnTarget name code [] srt
emitAlgReturnTarget
:: Name -- Just for its unique
-> [(ConTagZ, CgStmts)] -- Tagged branches
-> Maybe CgStmts -- Default branch (if any)
-> SRT -- Continuation's SRT
-> CtrlReturnConvention
-> Int -- family size
-> FCode (CLabel, SemiTaggingStuff)
emitAlgReturnTarget name branches mb_deflt srt ret_conv
= case ret_conv of
UnvectoredReturn fam_sz -> do
{ blks <- getCgStmts $
emitAlgReturnTarget name branches mb_deflt srt fam_sz
= do { blks <- getCgStmts $
emitSwitch tag_expr branches mb_deflt 0 (fam_sz - 1)
-- NB: tag_expr is zero-based
; lbl <- emitDirectReturnTarget name blks srt
; lbl <- emitReturnTarget name blks srt
; return (lbl, Nothing) }
-- Nothing: the internal branches in the switch don't have
-- global labels, so we can't use them at the 'call site'
VectoredReturn fam_sz -> do
{ let tagged_lbls = zip (map fst branches) $
map (CmmLabel . mkAltLabel uniq . fst) branches
deflt_lbl | isJust mb_deflt = CmmLabel $ mkDefaultLabel uniq
| otherwise = mkIntCLit 0
; let vector = [ assocDefault deflt_lbl tagged_lbls i
| i <- [0..fam_sz-1]]
; lbl <- emitReturnTarget name noCgStmts vector srt
; mapFCs emit_alt branches
; emit_deflt mb_deflt
; return (lbl, Just (tagged_lbls, deflt_lbl)) }
where
uniq = getUnique name
tag_expr = getConstrTag (CmmReg nodeReg)
emit_alt :: (Int, CgStmts) -> FCode (Int, CmmLit)
-- Emit the code for the alternative as a top-level
-- code block returning a label for it
emit_alt (tag, stmts) = do { let lbl = mkAltLabel uniq tag
; blks <- cgStmtsToBlocks stmts
; emitProc [] lbl [] blks
; return (tag, CmmLabel lbl) }
emit_deflt (Just stmts) = do { let lbl = mkDefaultLabel uniq
; blks <- cgStmtsToBlocks stmts
; emitProc [] lbl [] blks
; return (CmmLabel lbl) }
emit_deflt Nothing = return (mkIntCLit 0)
-- Nothing case: the simplifier might have eliminated a case
-- so we may have e.g. case xs of
-- [] -> e
-- In that situation the default should never be taken,
-- so we just use a NULL pointer
--------------------------------
emitDirectReturnInstr :: Code
emitDirectReturnInstr
emitReturnInstr :: Code
emitReturnInstr
= do { info_amode <- getSequelAmode
; stmtC (CmmJump (entryCode info_amode) []) }
emitVectoredReturnInstr :: CmmExpr -- _Zero-indexed_ constructor tag
-> Code
emitVectoredReturnInstr zero_indexed_tag
= do { info_amode <- getSequelAmode
-- HACK! assign info_amode to a temp, because retVec
-- uses it twice and the NCG doesn't have any CSE yet.
-- Only do this for the NCG, because gcc is too stupid
-- to optimise away the extra tmp (grrr).
; dflags <- getDynFlags
; x <- if hscTarget dflags == HscAsm
then do z <- newTemp wordRep
stmtC (CmmAssign z info_amode)
return (CmmReg z)
else
return info_amode
; let target = retVec x zero_indexed_tag
; stmtC (CmmJump target []) }
-------------------------------------------------------------------------
--
-- Generating a standard info table
......
compiler/codeGen/CgLetNoEscape.lhs
View file @ 9ff76535
......@@ -29,7 +29,6 @@ import CmmUtils
import CLabel
import ClosureInfo
import CostCentre
import Id
import Var
import SMRep
import BasicTypes
......@@ -169,7 +168,7 @@ cgLetNoEscapeClosure
-- Ignore the label that comes back from
-- mkRetDirectTarget. It must be conjured up elswhere
; emitDirectReturnTarget (idName bndr) abs_c srt
; emitReturnTarget (idName bndr) abs_c srt
; return () })
; returnFC (bndr, letNoEscapeIdInfo bndr vSp lf_info) }
......
compiler/codeGen/CgMonad.lhs
View file @ 9ff76535
......@@ -170,7 +170,6 @@ data Sequel
-- case this might be the label of a return vector
SemiTaggingStuff
Id -- The case binder, only used to see if it's dead
Bool -- True <=> polymorphic, push a SEQ frame too
type SemiTaggingStuff
= Maybe -- Maybe[1] we don't have any semi-tagging stuff...
......
compiler/codeGen/CgTailCall.lhs
View file @ 9ff76535
......@@ -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
-- -----------------------------------------------------------------------------
......
compiler/codeGen/SMRep.lhs
View file @ 9ff76535
......@@ -33,7 +33,7 @@ module SMRep (
profHdrSize, thunkHdrSize,
smRepClosureType, smRepClosureTypeInt,
rET_SMALL, rET_VEC_SMALL, rET_BIG, rET_VEC_BIG
rET_SMALL, rET_BIG
) where
#include "HsVersions.h"
......@@ -345,8 +345,6 @@ smRepClosureTypeInt rep = panic "smRepClosuretypeint"
-- We export these ones
rET_SMALL = (RET_SMALL :: Int)
rET_VEC_SMALL = (RET_VEC_SMALL :: Int)
rET_BIG = (RET_BIG :: Int)
rET_VEC_BIG = (RET_VEC_BIG :: Int)
\end{code}
compiler/main/Constants.lhs
View file @ 9ff76535
......@@ -55,11 +55,6 @@ mAX_CHARLIKE = MAX_CHARLIKE
A section of code-generator-related MAGIC CONSTANTS.
\begin{code}
mAX_FAMILY_SIZE_FOR_VEC_RETURNS = (MAX_VECTORED_RTN::Int) -- pretty arbitrary
-- If you change this, you may need to change runtimes/standard/Update.lhc
\end{code}
\begin{code}
mAX_Vanilla_REG = (MAX_VANILLA_REG :: Int)
mAX_Float_REG = (MAX_FLOAT_REG :: Int)
......
compiler/typecheck/TcGenDeriv.lhs
View file @ 9ff76535
......@@ -47,7 +47,6 @@ import TcType
import TysPrim
import TysWiredIn
import Util
import Constants
import Outputable
import FastString
import OccName
......@@ -1212,7 +1211,9 @@ gen_tag_n_con_monobind (rdr_name, tycon, GenCon2Tag)
`nlHsFunTy`
nlHsTyVar (getRdrName intPrimTyCon)
lots_of_constructors = tyConFamilySize tycon > mAX_FAMILY_SIZE_FOR_VEC_RETURNS
lots_of_constructors = tyConFamilySize tycon > 8
-- was: mAX_FAMILY_SIZE_FOR_VEC_RETURNS
-- but we don't do vectored returns any more.
mk_stuff :: DataCon -> ([LPat RdrName], LHsExpr RdrName)
mk_stuff con = ([nlWildConPat con],
......
includes/ClosureTypes.h
View file @ 9ff76535
......@@ -56,44 +56,42 @@
#define IND_STATIC 32
#define RET_BCO 33
#define RET_SMALL 34
#define RET_VEC_SMALL 35
#define RET_BIG 36
#define RET_VEC_BIG 37
#define RET_DYN 38
#define RET_FUN 39
#define UPDATE_FRAME 40
#define CATCH_FRAME 41
#define STOP_FRAME 42
#define CAF_BLACKHOLE 43
#define BLACKHOLE 44
#define SE_BLACKHOLE 45
#define SE_CAF_BLACKHOLE 46
#define MVAR 47
#define ARR_WORDS 48
#define MUT_ARR_PTRS_CLEAN 49
#define MUT_ARR_PTRS_DIRTY 50
#define MUT_ARR_PTRS_FROZEN0 51
#define MUT_ARR_PTRS_FROZEN 52
#define MUT_VAR_CLEAN 53
#define MUT_VAR_DIRTY 54
#define WEAK 55
#define STABLE_NAME 56
#define TSO 57
#define BLOCKED_FETCH 58
#define FETCH_ME 59
#define FETCH_ME_BQ 60