Skip to content
GitLab
Projects
Groups
Snippets
/
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Sign in / Register
Toggle navigation
Menu
Open sidebar
Glasgow Haskell Compiler
GHC
Commits
9ff76535
Commit
9ff76535
authored
Feb 28, 2007
by
Simon Marlow
Browse files
Remove vectored returns.
We recently discovered that they aren't a win any more, and just cost code size.
parent
6a7778b9
Changes
35
Hide whitespace changes
Inline
Side-by-side
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 <- emit
Direct
ReturnTarget (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 emit
Direct
Return 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 <- emit
Direct
ReturnTarget (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
(
emit
KnownConReturnCode con)
| otherwise -> build_it_then emit
ReturnInstr
}
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
(
emit
KnownConReturnCode data_con)
}
; performReturn emit
ReturnInstr
}
-- 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
(
emit
Alg
Return
Code tycon amode')
}
; performReturn emitReturn
Instr
}
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 emit
Direct
ReturnInstr
performReturn emitReturnInstr
| ReturnsPrim rep <- result_info
= do cgPrimOp [dataReturnConvPrim (primRepToCgRep rep)]
primop args emptyVarSet
performReturn emit
Direct
ReturnInstr
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
(
emit
Alg
Return
Code tycon (CmmReg tag_reg))
performReturn emitReturn
Instr
where
result_info = getPrimOpResultInfo primop
\end{code}
...
...
compiler/codeGen/CgInfoTbls.hs
View file @
9ff76535
...
...
@@ -11,8 +11,8 @@ module CgInfoTbls (
emitInfoTableAndCode
,
dataConTagZ
,
getSRTInfo
,
emit
Direct
ReturnTarget
,
emitAlgReturnTarget
,
emit
DirectReturnInstr
,
emitVectored
ReturnInstr
,
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
<-
emit
Direct
ReturnTarget
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
--------------------------------
emit
Direct
ReturnInstr
::
Code
emit
Direct
ReturnInstr
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
; emit
Direct
ReturnTarget (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 emit
Direct
ReturnInstr }
; 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
(
emit
KnownConReturnCode con)
}
; doFinalJump sp False emit
ReturnInstr
}
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 emit
Direct
ReturnInstr }
; 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-} emit
Direct
ReturnInstr }
; doFinalJump final_sp False{-not a LNE-} emitReturnInstr }
pushUnboxedTuple :: VirtualSpOffset -- Sp at which to start pushing