Skip to content
GitLab
Projects
Groups
Snippets
/
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Sign in / Register
Toggle navigation
Menu
Open sidebar
Shayne Fletcher
Glasgow Haskell Compiler
Commits
bf32abda
Commit
bf32abda
authored
Jul 09, 2012
by
Simon Marlow
Browse files
remove some redundant SRT-related stuff
parent
6ed684b3
Changes
6
Hide whitespace changes
Inline
Side-by-side
compiler/codeGen/StgCmm.hs
View file @
bf32abda
...
...
@@ -149,10 +149,10 @@ cgTopRhs :: Id -> StgRhs -> FCode CgIdInfo
cgTopRhs
bndr
(
StgRhsCon
_cc
con
args
)
=
forkStatics
(
cgTopRhsCon
bndr
con
args
)
cgTopRhs
bndr
(
StgRhsClosure
cc
bi
fvs
upd_flag
srt
args
body
)
cgTopRhs
bndr
(
StgRhsClosure
cc
bi
fvs
upd_flag
_
srt
args
body
)
=
ASSERT
(
null
fvs
)
-- There should be no free variables
setSRTLabel
(
mkSRTLabel
(
idName
bndr
)
(
idCafInfo
bndr
))
$
forkStatics
(
cgTopRhsClosure
bndr
cc
bi
upd_flag
srt
args
body
)
forkStatics
(
cgTopRhsClosure
bndr
cc
bi
upd_flag
args
body
)
---------------------------------------------------------------
...
...
compiler/codeGen/StgCmmBind.hs
View file @
bf32abda
...
...
@@ -68,16 +68,14 @@ cgTopRhsClosure :: Id
->
CostCentreStack
-- Optional cost centre annotation
->
StgBinderInfo
->
UpdateFlag
->
SRT
->
[
Id
]
-- Args
->
[
Id
]
-- Args
->
StgExpr
->
FCode
CgIdInfo
cgTopRhsClosure
id
ccs
_
upd_flag
srt
args
body
=
do
cgTopRhsClosure
id
ccs
_
upd_flag
args
body
=
do
{
-- LAY OUT THE OBJECT
let
name
=
idName
id
;
lf_info
<-
mkClosureLFInfo
id
TopLevel
[]
upd_flag
args
;
has_srt
<-
getSRTInfo
srt
;
mod_name
<-
getModuleName
;
dflags
<-
getDynFlags
;
let
descr
=
closureDescription
dflags
mod_name
name
...
...
@@ -86,7 +84,7 @@ cgTopRhsClosure id ccs _ upd_flag srt args body = do
cg_id_info
=
litIdInfo
id
lf_info
(
CmmLabel
closure_label
)
caffy
=
idCafInfo
id
info_tbl
=
mkCmmInfo
closure_info
-- XXX short-cut
closure_rep
=
mkStaticClosureFields
info_tbl
ccs
caffy
has_srt
[]
closure_rep
=
mkStaticClosureFields
info_tbl
ccs
caffy
[]
-- BUILD THE OBJECT, AND GENERATE INFO TABLE (IF NECESSARY)
;
emitDataLits
closure_label
closure_rep
...
...
compiler/codeGen/StgCmmCon.hs
View file @
bf32abda
...
...
@@ -92,7 +92,6 @@ cgTopRhsCon id con args
info_tbl
dontCareCCS
-- Because it's static data
caffy
-- Has CAF refs
False
-- no SRT
payload
-- BUILD THE OBJECT
...
...
compiler/codeGen/StgCmmExpr.hs
View file @
bf32abda
...
...
@@ -79,8 +79,8 @@ cgExpr (StgLetNoEscape _ _ binds expr) =
;
cgExpr
expr
;
emitLabel
join_id
}
cgExpr
(
StgCase
expr
_live_vars
_save_vars
bndr
srt
alt_type
alts
)
=
cgCase
expr
bndr
srt
alt_type
alts
cgExpr
(
StgCase
expr
_live_vars
_save_vars
bndr
_
srt
alt_type
alts
)
=
cgCase
expr
bndr
alt_type
alts
cgExpr
(
StgLam
{})
=
panic
"cgExpr: StgLam"
...
...
@@ -283,9 +283,9 @@ data GcPlan
-- of the case alternative(s) into the upstream check
-------------------------------------
cgCase
::
StgExpr
->
Id
->
SRT
->
AltType
->
[
StgAlt
]
->
FCode
()
cgCase
::
StgExpr
->
Id
->
AltType
->
[
StgAlt
]
->
FCode
()
cgCase
(
StgOpApp
(
StgPrimOp
op
)
args
_
)
bndr
_srt
(
AlgAlt
tycon
)
alts
cgCase
(
StgOpApp
(
StgPrimOp
op
)
args
_
)
bndr
(
AlgAlt
tycon
)
alts
|
isEnumerationTyCon
tycon
-- Note [case on bool]
=
do
{
tag_expr
<-
do_enum_primop
op
args
...
...
@@ -360,7 +360,7 @@ would make this special case go away.
-- code that enters the HValue, then we'll get a runtime panic, because
-- the HValue really is a MutVar#. The types are compatible though,
-- so we can just generate an assignment.
cgCase
(
StgApp
v
[]
)
bndr
_
alt_type
@
(
PrimAlt
_
)
alts
cgCase
(
StgApp
v
[]
)
bndr
alt_type
@
(
PrimAlt
_
)
alts
|
isUnLiftedType
(
idType
v
)
||
reps_compatible
=
-- assignment suffices for unlifted types
...
...
@@ -373,7 +373,7 @@ cgCase (StgApp v []) bndr _ alt_type@(PrimAlt _) alts
where
reps_compatible
=
idPrimRep
v
==
idPrimRep
bndr
cgCase
scrut
@
(
StgApp
v
[]
)
_
_
(
PrimAlt
_
)
_
cgCase
scrut
@
(
StgApp
v
[]
)
_
(
PrimAlt
_
)
_
=
-- fail at run-time, not compile-time
do
{
mb_cc
<-
maybeSaveCostCentre
True
;
withSequel
(
AssignTo
[
idToReg
(
NonVoid
v
)]
False
)
(
cgExpr
scrut
)
...
...
@@ -396,11 +396,11 @@ case a of v
(taking advantage of the fact that the return convention for (# State#, a #)
is the same as the return convention for just 'a')
-}
cgCase
(
StgOpApp
(
StgPrimOp
SeqOp
)
[
StgVarArg
a
,
_
]
_
)
bndr
srt
alt_type
alts
cgCase
(
StgOpApp
(
StgPrimOp
SeqOp
)
[
StgVarArg
a
,
_
]
_
)
bndr
alt_type
alts
=
-- handle seq#, same return convention as vanilla 'a'.
cgCase
(
StgApp
a
[]
)
bndr
srt
alt_type
alts
cgCase
(
StgApp
a
[]
)
bndr
alt_type
alts
cgCase
scrut
bndr
_srt
alt_type
alts
cgCase
scrut
bndr
alt_type
alts
=
-- the general case
do
{
up_hp_usg
<-
getVirtHp
-- Upstream heap usage
;
let
ret_bndrs
=
chooseReturnBndrs
bndr
alt_type
alts
...
...
compiler/codeGen/StgCmmHeap.hs
View file @
bf32abda
...
...
@@ -153,10 +153,9 @@ mkStaticClosureFields
::
CmmInfoTable
->
CostCentreStack
->
CafInfo
->
Bool
-- SRT is non-empty?
->
[
CmmLit
]
-- Payload
->
[
CmmLit
]
-- The full closure
mkStaticClosureFields
info_tbl
ccs
caf_refs
has_srt
payload
mkStaticClosureFields
info_tbl
ccs
caf_refs
payload
=
mkStaticClosure
info_lbl
ccs
payload
padding
static_link_field
saved_info_field
where
...
...
@@ -181,7 +180,7 @@ mkStaticClosureFields info_tbl ccs caf_refs has_srt payload
|
otherwise
=
ASSERT
(
null
payload
)
[
mkIntCLit
0
]
static_link_field
|
is_caf
||
staticClosureNeedsLink
has_srt
info_tbl
|
is_caf
||
staticClosureNeedsLink
(
mayHaveCafRefs
caf_refs
)
info_tbl
=
[
static_link_value
]
|
otherwise
=
[]
...
...
compiler/codeGen/StgCmmUtils.hs
View file @
bf32abda
...
...
@@ -44,9 +44,9 @@ module StgCmmUtils (
mkWordCLit
,
newStringCLit
,
newByteStringCLit
,
packHalfWordsCLit
,
blankWord
,
blankWord
,
getSRTInfo
,
srt_escape
srt_escape
)
where
#
include
"HsVersions.h"
...
...
@@ -66,12 +66,10 @@ import Type
import
TyCon
import
Constants
import
SMRep
import
StgSyn
(
SRT
(
..
)
)
import
Module
import
Literal
import
Digraph
import
ListSetOps
import
VarSet
import
Util
import
Unique
import
DynFlags
...
...
@@ -804,19 +802,5 @@ assignTemp' e
emitAssign
reg
e
return
(
CmmReg
reg
)
-------------------------------------------------------------------------
--
-- Static Reference Tables
--
-------------------------------------------------------------------------
-- | Returns 'True' if there is a non-empty SRT, or 'False' otherwise
-- NB. the SRT attached to an StgBind is still used in the new codegen
-- to decide whether we need a static link field on a static closure
-- or not.
getSRTInfo
::
SRT
->
FCode
Bool
getSRTInfo
(
SRTEntries
vs
)
=
return
(
not
(
isEmptyVarSet
vs
))
getSRTInfo
_
=
return
False
srt_escape
::
StgHalfWord
srt_escape
=
-
1
Write
Preview
Supports
Markdown
0%
Try again
or
attach a new file
.
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment