2 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
4 \section[CgUsages]{Accessing and modifying stacks and heap usage info}
6 This module provides the functions to access (\tr{get*} functions) and
7 modify (\tr{set*} functions) the stacks and heap usage information.
11 initHeapUsage, setVirtHp, getVirtAndRealHp, setRealHp,
16 getHpRelOffset, getSpRelOffset,
21 #include "HsVersions.h"
24 import PrimRep ( PrimRep(..) )
25 import AbsCUtils ( mkAbstractCs )
29 %************************************************************************
31 \subsection[CgUsages-heapery]{Monad things for fiddling with heap usage}
33 %************************************************************************
35 @initHeapUsage@ applies a function to the amount of heap that it uses.
36 It initialises the heap usage to zeros, and passes on an unchanged
39 It is usually a prelude to performing a GC check, so everything must
40 be in a tidy and consistent state.
42 rje: Note the slightly suble fixed point behaviour needed here
44 initHeapUsage :: (VirtualHeapOffset -> Code) -> Code
46 initHeapUsage fcode = do
47 (stk_usage, heap_usage) <- getUsage
48 setUsage (stk_usage, (0,0))
49 fixC (\heap_usage2 -> do
50 fcode (heapHWM heap_usage2)
51 (_, heap_usage2) <- getUsage
53 (stk_usage2, heap_usage2) <- getUsage
54 setUsage (stk_usage2, heap_usage {-unchanged -})
58 setVirtHp :: VirtualHeapOffset -> Code
59 setVirtHp new_virtHp = do
60 (stk, (virtHp, realHp)) <- getUsage
61 setUsage (stk, (new_virtHp, realHp))
65 getVirtAndRealHp :: FCode (VirtualHeapOffset, VirtualHeapOffset)
67 (_, (virtHp, realHp)) <- getUsage
68 return (virtHp, realHp)
72 setRealHp :: VirtualHeapOffset -> Code
74 (stk_usage, (vHp, _)) <- getUsage
75 setUsage (stk_usage, (vHp, realHp))
79 getHpRelOffset :: VirtualHeapOffset -> FCode RegRelative
80 getHpRelOffset virtual_offset = do
81 (_,(_,realHp)) <- getUsage
82 return $ hpRel realHp virtual_offset
85 The heap high water mark is the larger of virtHp and hwHp. The latter is
86 only records the high water marks of forked-off branches, so to find the
87 heap high water mark you have to take the max of virtHp and hwHp. Remember,
88 virtHp never retreats!
91 heapHWM (virtHp, realHp) = virtHp
94 %************************************************************************
96 \subsection[CgUsages-stackery]{Monad things for fiddling with stack usage}
98 %************************************************************************
100 @setRealAndVirtualSp@ sets into the environment the offsets of the
101 current position of the real and virtual stack pointers in the current
102 stack frame. The high-water mark is set too. It generates no code.
103 It is used to initialise things at the beginning of a closure body.
106 setRealAndVirtualSp :: VirtualSpOffset -- New real Sp
109 setRealAndVirtualSp sp = do
110 ((vsp,f,realSp,hwsp), h_usage) <- getUsage
111 let new_usage = ((sp, f, sp, sp), h_usage)
116 getVirtSp :: FCode VirtualSpOffset
118 ((virtSp,_,_,_), _) <- getUsage
121 getRealSp :: FCode VirtualSpOffset
123 ((_,_,realSp,_),_) <- getUsage
128 getSpRelOffset :: VirtualSpOffset -> FCode RegRelative
129 getSpRelOffset virtual_offset = do
130 ((_,_,realSp,_),_) <- getUsage
131 return $ spRel realSp virtual_offset
134 %************************************************************************
136 \subsection[CgStackery-adjust]{Adjusting the stack pointers}
138 %************************************************************************
140 This function adjusts the stack and heap pointers just before a tail
141 call or return. The stack pointer is adjusted to its final position
142 (i.e. to point to the last argument for a tail call, or the activation
143 record for a return). The heap pointer may be moved backwards, in
144 cases where we overallocated at the beginning of the basic block (see
145 CgCase.lhs for discussion).
147 These functions {\em do not} deal with high-water-mark adjustment.
148 That's done by functions which allocate stack space.
151 adjustSpAndHp :: VirtualSpOffset -- New offset for Arg stack ptr
153 adjustSpAndHp newRealSp = do
154 (MkCgInfoDown _ _ _ ticky_ctr _) <- getInfoDown
155 (MkCgState absC binds
156 ((vSp,fSp,realSp,hwSp),
157 (vHp, rHp))) <- getState
158 let move_sp = if (newRealSp == realSp) then AbsCNop
159 else (CAssign (CReg Sp)
160 (CAddr (spRel realSp newRealSp)))
162 if (rHp == vHp) then AbsCNop
164 CAssign (CReg Hp) (CAddr (hpRel rHp vHp)),
165 profCtrAbsC SLIT("TICK_ALLOC_HEAP")
166 [ mkIntCLit (vHp - rHp), CLbl ticky_ctr DataPtrRep ]
168 let new_usage = ((vSp, fSp, newRealSp, hwSp), (vHp,vHp))
169 setState $ MkCgState (mkAbstractCs [absC,move_sp,move_hp]) binds new_usage