compiler/codeGen/CgStackery.lhs

   1 %
   2 % (c) The University of Glasgow 2006
   3 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
   4 %
   5 \section[CgStackery]{Stack management functions}
   6
   7 Stack-twiddling operations, which are pretty low-down and grimy.
   8 (This is the module that knows all about stack layouts, etc.)
   9
  10 \begin{code}
  11 module CgStackery (
  12         spRel, getVirtSp, getRealSp, setRealSp,
  13         setRealAndVirtualSp, getSpRelOffset,
  14
  15         allocPrimStack, allocStackTop, deAllocStackTop,
  16         adjustStackHW, getFinalStackHW,
  17         setStackFrame, getStackFrame,
  18         mkVirtStkOffsets, mkStkAmodes,
  19         freeStackSlots,
  20         pushUpdateFrame, emitPushUpdateFrame,
  21     ) where
  22
  23 #include "HsVersions.h"
  24
  25 import CgMonad
  26 import CgUtils
  27 import CgProf
  28 import SMRep
  29 import Cmm
  30 import CmmUtils
  31 import CLabel
  32 import Constants
  33 import Util
  34 import OrdList
  35 import Outputable
  36
  37 import Control.Monad
  38 \end{code}
  39
  40 %************************************************************************
  41 %*                                                                      *
  42 \subsection[CgUsages-stackery]{Monad things for fiddling with stack usage}
  43 %*                                                                      *
  44 %************************************************************************
  45
  46 spRel is a little function that abstracts the stack direction.  Note that most
  47 of the code generator is dependent on the stack direction anyway, so
  48 changing this on its own spells certain doom.  ToDo: remove?
  49
  50         THIS IS DIRECTION SENSITIVE!
  51
  52 Stack grows down, positive virtual offsets correspond to negative
  53 additions to the stack pointer.
  54
  55 \begin{code}
  56 spRel :: VirtualSpOffset        -- virtual offset of Sp
  57       -> VirtualSpOffset        -- virtual offset of The Thing
  58       -> WordOff                -- integer offset
  59 spRel sp off = sp - off
  60 \end{code}
  61
  62 @setRealAndVirtualSp@ sets into the environment the offsets of the
  63 current position of the real and virtual stack pointers in the current
  64 stack frame.  The high-water mark is set too.  It generates no code.
  65 It is used to initialise things at the beginning of a closure body.
  66
  67 \begin{code}
  68 setRealAndVirtualSp :: VirtualSpOffset  -- New real Sp
  69                      -> Code
  70
  71 setRealAndVirtualSp new_sp
  72   = do  { stk_usg <- getStkUsage
  73         ; setStkUsage (stk_usg {virtSp = new_sp,
  74                                 realSp = new_sp,
  75                                 hwSp   = new_sp}) }
  76
  77 getVirtSp :: FCode VirtualSpOffset
  78 getVirtSp
  79   = do  { stk_usg <- getStkUsage
  80         ; return (virtSp stk_usg) }
  81
  82 getRealSp :: FCode VirtualSpOffset
  83 getRealSp
  84   = do  { stk_usg <- getStkUsage
  85         ; return (realSp stk_usg) }
  86
  87 setRealSp :: VirtualSpOffset -> Code
  88 setRealSp new_real_sp
  89   = do  { stk_usg <- getStkUsage
  90         ; setStkUsage (stk_usg {realSp = new_real_sp}) }
  91
  92 getSpRelOffset :: VirtualSpOffset -> FCode CmmExpr
  93 getSpRelOffset virtual_offset
  94   = do  { real_sp <- getRealSp
  95         ; return (cmmRegOffW spReg (spRel real_sp virtual_offset)) }
  96 \end{code}
  97
  98
  99 %************************************************************************
 100 %*                                                                      *
 101 \subsection[CgStackery-layout]{Laying out a stack frame}
 102 %*                                                                      *
 103 %************************************************************************
 104
 105 'mkVirtStkOffsets' is given a list of arguments.  The first argument
 106 gets the /largest/ virtual stack offset (remember, virtual offsets
 107 increase towards the top of stack).
 108
 109 \begin{code}
 110 mkVirtStkOffsets
 111           :: VirtualSpOffset    -- Offset of the last allocated thing
 112           -> [(CgRep,a)]                -- things to make offsets for
 113           -> (VirtualSpOffset,          -- OUTPUTS: Topmost allocated word
 114               [(a, VirtualSpOffset)])   -- things with offsets (voids filtered out)
 115
 116 mkVirtStkOffsets init_Sp_offset things
 117     = loop init_Sp_offset [] (reverse things)
 118   where
 119     loop offset offs [] = (offset,offs)
 120     loop offset offs ((VoidArg,_):things) = loop offset offs things
 121         -- ignore Void arguments
 122     loop offset offs ((rep,t):things)
 123         = loop thing_slot ((t,thing_slot):offs) things
 124         where
 125           thing_slot = offset + cgRepSizeW rep
 126             -- offset of thing is offset+size, because we're
 127             -- growing the stack *downwards* as the offsets increase.
 128
 129 -- | 'mkStkAmodes' is a higher-level version of
 130 -- 'mkVirtStkOffsets'.  It starts from the tail-call locations.
 131 -- It returns a single list of addressing modes for the stack
 132 -- locations, and therefore is in the monad.  It /doesn't/ adjust the
 133 -- high water mark.
 134
 135 mkStkAmodes
 136         :: VirtualSpOffset          -- Tail call positions
 137         -> [(CgRep,CmmExpr)]        -- things to make offsets for
 138         -> FCode (VirtualSpOffset,  -- OUTPUTS: Topmost allocated word
 139                   CmmStmts)         -- Assignments to appropriate stk slots
 140
 141 mkStkAmodes tail_Sp things
 142   = do  { rSp <- getRealSp
 143         ; let (last_Sp_offset, offsets) = mkVirtStkOffsets tail_Sp things
 144               abs_cs = [ CmmStore (cmmRegOffW spReg (spRel rSp offset)) amode
 145                        | (amode, offset) <- offsets
 146                        ]
 147         ; returnFC (last_Sp_offset, toOL abs_cs) }
 148 \end{code}
 149
 150 %************************************************************************
 151 %*                                                                      *
 152 \subsection[CgStackery-monadery]{Inside-monad functions for stack manipulation}
 153 %*                                                                      *
 154 %************************************************************************
 155
 156 Allocate a virtual offset for something.
 157
 158 \begin{code}
 159 allocPrimStack :: CgRep -> FCode VirtualSpOffset
 160 allocPrimStack rep
 161   = do  { stk_usg <- getStkUsage
 162         ; let free_stk = freeStk stk_usg
 163         ; case find_block free_stk of
 164              Nothing -> do
 165                 { let push_virt_sp = virtSp stk_usg + size
 166                 ; setStkUsage (stk_usg { virtSp = push_virt_sp,
 167                                          hwSp   = hwSp stk_usg `max` push_virt_sp })
 168                                                 -- Adjust high water mark
 169                 ; return push_virt_sp }
 170              Just slot -> do
 171                 { setStkUsage (stk_usg { freeStk = delete_block free_stk slot })
 172                 ; return slot }
 173         }
 174   where
 175     size :: WordOff
 176     size = cgRepSizeW rep
 177
 178         -- Find_block looks for a contiguous chunk of free slots
 179         -- returning the offset of its topmost word
 180     find_block :: [VirtualSpOffset] -> Maybe VirtualSpOffset
 181     find_block [] = Nothing
 182     find_block (slot:slots)
 183         | take size (slot:slots) == [slot..top_slot]
 184         = Just top_slot
 185         | otherwise
 186         = find_block slots
 187         where   -- The stack grows downwards, with increasing virtual offsets.
 188                 -- Therefore, the address of a multi-word object is the *highest*
 189                 -- virtual offset it occupies (top_slot below).
 190             top_slot = slot+size-1
 191
 192     delete_block free_stk slot = [ s | s <- free_stk,
 193                                        (s<=slot-size) || (s>slot) ]
 194                       -- Retain slots which are not in the range
 195                       -- slot-size+1..slot
 196 \end{code}
 197
 198 Allocate a chunk ON TOP OF the stack.
 199
 200 \begin{code}
 201 allocStackTop :: WordOff -> FCode VirtualSpOffset
 202 allocStackTop size
 203   = do  { stk_usg <- getStkUsage
 204         ; let push_virt_sp = virtSp stk_usg + size
 205         ; setStkUsage (stk_usg { virtSp = push_virt_sp,
 206                                  hwSp   = hwSp stk_usg `max` push_virt_sp })
 207         ; return push_virt_sp }
 208 \end{code}
 209
 210 Pop some words from the current top of stack.  This is used for
 211 de-allocating the return address in a case alternative.
 212
 213 \begin{code}
 214 deAllocStackTop :: WordOff -> FCode VirtualSpOffset
 215 deAllocStackTop size
 216   = do  { stk_usg <- getStkUsage
 217         ; let pop_virt_sp = virtSp stk_usg - size
 218         ; setStkUsage (stk_usg { virtSp = pop_virt_sp })
 219         ; return pop_virt_sp }
 220 \end{code}
 221
 222 \begin{code}
 223 adjustStackHW :: VirtualSpOffset -> Code
 224 adjustStackHW offset
 225   = do  { stk_usg <- getStkUsage
 226         ; setStkUsage (stk_usg { hwSp = hwSp stk_usg `max` offset }) }
 227 \end{code}
 228
 229 A knot-tying beast.
 230
 231 \begin{code}
 232 getFinalStackHW :: (VirtualSpOffset -> Code) -> Code
 233 getFinalStackHW fcode
 234   = do  { fixC (\hw_sp -> do
 235                 { fcode hw_sp
 236                 ; stk_usg <- getStkUsage
 237                 ; return (hwSp stk_usg) })
 238         ; return () }
 239 \end{code}
 240
 241 \begin{code}
 242 setStackFrame :: VirtualSpOffset -> Code
 243 setStackFrame offset
 244   = do  { stk_usg <- getStkUsage
 245         ; setStkUsage (stk_usg { frameSp = offset }) }
 246
 247 getStackFrame :: FCode VirtualSpOffset
 248 getStackFrame
 249   = do  { stk_usg <- getStkUsage
 250         ; return (frameSp stk_usg) }
 251 \end{code}
 252
 253
 254 %********************************************************
 255 %*                                                      *
 256 %*              Setting up update frames                *
 257 %*                                                      *
 258 %********************************************************
 259
 260 @pushUpdateFrame@ $updatee$ pushes a general update frame which
 261 points to $updatee$ as the thing to be updated.  It is only used
 262 when a thunk has just been entered, so the (real) stack pointers
 263 are guaranteed to be nicely aligned with the top of stack.
 264 @pushUpdateFrame@ adjusts the virtual and tail stack pointers
 265 to reflect the frame pushed.
 266
 267 \begin{code}
 268 pushUpdateFrame :: CmmExpr -> Code -> Code
 269 pushUpdateFrame updatee code
 270   = do  {
 271       when debugIsOn $ do
 272         { EndOfBlockInfo _ sequel <- getEndOfBlockInfo ;
 273         ; MASSERT(case sequel of { OnStack -> True; _ -> False}) }
 274         ; allocStackTop (fixedHdrSize +
 275                            sIZEOF_StgUpdateFrame_NoHdr `quot` wORD_SIZE)
 276         ; vsp <- getVirtSp
 277         ; setStackFrame vsp
 278         ; frame_addr <- getSpRelOffset vsp
 279                 -- The location of the lowest-address
 280                 -- word of the update frame itself
 281
 282         ; setEndOfBlockInfo (EndOfBlockInfo vsp UpdateCode) $
 283             do  { emitPushUpdateFrame frame_addr updatee
 284                 ; code }
 285         }
 286
 287 emitPushUpdateFrame :: CmmExpr -> CmmExpr -> Code
 288 emitPushUpdateFrame frame_addr updatee = do
 289         stmtsC [  -- Set the info word
 290                   CmmStore frame_addr (mkLblExpr mkUpdInfoLabel)
 291                 , -- And the updatee
 292                   CmmStore (cmmOffsetB frame_addr off_updatee) updatee ]
 293         initUpdFrameProf frame_addr
 294
 295 off_updatee :: ByteOff
 296 off_updatee = fixedHdrSize*wORD_SIZE + oFFSET_StgUpdateFrame_updatee
 297 \end{code}
 298
 299
 300 %************************************************************************
 301 %*                                                                      *
 302 \subsection[CgStackery-free]{Free stack slots}
 303 %*                                                                      *
 304 %************************************************************************
 305
 306 Explicitly free some stack space.
 307
 308 \begin{code}
 309 freeStackSlots :: [VirtualSpOffset] -> Code
 310 freeStackSlots extra_free
 311   = do  { stk_usg <- getStkUsage
 312         ; let all_free = addFreeSlots (freeStk stk_usg) (sortLe (<=) extra_free)
 313         ; let (new_vsp, new_free) = trim (virtSp stk_usg) all_free
 314         ; setStkUsage (stk_usg { virtSp = new_vsp, freeStk = new_free }) }
 315
 316 addFreeSlots :: [VirtualSpOffset] -> [VirtualSpOffset] -> [VirtualSpOffset]
 317 -- Merge the two, assuming both are in increasing order
 318 addFreeSlots cs [] = cs
 319 addFreeSlots [] ns = ns
 320 addFreeSlots (c:cs) (n:ns)
 321   | c < n     = c : addFreeSlots cs (n:ns)
 322   | otherwise = n : addFreeSlots (c:cs) ns
 323
 324 trim :: VirtualSpOffset -> [VirtualSpOffset] -> (VirtualSpOffset, [VirtualSpOffset])
 325 -- Try to trim back the virtual stack pointer, where there is a
 326 -- continuous bunch of free slots at the end of the free list
 327 trim vsp [] = (vsp, [])
 328 trim vsp (slot:slots)
 329   = case trim vsp slots of
 330       (vsp', [])
 331         | vsp' < slot  -> pprTrace "trim: strange" (ppr vsp <+> ppr (slot:slots))
 332                           (vsp',   [])
 333         | vsp' == slot -> (vsp'-1, [])
 334         | otherwise    -> (vsp',   [slot])
 335       (vsp', slots')   -> (vsp',   slot:slots')
 336 \end{code}