%
-% (c) The GRASP/AQUA Project, Glasgow University, 1992-1995
+% (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
%
\section[CgUsages]{Accessing and modifying stacks and heap usage info}
modify (\tr{set*} functions) the stacks and heap usage information.
\begin{code}
-#include "HsVersions.h"
-
module CgUsages (
initHeapUsage, setVirtHp, getVirtAndRealHp, setRealHp,
- setRealAndVirtualSps,
+ setRealAndVirtualSp,
- getVirtSps,
+ getVirtSp, getRealSp,
- getHpRelOffset, getSpARelOffset, getSpBRelOffset,
+ getHpRelOffset, getSpRelOffset,
- freeBStkSlot
+ adjustSpAndHp
) where
-IMP_Ubiq(){-uitous-}
-IMPORT_DELOOPER(CgLoop1) -- here for paranoia-checking
+#include "HsVersions.h"
-import AbsCSyn ( RegRelative(..), AbstractC, CAddrMode )
+import AbsCSyn
+import PrimRep ( PrimRep(..) )
+import AbsCUtils ( mkAbstractCs )
import CgMonad
-import HeapOffs ( zeroOff,
- SYN_IE(VirtualHeapOffset),
- SYN_IE(VirtualSpAOffset),
- SYN_IE(VirtualSpBOffset)
- )
-import Id ( SYN_IE(IdEnv) )
\end{code}
%************************************************************************
\begin{code}
initHeapUsage :: (VirtualHeapOffset -> Code) -> Code
-initHeapUsage fcode info_down (MkCgState absC binds (a_usage, b_usage, heap_usage))
+initHeapUsage fcode info_down (MkCgState absC binds (stk_usage, heap_usage))
= state3
where
- state1 = MkCgState absC binds (a_usage, b_usage, (zeroOff, zeroOff))
+ state1 = MkCgState absC binds (stk_usage, (0, 0))
state2 = fcode (heapHWM heap_usage2) info_down state1
- (MkCgState absC2 binds2 (a_usage2, b_usage2, heap_usage2)) = state2
+ (MkCgState absC2 binds2 (stk_usage2, heap_usage2)) = state2
state3 = MkCgState absC2
binds2
- (a_usage2, b_usage2, heap_usage {- unchanged -})
+ (stk_usage2, heap_usage {- unchanged -})
\end{code}
\begin{code}
setVirtHp :: VirtualHeapOffset -> Code
setVirtHp new_virtHp info_down
- state@(MkCgState absC binds (a_stk, b_stk, (virtHp, realHp)))
- = MkCgState absC binds (a_stk, b_stk, (new_virtHp, realHp))
+ state@(MkCgState absC binds (stk, (virtHp, realHp)))
+ = MkCgState absC binds (stk, (new_virtHp, realHp))
\end{code}
\begin{code}
getVirtAndRealHp :: FCode (VirtualHeapOffset, VirtualHeapOffset)
-getVirtAndRealHp info_down state@(MkCgState _ _ (au, bu, (virtHp, realHp)))
+getVirtAndRealHp info_down state@(MkCgState _ _ (_, (virtHp, realHp)))
= ((virtHp, realHp), state)
\end{code}
\begin{code}
setRealHp :: VirtualHeapOffset -> Code
-setRealHp realHp info_down (MkCgState absC binds (au, bu, (vHp, _)))
- = MkCgState absC binds (au, bu, (vHp, realHp))
+setRealHp realHp info_down (MkCgState absC binds (stk_usage, (vHp, _)))
+ = MkCgState absC binds (stk_usage, (vHp, realHp))
\end{code}
\begin{code}
getHpRelOffset :: VirtualHeapOffset -> FCode RegRelative
-getHpRelOffset virtual_offset info_down state@(MkCgState _ _ (_,_,(_,realHp)))
- = (HpRel realHp virtual_offset, state)
+getHpRelOffset virtual_offset info_down state@(MkCgState _ _ (_,(_,realHp)))
+ = (hpRel realHp virtual_offset, state)
\end{code}
The heap high water mark is the larger of virtHp and hwHp. The latter is
%* *
%************************************************************************
-@setRealAndVirtualSps@ sets into the environment the offsets of the
+@setRealAndVirtualSp@ sets into the environment the offsets of the
current position of the real and virtual stack pointers in the current
stack frame. The high-water mark is set too. It generates no code.
It is used to initialise things at the beginning of a closure body.
\begin{code}
-setRealAndVirtualSps :: VirtualSpAOffset -- New real SpA
- -> VirtualSpBOffset -- Ditto B stack
+setRealAndVirtualSp :: VirtualSpOffset -- New real Sp
-> Code
-setRealAndVirtualSps spA spB info_down (MkCgState absC binds
- ((vspA,fA,realSpA,hwspA),
- (vspB,fB,realSpB,hwspB),
- h_usage))
+setRealAndVirtualSp sp info_down (MkCgState absC binds
+ ((vsp,f,realSp,hwsp), h_usage))
= MkCgState absC binds new_usage
where
- new_usage = ((spA, fA, spA, spA),
- (spB, fB, spB, spB),
- h_usage)
+ new_usage = ((sp, f, sp, sp), h_usage)
\end{code}
\begin{code}
-getVirtSps :: FCode (VirtualSpAOffset,VirtualSpBOffset)
-getVirtSps info_down state@(MkCgState absC binds ((virtSpA,_,_,_), (virtSpB,_,_,_), _))
- = ((virtSpA,virtSpB), state)
+getVirtSp :: FCode VirtualSpOffset
+getVirtSp info_down state@(MkCgState absC binds ((virtSp,_,_,_), _))
+ = (virtSp, state)
+
+getRealSp :: FCode VirtualSpOffset
+getRealSp info_down state@(MkCgState absC binds ((_,_,realSp,_),_))
+ = (realSp,state)
\end{code}
\begin{code}
-getSpARelOffset :: VirtualSpAOffset -> FCode RegRelative
-getSpARelOffset virtual_offset info_down state@(MkCgState _ _ ((_,_,realSpA,_),_,_))
- = (SpARel realSpA virtual_offset, state)
-
-getSpBRelOffset :: VirtualSpBOffset -> FCode RegRelative
-getSpBRelOffset virtual_offset info_down state@(MkCgState _ _ (_,(_,_,realSpB,_),_))
- = (SpBRel realSpB virtual_offset, state)
+getSpRelOffset :: VirtualSpOffset -> FCode RegRelative
+getSpRelOffset virtual_offset info_down state@(MkCgState _ _ ((_,_,realSp,_),_))
+ = (spRel realSp virtual_offset, state)
\end{code}
+%************************************************************************
+%* *
+\subsection[CgStackery-adjust]{Adjusting the stack pointers}
+%* *
+%************************************************************************
+
+This function adjusts the stack and heap pointers just before a tail
+call or return. The stack pointer is adjusted to its final position
+(i.e. to point to the last argument for a tail call, or the activation
+record for a return). The heap pointer may be moved backwards, in
+cases where we overallocated at the beginning of the basic block (see
+CgCase.lhs for discussion).
+
+These functions {\em do not} deal with high-water-mark adjustment.
+That's done by functions which allocate stack space.
+
\begin{code}
-freeBStkSlot :: VirtualSpBOffset -> Code
-freeBStkSlot b_slot info_down
- state@(MkCgState absC binds (spa_usage, (virtSpB,free_b,realSpB,hwSpB), heap_usage))
- = MkCgState absC binds (spa_usage, (virtSpB,new_free_b,realSpB,hwSpB), heap_usage)
- where
- new_free_b = addFreeBSlots free_b [b_slot]
+adjustSpAndHp :: VirtualSpOffset -- New offset for Arg stack ptr
+ -> Code
+adjustSpAndHp newRealSp (MkCgInfoDown _ _ _ ticky_ctr _)
+ (MkCgState absC binds
+ ((vSp,fSp,realSp,hwSp),
+ (vHp, rHp)))
+ = MkCgState (mkAbstractCs [absC,move_sp,move_hp]) binds new_usage
+ where
+
+ move_sp = if (newRealSp == realSp) then AbsCNop
+ else (CAssign (CReg Sp)
+ (CAddr (spRel realSp newRealSp)))
+
+ -- Adjust the heap pointer backwards in case we over-allocated
+ -- Analogously, we also remove bytes from the ticky counter
+ move_hp = if (rHp == vHp) then AbsCNop
+ else mkAbstractCs [
+ CAssign (CReg Hp) (CAddr (hpRel rHp vHp)),
+ profCtrAbsC SLIT("TICK_ALLOC_HEAP")
+ [ mkIntCLit (vHp - rHp), CLbl ticky_ctr DataPtrRep ]
+ ]
+
+ new_usage = ((vSp, fSp, newRealSp, hwSp), (vHp,vHp))
\end{code}