Commit b8172ba1 authored by Simon Marlow's avatar Simon Marlow

Fix an SRT-related bug

We were using the SRT information generated by the computeSRTs pass to
decide whether to add a static link field to a constructor or not, and
this broke when I disabled computeSRTs for the new code generator.  So
I've hacked it for now to only rely on the SRT information generated
by CoreToStg.
parent 3a478196
......@@ -76,16 +76,16 @@ cgTopRhsClosure :: Id
cgTopRhsClosure id ccs _ upd_flag srt args body = do
{ -- LAY OUT THE OBJECT
let name = idName id
; lf_info <- mkClosureLFInfo id TopLevel [] upd_flag args
; srt_info <- getSRTInfo srt
; lf_info <- mkClosureLFInfo id TopLevel [] upd_flag args
; has_srt <- getSRTInfo srt
; mod_name <- getModuleName
; let descr = closureDescription mod_name name
closure_info = mkClosureInfo True id lf_info 0 0 srt_info descr
closure_info = mkClosureInfo True id lf_info 0 0 descr
closure_label = mkLocalClosureLabel name (idCafInfo id)
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 []
closure_rep = mkStaticClosureFields info_tbl ccs caffy has_srt []
-- BUILD THE OBJECT, AND GENERATE INFO TABLE (IF NECESSARY)
; emitDataLits closure_label closure_rep
......@@ -161,8 +161,8 @@ cgRhs :: Id -> StgRhs -> FCode (CgIdInfo, CmmAGraph)
cgRhs name (StgRhsCon cc con args)
= buildDynCon name cc con args
cgRhs name (StgRhsClosure cc bi fvs upd_flag srt args body)
= mkRhsClosure name cc bi (nonVoidIds fvs) upd_flag srt args body
cgRhs name (StgRhsClosure cc bi fvs upd_flag _srt args body)
= mkRhsClosure name cc bi (nonVoidIds fvs) upd_flag args body
------------------------------------------------------------------------
-- Non-constructor right hand sides
......@@ -170,7 +170,7 @@ cgRhs name (StgRhsClosure cc bi fvs upd_flag srt args body)
mkRhsClosure :: Id -> CostCentreStack -> StgBinderInfo
-> [NonVoid Id] -- Free vars
-> UpdateFlag -> SRT
-> UpdateFlag
-> [Id] -- Args
-> StgExpr
-> FCode (CgIdInfo, CmmAGraph)
......@@ -214,8 +214,7 @@ for semi-obvious reasons.
mkRhsClosure bndr cc bi
[NonVoid the_fv] -- Just one free var
upd_flag -- Updatable thunk
_srt
[] -- A thunk
[] -- A thunk
body@(StgCase (StgApp scrutinee [{-no args-}])
_ _ _ _ -- ignore uniq, etc.
(AlgAlt _)
......@@ -246,8 +245,7 @@ mkRhsClosure bndr cc bi
mkRhsClosure bndr cc bi
fvs
upd_flag
_srt
[] -- No args; a thunk
[] -- No args; a thunk
body@(StgApp fun_id args)
| args `lengthIs` (arity-1)
......@@ -268,7 +266,7 @@ mkRhsClosure bndr cc bi
arity = length fvs
---------- Default case ------------------
mkRhsClosure bndr cc _ fvs upd_flag srt args body
mkRhsClosure bndr cc _ fvs upd_flag args body
= do { -- LAY OUT THE OBJECT
-- If the binder is itself a free variable, then don't store
-- it in the closure. Instead, just bind it to Node on entry.
......@@ -287,8 +285,7 @@ mkRhsClosure bndr cc _ fvs upd_flag srt args body
-- MAKE CLOSURE INFO FOR THIS CLOSURE
; lf_info <- mkClosureLFInfo bndr NotTopLevel fvs upd_flag args
; mod_name <- getModuleName
; c_srt <- getSRTInfo srt
; let name = idName bndr
; let name = idName bndr
descr = closureDescription mod_name name
fv_details :: [(NonVoid Id, VirtualHpOffset)]
(tot_wds, ptr_wds, fv_details)
......@@ -296,7 +293,7 @@ mkRhsClosure bndr cc _ fvs upd_flag srt args body
(addIdReps (map stripNV reduced_fvs))
closure_info = mkClosureInfo False -- Not static
bndr lf_info tot_wds ptr_wds
c_srt descr
descr
-- BUILD ITS INFO TABLE AND CODE
; forkClosureBody $
......@@ -342,8 +339,7 @@ cgStdThunk bndr _cc _bndr_info _body lf_info payload
descr = closureDescription mod_name (idName bndr)
closure_info = mkClosureInfo False -- Not static
bndr lf_info tot_wds ptr_wds
NoC_SRT -- No SRT for a std-form closure
descr
descr
-- ; (use_cc, blame_cc) <- chooseDynCostCentres cc [{- no args-}] body
; let use_cc = curCCS; blame_cc = curCCS
......
......@@ -650,7 +650,6 @@ data ClosureInfo
-- the rest is just an unpacked CmmInfoTable.
closureInfoLabel :: !CLabel,
closureSMRep :: !SMRep, -- representation used by storage mgr
closureSRT :: !C_SRT, -- What SRT applies to this closure
closureProf :: !ProfilingInfo
}
......@@ -660,7 +659,7 @@ mkCmmInfo ClosureInfo {..}
= CmmInfoTable { cit_lbl = closureInfoLabel
, cit_rep = closureSMRep
, cit_prof = closureProf
, cit_srt = closureSRT }
, cit_srt = NoC_SRT }
--------------------------------------
......@@ -671,16 +670,14 @@ mkClosureInfo :: Bool -- Is static
-> Id
-> LambdaFormInfo
-> Int -> Int -- Total and pointer words
-> C_SRT
-> String -- String descriptor
-> String -- String descriptor
-> ClosureInfo
mkClosureInfo is_static id lf_info tot_wds ptr_wds srt_info val_descr
mkClosureInfo is_static id lf_info tot_wds ptr_wds val_descr
= ClosureInfo { closureName = name,
closureLFInfo = lf_info,
closureInfoLabel = info_lbl,
closureSMRep = sm_rep, -- These four fields are a
closureSRT = srt_info, -- CmmInfoTable
closureProf = prof } -- ---
closureInfoLabel = info_lbl, -- These three fields are
closureSMRep = sm_rep, -- (almost) an info table
closureProf = prof } -- (we don't have an SRT yet)
where
name = idName id
sm_rep = mkHeapRep is_static ptr_wds nonptr_wds (lfClosureType lf_info)
......@@ -906,15 +903,21 @@ cafBlackHoleInfoTable
, cit_prof = NoProfilingInfo
, cit_srt = NoC_SRT }
staticClosureNeedsLink :: CmmInfoTable -> Bool
staticClosureNeedsLink :: Bool -> CmmInfoTable -> Bool
-- A static closure needs a link field to aid the GC when traversing
-- the static closure graph. But it only needs such a field if either
-- a) it has an SRT
-- b) it's a constructor with one or more pointer fields
-- In case (b), the constructor's fields themselves play the role
-- of the SRT.
staticClosureNeedsLink info_tbl@CmmInfoTable{ cit_rep = smrep }
--
-- At this point, the cit_srt field has not been calculated (that
-- happens right at the end of the Cmm pipeline), but we do have the
-- VarSet of CAFs that CoreToStg attached, and if that is empty there
-- will definitely not be an SRT.
--
staticClosureNeedsLink has_srt CmmInfoTable{ cit_rep = smrep }
| isConRep smrep = not (isStaticNoCafCon smrep)
| otherwise = needsSRT (cit_srt info_tbl)
staticClosureNeedsLink _ = False
| otherwise = has_srt -- needsSRT (cit_srt info_tbl)
staticClosureNeedsLink _ _ = False
......@@ -92,6 +92,7 @@ cgTopRhsCon id con args
info_tbl
dontCareCCS -- Because it's static data
caffy -- Has CAF refs
False -- no SRT
payload
-- BUILD THE OBJECT
......
......@@ -72,10 +72,7 @@ cgForeignCall results result_hints (CCall (CCallSpec target cconv safety)) stg_a
fc = ForeignConvention cconv arg_hints result_hints
call_target = ForeignTarget cmm_target fc
; srt <- getSRTInfo NoSRT -- SLPJ: Not sure what SRT
-- is right here
-- JD: Does it matter in the new codegen?
; emitForeignCall safety results call_target call_args srt CmmMayReturn }
; emitForeignCall safety results call_target call_args CmmMayReturn }
where
-- in the stdcall calling convention, the symbol needs @size appended
-- to it, where size is the total number of bytes of arguments. We
......@@ -93,9 +90,7 @@ emitCCall :: [(CmmFormal,ForeignHint)]
-> [(CmmActual,ForeignHint)]
-> FCode ()
emitCCall hinted_results fn hinted_args
= emitForeignCall PlayRisky results target args
NoC_SRT -- No SRT b/c we PlayRisky
CmmMayReturn
= emitForeignCall PlayRisky results target args CmmMayReturn
where
(args, arg_hints) = unzip hinted_args
(results, result_hints) = unzip hinted_results
......@@ -105,7 +100,7 @@ emitCCall hinted_results fn hinted_args
emitPrimCall :: [CmmFormal] -> CallishMachOp -> [CmmActual] -> FCode ()
emitPrimCall res op args
= emitForeignCall PlayRisky res (PrimTarget op) args NoC_SRT CmmMayReturn
= emitForeignCall PlayRisky res (PrimTarget op) args CmmMayReturn
-- alternative entry point, used by CmmParse
emitForeignCall
......@@ -113,11 +108,10 @@ emitForeignCall
-> [CmmFormal] -- where to put the results
-> ForeignTarget -- the op
-> [CmmActual] -- arguments
-> C_SRT -- the SRT of the calls continuation
-> CmmReturnInfo -- This can say "never returns"
-- only RTS procedures do this
-> FCode ()
emitForeignCall safety results target args _srt _ret
emitForeignCall safety results target args _ret
| not (playSafe safety) = do
let (caller_save, caller_load) = callerSaveVolatileRegs
emit caller_save
......
......@@ -151,9 +151,10 @@ mkStaticClosureFields
:: CmmInfoTable
-> CostCentreStack
-> CafInfo
-> Bool -- SRT is non-empty?
-> [CmmLit] -- Payload
-> [CmmLit] -- The full closure
mkStaticClosureFields info_tbl ccs caf_refs payload
mkStaticClosureFields info_tbl ccs caf_refs has_srt payload
= mkStaticClosure info_lbl ccs payload padding
static_link_field saved_info_field
where
......@@ -178,8 +179,10 @@ mkStaticClosureFields info_tbl ccs caf_refs payload
| otherwise = ASSERT(null payload) [mkIntCLit 0]
static_link_field
| is_caf || staticClosureNeedsLink info_tbl = [static_link_value]
| otherwise = []
| is_caf || staticClosureNeedsLink has_srt info_tbl
= [static_link_value]
| otherwise
= []
saved_info_field
| is_caf = [mkIntCLit 0]
......
......@@ -71,6 +71,7 @@ import Module
import Literal
import Digraph
import ListSetOps
import VarSet
import Util
import Unique
import DynFlags
......@@ -811,36 +812,13 @@ assignTemp' e
--
-------------------------------------------------------------------------
-- There is just one SRT for each top level binding; all the nested
-- bindings use sub-sections of this SRT. The label is passed down to
-- the nested bindings via the monad.
getSRTInfo :: SRT -> FCode C_SRT
getSRTInfo (SRTEntries {}) = return NoC_SRT --panic "getSRTInfo"
getSRTInfo (SRT off len bmp)
| len > hALF_WORD_SIZE_IN_BITS || bmp == [fromIntegral srt_escape]
= do { id <- newUnique
-- ; top_srt <- getSRTLabel
; let srt_desc_lbl = mkLargeSRTLabel id
-- JD: We're not constructing and emitting SRTs in the back end,
-- which renders this code wrong (it now names a now-non-existent label).
-- ; emitRODataLits srt_desc_lbl
-- ( cmmLabelOffW top_srt off
-- : mkWordCLit (fromIntegral len)
-- : map mkWordCLit bmp)
; return (C_SRT srt_desc_lbl 0 srt_escape) }
| otherwise
= do { top_srt <- getSRTLabel
; return (C_SRT top_srt off (fromIntegral (head bmp))) }
-- The fromIntegral converts to StgHalfWord
getSRTInfo NoSRT
= -- TODO: Should we panic in this case?
-- Someone obviously thinks there should be an SRT
return NoC_SRT
-- | 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