%
% (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
%
-% $Id: CgHeapery.lhs,v 1.41 2004/09/30 10:35:45 simonpj Exp $
+% $Id: CgHeapery.lhs,v 1.47 2005/06/21 10:44:41 simonmar Exp $
%
\section[CgHeapery]{Heap management functions}
#include "HsVersions.h"
-import Constants ( mIN_UPD_SIZE )
import StgSyn ( AltType(..) )
import CLabel ( CLabel, mkRtsCodeLabel )
import CgUtils ( mkWordCLit, cmmRegOffW, cmmOffsetW,
import CgParallel ( staticGranHdr, staticParHdr, doGranAllocate )
import CgStackery ( getFinalStackHW, getRealSp )
import CgCallConv ( mkRegLiveness )
-import ClosureInfo ( closureSize, closureUpdReqd,
- staticClosureNeedsLink,
- mkConInfo,
+import ClosureInfo ( closureSize, staticClosureNeedsLink,
+ mkConInfo, closureNeedsUpdSpace,
infoTableLabelFromCI, closureLabelFromCI,
nodeMustPointToIt, closureLFInfo,
ClosureInfo )
import SMRep ( CgRep(..), cgRepSizeW, separateByPtrFollowness,
- WordOff, fixedHdrSize, isVoidArg, primRepToCgRep )
+ WordOff, fixedHdrSize, thunkHdrSize,
+ isVoidArg, primRepToCgRep )
import Cmm ( CmmLit(..), CmmStmt(..), CmmExpr(..), GlobalReg(..),
CmmReg(..), hpReg, nodeReg, spReg )
import CostCentre ( CostCentreStack )
import Util ( mapAccumL, filterOut )
import Constants ( wORD_SIZE )
+import Packages ( HomeModules )
import Outputable
-import GLAEXTS
-
\end{code}
\begin{code}
layOutDynConstr, layOutStaticConstr
- :: DataCon
+ :: HomeModules
+ -> DataCon
-> [(CgRep,a)]
-> (ClosureInfo,
[(a,VirtualHpOffset)])
layOutDynConstr = layOutConstr False
layOutStaticConstr = layOutConstr True
-layOutConstr is_static data_con args
- = (mkConInfo is_static data_con tot_wds ptr_wds,
+layOutConstr is_static hmods data_con args
+ = (mkConInfo hmods is_static data_con tot_wds ptr_wds,
things_w_offsets)
where
- (tot_wds, -- #ptr_wds + #nonptr_wds
- ptr_wds, -- #ptr_wds
- things_w_offsets) = mkVirtHeapOffsets args
+ (tot_wds, -- #ptr_wds + #nonptr_wds
+ ptr_wds, -- #ptr_wds
+ things_w_offsets) = mkVirtHeapOffsets False{-not a thunk-} args
\end{code}
@mkVirtHeapOffsets@ always returns boxed things with smaller offsets
\begin{code}
mkVirtHeapOffsets
- :: [(CgRep,a)] -- Things to make offsets for
- -> (WordOff, -- *Total* number of words allocated
+ :: Bool -- True <=> is a thunk
+ -> [(CgRep,a)] -- Things to make offsets for
+ -> (WordOff, -- _Total_ number of words allocated
WordOff, -- Number of words allocated for *pointers*
[(a, VirtualHpOffset)])
-- Things with their offsets from start of
-- First in list gets lowest offset, which is initial offset + 1.
-mkVirtHeapOffsets things
+mkVirtHeapOffsets is_thunk things
= let non_void_things = filterOut (isVoidArg . fst) things
(ptrs, non_ptrs) = separateByPtrFollowness non_void_things
(wds_of_ptrs, ptrs_w_offsets) = mapAccumL computeOffset 0 ptrs
in
(tot_wds, wds_of_ptrs, ptrs_w_offsets ++ non_ptrs_w_offsets)
where
+ hdr_size | is_thunk = thunkHdrSize
+ | otherwise = fixedHdrSize
+
computeOffset wds_so_far (rep, thing)
- = (wds_so_far + cgRepSizeW rep, (thing, fixedHdrSize + wds_so_far))
+ = (wds_so_far + cgRepSizeW rep, (thing, hdr_size + wds_so_far))
\end{code}
-> [CmmLit] -- Payload
-> [CmmLit] -- The full closure
mkStaticClosureFields cl_info ccs caf_refs payload
- = mkStaticClosure info_lbl ccs payload padding_wds static_link_field
+ = mkStaticClosure info_lbl ccs payload padding_wds
+ static_link_field saved_info_field
where
info_lbl = infoTableLabelFromCI cl_info
- upd_reqd = closureUpdReqd cl_info
+ -- CAFs must have consistent layout, regardless of whether they
+ -- are actually updatable or not. The layout of a CAF is:
+ --
+ -- 3 saved_info
+ -- 2 static_link
+ -- 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:
+
+ is_caf = closureNeedsUpdSpace cl_info
- -- for the purposes of laying out the static closure, we consider all
- -- thunks to be "updatable", so that the static link field is always
- -- in the same place.
padding_wds
- | not upd_reqd = []
- | otherwise = replicate n (mkIntCLit 0) -- a bunch of 0s
- where n = max 0 (mIN_UPD_SIZE - length payload)
+ | not is_caf = []
+ | otherwise = ASSERT(null payload) [mkIntCLit 0]
- -- We always have a static link field for a thunk, it's used to
- -- save the closure's info pointer when we're reverting CAFs
- -- (see comment in Storage.c)
static_link_field
- | upd_reqd || staticClosureNeedsLink cl_info = [static_link_value]
- | otherwise = []
+ | is_caf || staticClosureNeedsLink cl_info = [static_link_value]
+ | otherwise = []
+
+ saved_info_field
+ | is_caf = [mkIntCLit 0]
+ | otherwise = []
-- for a static constructor which has NoCafRefs, we set the
-- static link field to a non-zero value so the garbage
| caf_refs = mkIntCLit 0
| otherwise = mkIntCLit 1
+
mkStaticClosure :: CLabel -> CostCentreStack -> [CmmLit]
- -> [CmmLit] -> [CmmLit] -> [CmmLit]
-mkStaticClosure info_lbl ccs payload padding_wds static_link_field
+ -> [CmmLit] -> [CmmLit] -> [CmmLit] -> [CmmLit]
+mkStaticClosure info_lbl ccs payload padding_wds static_link_field saved_info_field
= [CmmLabel info_lbl]
++ variable_header_words
++ payload
++ padding_wds
++ static_link_field
+ ++ saved_info_field
where
variable_header_words
= staticGranHdr