Commit bf32abda authored by Simon Marlow's avatar Simon Marlow

remove some redundant SRT-related stuff

parent 6ed684b3
......@@ -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)
---------------------------------------------------------------
......
......@@ -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
......
......@@ -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
......
......@@ -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
......
......@@ -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
= []
......
......@@ -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
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment