diff options
| -rw-r--r-- | compiler/cmm/SMRep.lhs | 53 | ||||
| -rw-r--r-- | compiler/codeGen/StgCmmBind.hs | 3 | ||||
| -rw-r--r-- | compiler/codeGen/StgCmmClosure.hs | 39 | ||||
| -rw-r--r-- | compiler/codeGen/StgCmmCon.hs | 25 | ||||
| -rw-r--r-- | compiler/codeGen/StgCmmHeap.hs | 18 |
5 files changed, 78 insertions, 60 deletions
diff --git a/compiler/cmm/SMRep.lhs b/compiler/cmm/SMRep.lhs index fd60544869..bc502a30a3 100644 --- a/compiler/cmm/SMRep.lhs +++ b/compiler/cmm/SMRep.lhs @@ -10,27 +10,33 @@ Other modules should access this info through ClosureInfo. \begin{code} module SMRep ( - -- Words and bytes + -- * Words and bytes StgWord, StgHalfWord, hALF_WORD_SIZE, hALF_WORD_SIZE_IN_BITS, WordOff, ByteOff, - -- Closure repesentation + -- * Closure repesentation SMRep(..), -- CmmInfo sees the rep; no one else does IsStatic, ClosureTypeInfo(..), ArgDescr(..), Liveness, ConstrDescription, + + -- ** Construction mkHeapRep, blackHoleRep, mkStackRep, mkRTSRep, - isStaticRep, isStaticNoCafCon, + -- ** Predicates + isStaticRep, isConRep, isThunkRep, isStaticNoCafCon, + + -- ** Size-related things heapClosureSize, fixedHdrSize, arrWordsHdrSize, arrPtrsHdrSize, profHdrSize, thunkHdrSize, nonHdrSize, - rtsClosureType, rET_SMALL, rET_BIG, + -- ** RTS closure types + rtsClosureType, rET_SMALL, rET_BIG, aRG_GEN, aRG_GEN_BIG, - -- Operations over [Word8] strings + -- * Operations over [Word8] strings that don't belong here pprWord8String, stringToWord8s ) where @@ -173,6 +179,31 @@ blackHoleRep :: SMRep blackHoleRep = HeapRep False 0 0 BlackHole ----------------------------------------------------------------------------- +-- Predicates + +isStaticRep :: SMRep -> IsStatic +isStaticRep (HeapRep is_static _ _ _) = is_static +isStaticRep (StackRep {}) = False +isStaticRep (RTSRep _ rep) = isStaticRep rep + +isConRep :: SMRep -> Bool +isConRep (HeapRep _ _ _ Constr{}) = True +isConRep _ = False + +isThunkRep :: SMRep -> Bool +isThunkRep (HeapRep _ _ _ Thunk{}) = True +isThunkRep (HeapRep _ _ _ ThunkSelector{}) = True +isThunkRep (HeapRep _ _ _ BlackHole{}) = True +isThunkRep _ = False + +isStaticNoCafCon :: SMRep -> Bool +-- This should line up exactly with CONSTR_NOCAF_STATIC above +-- See Note [Static NoCaf constructors] +isStaticNoCafCon (HeapRep True 0 _ Constr{}) = True +isStaticNoCafCon _ = False + + +----------------------------------------------------------------------------- -- Size-related things -- | Size of a closure header (StgHeader in includes/rts/storage/Closures.h) @@ -202,11 +233,6 @@ thunkHdrSize = fixedHdrSize + smp_hdr where smp_hdr = sIZEOF_StgSMPThunkHeader `quot` wORD_SIZE -isStaticRep :: SMRep -> IsStatic -isStaticRep (HeapRep is_static _ _ _) = is_static -isStaticRep (StackRep {}) = False -isStaticRep (RTSRep _ rep) = isStaticRep rep - nonHdrSize :: SMRep -> WordOff nonHdrSize (HeapRep _ p np _) = p + np nonHdrSize (StackRep bs) = length bs @@ -273,12 +299,6 @@ rtsClosureType (HeapRep False _ _ BlackHole{}) = BLACKHOLE rtsClosureType _ = panic "rtsClosureType" -isStaticNoCafCon :: SMRep -> Bool --- This should line up exactly with CONSTR_NOCAF_STATIC above --- See Note [Static NoCaf constructors] -isStaticNoCafCon (HeapRep True 0 _ Constr{}) = True -isStaticNoCafCon _ = False - -- We export these ones rET_SMALL, rET_BIG, aRG_GEN, aRG_GEN_BIG :: StgHalfWord rET_SMALL = RET_SMALL @@ -345,6 +365,7 @@ pprTypeInfo (ThunkSelector offset) pprTypeInfo Thunk = ptext (sLit "Thunk") pprTypeInfo BlackHole = ptext (sLit "BlackHole") +-- XXX Does not belong here!! stringToWord8s :: String -> [Word8] stringToWord8s s = map (fromIntegral . ord) s diff --git a/compiler/codeGen/StgCmmBind.hs b/compiler/codeGen/StgCmmBind.hs index 281ad31fa2..e8874fa752 100644 --- a/compiler/codeGen/StgCmmBind.hs +++ b/compiler/codeGen/StgCmmBind.hs @@ -75,7 +75,8 @@ cgTopRhsClosure id ccs _ upd_flag srt args body = do closure_label = mkLocalClosureLabel name (idCafInfo id) cg_id_info = litIdInfo id lf_info (CmmLabel closure_label) caffy = idCafInfo id - closure_rep = mkStaticClosureFields closure_info ccs caffy [] + info_tbl = mkCmmInfo closure_info -- XXX short-cut + closure_rep = mkStaticClosureFields info_tbl ccs caffy [] -- BUILD THE OBJECT, AND GENERATE INFO TABLE (IF NECESSARY) ; emitDataLits closure_label closure_rep diff --git a/compiler/codeGen/StgCmmClosure.hs b/compiler/codeGen/StgCmmClosure.hs index bbf884bfc4..58eb427f22 100644 --- a/compiler/codeGen/StgCmmClosure.hs +++ b/compiler/codeGen/StgCmmClosure.hs @@ -39,7 +39,7 @@ module StgCmmClosure ( closureName, infoTableLabelFromCI, entryLabelFromCI, closureLabelFromCI, closureProf, closureSRT, closureLFInfo, closureSMRep, closureUpdReqd, - closureNeedsUpdSpace, closureIsThunk, + closureIsThunk, closureSingleEntry, closureReEntrant, isConstrClosure_maybe, closureFunInfo, isStandardFormThunk, isKnownFun, funTag, tagForArity, @@ -763,15 +763,6 @@ mkCmmInfo cl_info closureSize :: ClosureInfo -> WordOff closureSize cl_info = heapClosureSize (closureSMRep cl_info) -closureNeedsUpdSpace :: ClosureInfo -> Bool --- We leave space for an update if either (a) the closure is updatable --- or (b) it is a static thunk. This is because a static thunk needs --- a static link field in a predictable place (after the slop), regardless --- of whether it is updatable or not. -closureNeedsUpdSpace (ClosureInfo { closureLFInfo = - LFThunk TopLevel _ _ _ _ }) = True -closureNeedsUpdSpace cl_info = closureUpdReqd cl_info - -------------------------------------- -- Other functions over ClosureInfo -------------------------------------- @@ -801,19 +792,6 @@ blackHoleOnEntry dflags (ClosureInfo { closureLFInfo = lf_info, closureSMRep = r _other -> panic "blackHoleOnEntry" -- Should never happen - -staticClosureNeedsLink :: ClosureInfo -> 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 (ClosureInfo { closureSRT = srt }) - = needsSRT srt -staticClosureNeedsLink (ConInfo { closureSMRep = rep }) - = not (isStaticNoCafCon rep) - isStaticClosure :: ClosureInfo -> Bool isStaticClosure cl_info = isStaticRep (closureSMRep cl_info) @@ -980,7 +958,7 @@ getPredTyDescription (IParam ip _) = getOccString (ipNameName ip) getPredTyDescription (EqPred {}) = "Type equality" -------------------------------------- --- Misc things +-- CmmInfoTable-related things -------------------------------------- mkDataConInfoTable :: DataCon -> Bool -> Int -> Int -> CmmInfoTable @@ -1005,3 +983,16 @@ mkDataConInfoTable data_con is_static ptr_wds nonptr_wds ty_descr = stringToWord8s $ occNameString $ getOccName $ dataConTyCon data_con val_descr = stringToWord8s $ occNameString $ getOccName data_con + + +staticClosureNeedsLink :: 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 } + | isConRep smrep = not (isStaticNoCafCon smrep) + | otherwise = needsSRT (cit_srt info_tbl) +staticClosureNeedsLink _ = False diff --git a/compiler/codeGen/StgCmmCon.hs b/compiler/codeGen/StgCmmCon.hs index ae40daf372..ee7b0be6f2 100644 --- a/compiler/codeGen/StgCmmCon.hs +++ b/compiler/codeGen/StgCmmCon.hs @@ -67,15 +67,20 @@ cgTopRhsCon id con args -- LAY IT OUT ; let - name = idName id - lf_info = mkConLFInfo con - closure_label = mkClosureLabel name caffy - caffy = idCafInfo id -- any stgArgHasCafRefs args - - (tot_wds, -- #ptr_wds + #nonptr_wds + name = idName id + caffy = idCafInfo id -- any stgArgHasCafRefs args + closure_label = mkClosureLabel name caffy + + (tot_wds, -- #ptr_wds + #nonptr_wds ptr_wds, -- #ptr_wds nv_args_w_offsets) = mkVirtConstrOffsets (addArgReps args) - closure_info = mkConInfo True caffy con tot_wds ptr_wds + + nonptr_wds = tot_wds - ptr_wds + + -- we're not really going to emit an info table, so having + -- to make a CmmInfoTable is a bit overkill, but mkStaticClosureFields + -- needs to poke around inside it. + info_tbl = mkDataConInfoTable con True ptr_wds nonptr_wds get_lit (arg, _offset) = do { CmmLit lit <- getArgAmode arg ; return lit } @@ -85,7 +90,7 @@ cgTopRhsCon id con args -- NB2: all the amodes should be Lits! ; let closure_rep = mkStaticClosureFields - closure_info + info_tbl dontCareCCS -- Because it's static data caffy -- Has CAF refs payload @@ -93,8 +98,8 @@ cgTopRhsCon id con args -- BUILD THE OBJECT ; emitDataLits closure_label closure_rep - -- RETURN - ; return $ litIdInfo id lf_info (CmmLabel closure_label) } + -- RETURN + ; return $ litIdInfo id (mkConLFInfo con) (CmmLabel closure_label) } --------------------------------------------------------------- diff --git a/compiler/codeGen/StgCmmHeap.hs b/compiler/codeGen/StgCmmHeap.hs index 050ea10083..d094337ef5 100644 --- a/compiler/codeGen/StgCmmHeap.hs +++ b/compiler/codeGen/StgCmmHeap.hs @@ -149,16 +149,16 @@ hpStore base vals offs -- and adding a static link field if necessary. mkStaticClosureFields - :: ClosureInfo + :: CmmInfoTable -> CostCentreStack -> CafInfo -> [CmmLit] -- Payload -> [CmmLit] -- The full closure -mkStaticClosureFields cl_info ccs caf_refs payload +mkStaticClosureFields info_tbl ccs caf_refs payload = mkStaticClosure info_lbl ccs payload padding static_link_field saved_info_field where - info_lbl = infoTableLabelFromCI cl_info + info_lbl = cit_lbl info_tbl -- CAFs must have consistent layout, regardless of whether they -- are actually updatable or not. The layout of a CAF is: @@ -168,19 +168,19 @@ mkStaticClosureFields cl_info ccs caf_refs payload -- 1 indirectee -- 0 info ptr -- - -- the static_link and saved_info fields must always be in the same - -- place. So we use closureNeedsUpdSpace rather than - -- closureUpdReqd here: + -- the static_link and saved_info fields must always be in the + -- same place. So we use isThunkRep rather than closureUpdReqd + -- here: - is_caf = closureNeedsUpdSpace cl_info + is_caf = isThunkRep (cit_rep info_tbl) padding | not is_caf = [] | otherwise = ASSERT(null payload) [mkIntCLit 0] static_link_field - | is_caf || staticClosureNeedsLink cl_info = [static_link_value] - | otherwise = [] + | is_caf || staticClosureNeedsLink info_tbl = [static_link_value] + | otherwise = [] saved_info_field | is_caf = [mkIntCLit 0] |