%
% (c) The University of Glasgow 2006
% (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
%
\section[CgStackery]{Stack management functions}
Stack-twiddling operations, which are pretty low-down and grimy.
(This is the module that knows all about stack layouts, etc.)
\begin{code}
module CgStackery (
spRel, getVirtSp, getRealSp, setRealSp,
setRealAndVirtualSp, getSpRelOffset,
allocPrimStack, allocStackTop, deAllocStackTop,
adjustStackHW, getFinalStackHW,
setStackFrame, getStackFrame,
mkVirtStkOffsets, mkStkAmodes,
freeStackSlots,
pushUpdateFrame, pushBHUpdateFrame, emitPushUpdateFrame,
) where
#include "HsVersions.h"
import CgMonad
import CgUtils
import CgProf
import SMRep
import Cmm
import CmmUtils
import CLabel
import Constants
import Util
import OrdList
import Outputable
import Control.Monad
\end{code}
%************************************************************************
%* *
\subsection[CgUsages-stackery]{Monad things for fiddling with stack usage}
%* *
%************************************************************************
spRel is a little function that abstracts the stack direction. Note that most
of the code generator is dependent on the stack direction anyway, so
changing this on its own spells certain doom. ToDo: remove?
THIS IS DIRECTION SENSITIVE!
Stack grows down, positive virtual offsets correspond to negative
additions to the stack pointer.
\begin{code}
spRel :: VirtualSpOffset
-> VirtualSpOffset
-> WordOff
spRel sp off = sp off
\end{code}
@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}
setRealAndVirtualSp :: VirtualSpOffset
-> Code
setRealAndVirtualSp new_sp
= do { stk_usg <- getStkUsage
; setStkUsage (stk_usg {virtSp = new_sp,
realSp = new_sp,
hwSp = new_sp}) }
getVirtSp :: FCode VirtualSpOffset
getVirtSp
= do { stk_usg <- getStkUsage
; return (virtSp stk_usg) }
getRealSp :: FCode VirtualSpOffset
getRealSp
= do { stk_usg <- getStkUsage
; return (realSp stk_usg) }
setRealSp :: VirtualSpOffset -> Code
setRealSp new_real_sp
= do { stk_usg <- getStkUsage
; setStkUsage (stk_usg {realSp = new_real_sp}) }
getSpRelOffset :: VirtualSpOffset -> FCode CmmExpr
getSpRelOffset virtual_offset
= do { real_sp <- getRealSp
; return (cmmRegOffW spReg (spRel real_sp virtual_offset)) }
\end{code}
%************************************************************************
%* *
\subsection[CgStackery-layout]{Laying out a stack frame}
%* *
%************************************************************************
'mkVirtStkOffsets' is given a list of arguments. The first argument
gets the /largest/ virtual stack offset (remember, virtual offsets
increase towards the top of stack).
\begin{code}
mkVirtStkOffsets
:: VirtualSpOffset
-> [(CgRep,a)]
-> (VirtualSpOffset,
[(a, VirtualSpOffset)])
mkVirtStkOffsets init_Sp_offset things
= loop init_Sp_offset [] (reverse things)
where
loop offset offs [] = (offset,offs)
loop offset offs ((VoidArg,_):things) = loop offset offs things
loop offset offs ((rep,t):things)
= loop thing_slot ((t,thing_slot):offs) things
where
thing_slot = offset + cgRepSizeW rep
mkStkAmodes
:: VirtualSpOffset
-> [(CgRep,CmmExpr)]
-> FCode (VirtualSpOffset,
CmmStmts)
mkStkAmodes tail_Sp things
= do { rSp <- getRealSp
; let (last_Sp_offset, offsets) = mkVirtStkOffsets tail_Sp things
abs_cs = [ CmmStore (cmmRegOffW spReg (spRel rSp offset)) amode
| (amode, offset) <- offsets
]
; returnFC (last_Sp_offset, toOL abs_cs) }
\end{code}
%************************************************************************
%* *
\subsection[CgStackery-monadery]{Inside-monad functions for stack manipulation}
%* *
%************************************************************************
Allocate a virtual offset for something.
\begin{code}
allocPrimStack :: CgRep -> FCode VirtualSpOffset
allocPrimStack rep
= do { stk_usg <- getStkUsage
; let free_stk = freeStk stk_usg
; case find_block free_stk of
Nothing -> do
{ let push_virt_sp = virtSp stk_usg + size
; setStkUsage (stk_usg { virtSp = push_virt_sp,
hwSp = hwSp stk_usg `max` push_virt_sp })
; return push_virt_sp }
Just slot -> do
{ setStkUsage (stk_usg { freeStk = delete_block free_stk slot })
; return slot }
}
where
size :: WordOff
size = cgRepSizeW rep
find_block :: [VirtualSpOffset] -> Maybe VirtualSpOffset
find_block [] = Nothing
find_block (slot:slots)
| take size (slot:slots) == [slot..top_slot]
= Just top_slot
| otherwise
= find_block slots
where
top_slot = slot+size1
delete_block free_stk slot = [ s | s <- free_stk,
(s<=slotsize) || (s>slot) ]
\end{code}
Allocate a chunk ON TOP OF the stack.
\begin{code}
allocStackTop :: WordOff -> FCode ()
allocStackTop size
= do { stk_usg <- getStkUsage
; let push_virt_sp = virtSp stk_usg + size
; setStkUsage (stk_usg { virtSp = push_virt_sp,
hwSp = hwSp stk_usg `max` push_virt_sp }) }
\end{code}
Pop some words from the current top of stack. This is used for
de-allocating the return address in a case alternative.
\begin{code}
deAllocStackTop :: WordOff -> FCode ()
deAllocStackTop size
= do { stk_usg <- getStkUsage
; let pop_virt_sp = virtSp stk_usg size
; setStkUsage (stk_usg { virtSp = pop_virt_sp }) }
\end{code}
\begin{code}
adjustStackHW :: VirtualSpOffset -> Code
adjustStackHW offset
= do { stk_usg <- getStkUsage
; setStkUsage (stk_usg { hwSp = hwSp stk_usg `max` offset }) }
\end{code}
A knot-tying beast.
\begin{code}
getFinalStackHW :: (VirtualSpOffset -> Code) -> Code
getFinalStackHW fcode
= do { fixC_ (\hw_sp -> do
{ fcode hw_sp
; stk_usg <- getStkUsage
; return (hwSp stk_usg) })
; return () }
\end{code}
\begin{code}
setStackFrame :: VirtualSpOffset -> Code
setStackFrame offset
= do { stk_usg <- getStkUsage
; setStkUsage (stk_usg { frameSp = offset }) }
getStackFrame :: FCode VirtualSpOffset
getStackFrame
= do { stk_usg <- getStkUsage
; return (frameSp stk_usg) }
\end{code}
%********************************************************
%* *
%* Setting up update frames *
%* *
%********************************************************
@pushUpdateFrame@ $updatee$ pushes a general update frame which
points to $updatee$ as the thing to be updated. It is only used
when a thunk has just been entered, so the (real) stack pointers
are guaranteed to be nicely aligned with the top of stack.
@pushUpdateFrame@ adjusts the virtual and tail stack pointers
to reflect the frame pushed.
\begin{code}
pushUpdateFrame :: CmmExpr -> Code -> Code
pushUpdateFrame updatee code
= pushSpecUpdateFrame mkUpdInfoLabel updatee code
pushBHUpdateFrame :: CmmExpr -> Code -> Code
pushBHUpdateFrame updatee code
= pushSpecUpdateFrame mkBHUpdInfoLabel updatee code
pushSpecUpdateFrame :: CLabel -> CmmExpr -> Code -> Code
pushSpecUpdateFrame lbl updatee code
= do {
when debugIsOn $ do
{ EndOfBlockInfo _ sequel <- getEndOfBlockInfo ;
; MASSERT(case sequel of { OnStack -> True; _ -> False}) }
; allocStackTop (fixedHdrSize +
sIZEOF_StgUpdateFrame_NoHdr `quot` wORD_SIZE)
; vsp <- getVirtSp
; setStackFrame vsp
; frame_addr <- getSpRelOffset vsp
; setEndOfBlockInfo (EndOfBlockInfo vsp OnStack) $
do { emitSpecPushUpdateFrame lbl frame_addr updatee
; code }
}
emitPushUpdateFrame :: CmmExpr -> CmmExpr -> Code
emitPushUpdateFrame = emitSpecPushUpdateFrame mkUpdInfoLabel
emitSpecPushUpdateFrame :: CLabel -> CmmExpr -> CmmExpr -> Code
emitSpecPushUpdateFrame lbl frame_addr updatee = do
stmtsC [
CmmStore frame_addr (mkLblExpr lbl)
,
CmmStore (cmmOffsetB frame_addr off_updatee) updatee ]
initUpdFrameProf frame_addr
off_updatee :: ByteOff
off_updatee = fixedHdrSize*wORD_SIZE + oFFSET_StgUpdateFrame_updatee
\end{code}
%************************************************************************
%* *
\subsection[CgStackery-free]{Free stack slots}
%* *
%************************************************************************
Explicitly free some stack space.
\begin{code}
freeStackSlots :: [VirtualSpOffset] -> Code
freeStackSlots extra_free
= do { stk_usg <- getStkUsage
; let all_free = addFreeSlots (freeStk stk_usg) (sortLe (<=) extra_free)
; let (new_vsp, new_free) = trim (virtSp stk_usg) all_free
; setStkUsage (stk_usg { virtSp = new_vsp, freeStk = new_free }) }
addFreeSlots :: [VirtualSpOffset] -> [VirtualSpOffset] -> [VirtualSpOffset]
addFreeSlots cs [] = cs
addFreeSlots [] ns = ns
addFreeSlots (c:cs) (n:ns)
| c < n = c : addFreeSlots cs (n:ns)
| otherwise = n : addFreeSlots (c:cs) ns
trim :: VirtualSpOffset -> [VirtualSpOffset] -> (VirtualSpOffset, [VirtualSpOffset])
trim vsp [] = (vsp, [])
trim vsp (slot:slots)
= case trim vsp slots of
(vsp', [])
| vsp' < slot -> pprTrace "trim: strange" (ppr vsp <+> ppr (slot:slots))
(vsp', [])
| vsp' == slot -> (vsp'1, [])
| otherwise -> (vsp', [slot])
(vsp', slots') -> (vsp', slot:slots')
\end{code}