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