%
% (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
%
-% $Id: CgHeapery.lhs,v 1.10 1998/12/02 13:17:50 simonm Exp $
+% $Id: CgHeapery.lhs,v 1.18 1999/06/24 13:04:19 simonmar Exp $
%
\section[CgHeapery]{Heap management functions}
\begin{code}
module CgHeapery (
fastEntryChecks, altHeapCheck, thunkChecks,
- allocHeap, allocDynClosure
+ allocDynClosure, inPlaceAllocDynClosure
-- new functions, basically inserting macro calls into Code -- HWL
,fetchAndReschedule, yield
import CgMonad
import CgStackery ( getFinalStackHW, mkTaggedStkAmodes, mkTagAssts )
-import SMRep ( fixedHdrSize, getSMRepStr )
+import SMRep ( fixedHdrSize )
import AbsCUtils ( mkAbstractCs, getAmodeRep )
import CgUsages ( getVirtAndRealHp, getRealSp, setVirtHp, setRealHp,
initHeapUsage
closureSMRep
)
import PrimRep ( PrimRep(..), isFollowableRep )
-import Util ( panic )
+import Unique ( Unique )
import CmdLineOpts ( opt_SccProfilingOn )
import GlaExts
+import Outputable
#ifdef DEBUG
import PprAbsC ( pprMagicId ) -- tmp
-import Outputable -- tmp
#endif
\end{code}
-> [MagicId] -- live registers
-> [(VirtualSpOffset,Int)] -- stack slots to tag
-> AbstractC
- -> Maybe CLabel -- ret address if not on top of stack.
+ -> Maybe Unique -- uniq of ret address (possibly)
-> Code
-> Code
checking_code tag_assts =
case non_void_regs of
+{- no: there might be stuff on top of the retn. addr. on the stack.
+ [{-no regs-}] ->
+ CCheck HP_CHK_NOREGS
+ [mkIntCLit words_required]
+ tag_assts
+-}
-- this will cover all cases for x86
[VanillaReg rep ILIT(1)]
CCheck HP_CHK_UT_ALT
[mkIntCLit words_required, mkIntCLit 1, mkIntCLit 0,
CReg (VanillaReg RetRep ILIT(2)),
- CLbl ret_addr RetRep]
+ CLbl (mkReturnInfoLabel ret_addr) RetRep]
tag_assts
| otherwise ->
CCheck HP_CHK_UT_ALT
[mkIntCLit words_required, mkIntCLit 0, mkIntCLit 1,
CReg (VanillaReg RetRep ILIT(2)),
- CLbl ret_addr RetRep]
+ CLbl (mkReturnInfoLabel ret_addr) RetRep]
tag_assts
several_regs ->
CCheck HP_CHK_GEN
[mkIntCLit words_required,
mkIntCLit (IBOX(word2Int# liveness)),
- CLbl ret_addr RetRep]
+ -- HP_CHK_GEN needs a direct return address,
+ -- not an info table (might be different if
+ -- we're not assembly-mangling/tail-jumping etc.)
+ CLbl (mkReturnPtLabel ret_addr) RetRep]
tag_assts
-- normal algebraic and primitive case alternatives:
CCheck HP_CHK_NOREGS [mkIntCLit words_required] AbsCNop
-- The SEQ case (polymophic/function typed case branch)
+ -- We need this case because the closure in Node won't return
+ -- directly when we enter it (it could be a function), so the
+ -- heap check code needs to push a seq frame on top of the stack.
[VanillaReg rep ILIT(1)]
| rep == PtrRep
&& is_fun ->
-- build up a bitmap of the live pointer registers
mkRegLiveness :: [MagicId] -> Word#
-mkRegLiveness [] = int2Word# 0#
-mkRegLiveness (VanillaReg rep i : regs)
- | isFollowableRep rep = ((int2Word# 1#) `shiftL#` (i -# 1#))
- `or#` mkRegLiveness regs
- | otherwise = mkRegLiveness regs
+mkRegLiveness [] = int2Word# 0#
+mkRegLiveness (VanillaReg rep i : regs) | isFollowableRep rep
+ = ((int2Word# 1#) `shiftL#` (i -# 1#)) `or#` mkRegLiveness regs
+mkRegLiveness (_ : regs) = mkRegLiveness regs
-- Emit macro for simulating a fetch and then reschedule
in
-- SAY WHAT WE ARE ABOUT TO DO
profCtrC (allocProfilingMsg closure_info)
- [mkIntCLit fixedHdrSize,
- mkIntCLit (closureGoodStuffSize closure_info),
- mkIntCLit slop_size,
- mkIntCLit closure_size] `thenC`
+ [mkIntCLit (closureGoodStuffSize closure_info),
+ mkIntCLit slop_size] `thenC`
-- GENERATE THE CODE
absC ( mkAbstractCs (
-- GENERATE CC PROFILING MESSAGES
costCentresC SLIT("CCS_ALLOC") [blame_cc, mkIntCLit closure_size]
- -- CLitLit (_PK_ type_str) IntRep] -- not necessary? --SDM
`thenC`
-- BUMP THE VIRTUAL HEAP POINTER
where
closure_size = closureSize closure_info
slop_size = slopSize closure_info
- type_str = getSMRepStr (closureSMRep closure_info)
+\end{code}
--- Avoid hanging on to anything in the CC field when we're not profiling.
+Occasionally we can update a closure in place instead of allocating
+new space for it. This is the function that does the business, assuming:
-cInitHdr closure_info amode cc
- | opt_SccProfilingOn = CInitHdr closure_info amode cc
- | otherwise = CInitHdr closure_info amode (panic "absent cc")
-
-\end{code}
+ - node points to the closure to be overwritten
-%************************************************************************
-%* *
-\subsection{Allocate uninitialized heap space}
-%* *
-%************************************************************************
+ - the new closure doesn't contain any pointers if we're
+ using a generational collector.
\begin{code}
-allocHeap :: HeapOffset -- Size of the space required
- -> FCode CAddrMode -- Addr mode for first word of object
+inPlaceAllocDynClosure
+ :: ClosureInfo
+ -> CAddrMode -- Pointer to beginning of closure
+ -> CAddrMode -- Cost Centre to stick in the object
-allocHeap space
- = getVirtAndRealHp `thenFC` \ (virtHp, realHp) ->
- let block_start = virtHp + 1
+ -> [(CAddrMode, VirtualHeapOffset)] -- Offsets from start of the object
+ -- ie Info ptr has offset zero.
+ -> Code
+
+inPlaceAllocDynClosure closure_info head use_cc amodes_with_offsets
+ = let -- do_move IS THE ASSIGNMENT FUNCTION
+ do_move (amode, offset_from_start)
+ = CAssign (CVal (CIndex head (mkIntCLit offset_from_start) WordRep)
+ (getAmodeRep amode))
+ amode
in
- -- We charge the allocation to "PRIM" (which is probably right)
- profCtrC SLIT("ALLOC_PRIM2") [mkIntCLit space] `thenC`
+ -- GENERATE THE CODE
+ absC ( mkAbstractCs (
+ [ CInitHdr closure_info head use_cc ]
+ ++ (map do_move amodes_with_offsets)))
- -- BUMP THE VIRTUAL HEAP POINTER
- setVirtHp (virtHp + space) `thenC`
+-- Avoid hanging on to anything in the CC field when we're not profiling.
- -- RETURN PTR TO START OF OBJECT
- returnFC (CAddr (hpRel realHp block_start))
+cInitHdr closure_info amode cc
+ | opt_SccProfilingOn = CInitHdr closure_info (CAddr amode) cc
+ | otherwise = CInitHdr closure_info (CAddr amode) (panic "absent cc")
+
\end{code}
projects / ghc-hetmet.git / blobdiff