%
% (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
%
-% $Id: CgHeapery.lhs,v 1.44 2005/03/18 13:37:42 simonmar Exp $
+% $Id: CgHeapery.lhs,v 1.46 2005/04/21 15:28:20 simonmar Exp $
%
\section[CgHeapery]{Heap management functions}
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 )
= (mkConInfo dflags 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}
| caf_refs = mkIntCLit 0
| otherwise = mkIntCLit 1
+
mkStaticClosure :: CLabel -> CostCentreStack -> [CmmLit]
-> [CmmLit] -> [CmmLit] -> [CmmLit] -> [CmmLit]
mkStaticClosure info_lbl ccs payload padding_wds static_link_field saved_info_field