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, pushBHUpdateFrame, emitPushUpdateFrame,
  21     ) where
  22
  23 #include "HsVersions.h"
  24
  25 import CgMonad
  26 import CgUtils
  27 import CgProf
  28 import SMRep
  29 import OldCmm
  30 import OldCmmUtils
  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 ()
 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 \end{code}
 208
 209 Pop some words from the current top of stack.  This is used for
 210 de-allocating the return address in a case alternative.
 211
 212 \begin{code}
 213 deAllocStackTop :: WordOff -> FCode ()
 214 deAllocStackTop size
 215   = do  { stk_usg <- getStkUsage
 216         ; let pop_virt_sp = virtSp stk_usg - size
 217         ; setStkUsage (stk_usg { virtSp = pop_virt_sp }) }
 218 \end{code}
 219
 220 \begin{code}
 221 adjustStackHW :: VirtualSpOffset -> Code
 222 adjustStackHW offset
 223   = do  { stk_usg <- getStkUsage
 224         ; setStkUsage (stk_usg { hwSp = hwSp stk_usg `max` offset }) }
 225 \end{code}
 226
 227 A knot-tying beast.
 228
 229 \begin{code}
 230 getFinalStackHW :: (VirtualSpOffset -> Code) -> Code
 231 getFinalStackHW fcode
 232   = do  { fixC_ (\hw_sp -> do
 233                 { fcode hw_sp
 234                 ; stk_usg <- getStkUsage
 235                 ; return (hwSp stk_usg) })
 236         ; return () }
 237 \end{code}
 238
 239 \begin{code}
 240 setStackFrame :: VirtualSpOffset -> Code
 241 setStackFrame offset
 242   = do  { stk_usg <- getStkUsage
 243         ; setStkUsage (stk_usg { frameSp = offset }) }
 244
 245 getStackFrame :: FCode VirtualSpOffset
 246 getStackFrame
 247   = do  { stk_usg <- getStkUsage
 248         ; return (frameSp stk_usg) }
 249 \end{code}
 250
 251
 252 %********************************************************
 253 %*                                                      *
 254 %*              Setting up update frames                *
 255 %*                                                      *
 256 %********************************************************
 257
 258 @pushUpdateFrame@ $updatee$ pushes a general update frame which
 259 points to $updatee$ as the thing to be updated.  It is only used
 260 when a thunk has just been entered, so the (real) stack pointers
 261 are guaranteed to be nicely aligned with the top of stack.
 262 @pushUpdateFrame@ adjusts the virtual and tail stack pointers
 263 to reflect the frame pushed.
 264
 265 \begin{code}
 266 pushUpdateFrame :: CmmExpr -> Code -> Code
 267 pushUpdateFrame updatee code
 268   = pushSpecUpdateFrame mkUpdInfoLabel updatee code
 269
 270 pushBHUpdateFrame :: CmmExpr -> Code -> Code
 271 pushBHUpdateFrame updatee code
 272   = pushSpecUpdateFrame mkBHUpdInfoLabel updatee code
 273
 274 pushSpecUpdateFrame :: CLabel -> CmmExpr -> Code -> Code
 275 pushSpecUpdateFrame lbl updatee code
 276   = do  {
 277       when debugIsOn $ do
 278         { EndOfBlockInfo _ sequel <- getEndOfBlockInfo ;
 279         ; MASSERT(case sequel of { OnStack -> True; _ -> False}) }
 280         ; allocStackTop (fixedHdrSize +
 281                            sIZEOF_StgUpdateFrame_NoHdr `quot` wORD_SIZE)
 282         ; vsp <- getVirtSp
 283         ; setStackFrame vsp
 284         ; frame_addr <- getSpRelOffset vsp
 285                 -- The location of the lowest-address
 286                 -- word of the update frame itself
 287
 288                 -- NB. we used to set the Sequel to 'UpdateCode' so
 289                 -- that we could jump directly to the update code if
 290                 -- we know that the next frame on the stack is an
 291                 -- update frame.  However, the RTS can sometimes
 292                 -- change an update frame into something else (see
 293                 -- e.g. Note [upd-black-hole] in rts/sm/Scav.c), so we
 294                 -- no longer make this assumption.
 295         ; setEndOfBlockInfo (EndOfBlockInfo vsp OnStack) $
 296             do  { emitSpecPushUpdateFrame lbl frame_addr updatee
 297                 ; code }
 298         }
 299
 300 emitPushUpdateFrame :: CmmExpr -> CmmExpr -> Code
 301 emitPushUpdateFrame = emitSpecPushUpdateFrame mkUpdInfoLabel
 302
 303 emitSpecPushUpdateFrame :: CLabel -> CmmExpr -> CmmExpr -> Code
 304 emitSpecPushUpdateFrame lbl frame_addr updatee = do
 305         stmtsC [  -- Set the info word
 306                   CmmStore frame_addr (mkLblExpr lbl)
 307                 , -- And the updatee
 308                   CmmStore (cmmOffsetB frame_addr off_updatee) updatee ]
 309         initUpdFrameProf frame_addr
 310
 311 off_updatee :: ByteOff
 312 off_updatee = fixedHdrSize*wORD_SIZE + oFFSET_StgUpdateFrame_updatee
 313 \end{code}
 314
 315
 316 %************************************************************************
 317 %*                                                                      *
 318 \subsection[CgStackery-free]{Free stack slots}
 319 %*                                                                      *
 320 %************************************************************************
 321
 322 Explicitly free some stack space.
 323
 324 \begin{code}
 325 freeStackSlots :: [VirtualSpOffset] -> Code
 326 freeStackSlots extra_free
 327   = do  { stk_usg <- getStkUsage
 328         ; let all_free = addFreeSlots (freeStk stk_usg) (sortLe (<=) extra_free)
 329         ; let (new_vsp, new_free) = trim (virtSp stk_usg) all_free
 330         ; setStkUsage (stk_usg { virtSp = new_vsp, freeStk = new_free }) }
 331
 332 addFreeSlots :: [VirtualSpOffset] -> [VirtualSpOffset] -> [VirtualSpOffset]
 333 -- Merge the two, assuming both are in increasing order
 334 addFreeSlots cs [] = cs
 335 addFreeSlots [] ns = ns
 336 addFreeSlots (c:cs) (n:ns)
 337   | c < n     = c : addFreeSlots cs (n:ns)
 338   | otherwise = n : addFreeSlots (c:cs) ns
 339
 340 trim :: VirtualSpOffset -> [VirtualSpOffset] -> (VirtualSpOffset, [VirtualSpOffset])
 341 -- Try to trim back the virtual stack pointer, where there is a
 342 -- continuous bunch of free slots at the end of the free list
 343 trim vsp [] = (vsp, [])
 344 trim vsp (slot:slots)
 345   = case trim vsp slots of
 346       (vsp', [])
 347         | vsp' < slot  -> pprTrace "trim: strange" (ppr vsp <+> ppr (slot:slots))
 348                           (vsp',   [])
 349         | vsp' == slot -> (vsp'-1, [])
 350         | otherwise    -> (vsp',   [slot])
 351       (vsp', slots')   -> (vsp',   slot:slots')
 352 \end{code}