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