% % (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 	-- virtual offset of Sp
          -> VirtualSpOffset 	-- virtual offset of The Thing
          -> WordOff		-- integer offset
    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 	-- New real Sp
    		     -> 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 	-- Offset of the last allocated thing
    	  -> [(CgRep,a)]		-- things to make offsets for
    	  -> (VirtualSpOffset,		-- OUTPUTS: Topmost allocated word
    	      [(a, VirtualSpOffset)])	-- things with offsets (voids filtered out)

    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
    	-- ignore Void arguments
        loop offset offs ((rep,t):things)
    	= loop thing_slot ((t,thing_slot):offs) things
    	where
    	  thing_slot = offset + cgRepSizeW rep
    	    -- offset of thing is offset+size, because we're
    	    -- growing the stack *downwards* as the offsets increase.

    -- | 'mkStkAmodes' is a higher-level version of
    -- 'mkVirtStkOffsets'.  It starts from the tail-call locations.
    -- It returns a single list of addressing modes for the stack
    -- locations, and therefore is in the monad.  It /doesn't/ adjust the
    -- high water mark.

    mkStkAmodes
    	:: VirtualSpOffset	    -- Tail call positions
    	-> [(CgRep,CmmExpr)]	    -- things to make offsets for
    	-> FCode (VirtualSpOffset,  -- OUTPUTS: Topmost allocated word
    	          CmmStmts)	    -- Assignments to appropriate stk slots

    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 })
    						-- Adjust high water mark
    		; 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 looks for a contiguous chunk of free slots
    	-- returning the offset of its topmost word
        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	-- The stack grows downwards, with increasing virtual offsets.
    		-- Therefore, the address of a multi-word object is the *highest*
    		-- virtual offset it occupies (top_slot below).
    	    top_slot = slot+size-1

        delete_block free_stk slot = [ s | s <- free_stk,
    				       (s<=slot-size) || (s>slot) ]
    		      -- Retain slots which are not in the range
    		      -- slot-size+1..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
    		-- The location of the lowest-address
    		-- word of the update frame itself

                    -- NB. we used to set the Sequel to 'UpdateCode' so
                    -- that we could jump directly to the update code if
                    -- we know that the next frame on the stack is an
                    -- update frame.  However, the RTS can sometimes
                    -- change an update frame into something else (see
                    -- e.g. Note [upd-black-hole] in rts/sm/Scav.c), so we
                    -- no longer make this assumption.
    	; 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 [  -- Set the info word
    		  CmmStore frame_addr (mkLblExpr lbl)
    		, -- And the updatee
    		  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]
    -- Merge the two, assuming both are in increasing order
    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])
    -- Try to trim back the virtual stack pointer, where there is a
    -- continuous bunch of free slots at the end of the free list
    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}