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
  45 import Control.Monad
  46 \end{code}
  47
  48 %************************************************************************
  49 %*                                                                      *
  50 \subsection[CgUsages-stackery]{Monad things for fiddling with stack usage}
  51 %*                                                                      *
  52 %************************************************************************
  53
  54 spRel is a little function that abstracts the stack direction.  Note that most
  55 of the code generator is dependent on the stack direction anyway, so
  56 changing this on its own spells certain doom.  ToDo: remove?
  57
  58         THIS IS DIRECTION SENSITIVE!
  59
  60 Stack grows down, positive virtual offsets correspond to negative
  61 additions to the stack pointer.
  62
  63 \begin{code}
  64 spRel :: VirtualSpOffset        -- virtual offset of Sp
  65       -> VirtualSpOffset        -- virtual offset of The Thing
  66       -> WordOff                -- integer offset
  67 spRel sp off = sp - off
  68 \end{code}
  69
  70 @setRealAndVirtualSp@ sets into the environment the offsets of the
  71 current position of the real and virtual stack pointers in the current
  72 stack frame.  The high-water mark is set too.  It generates no code.
  73 It is used to initialise things at the beginning of a closure body.
  74
  75 \begin{code}
  76 setRealAndVirtualSp :: VirtualSpOffset  -- New real Sp
  77                      -> Code
  78
  79 setRealAndVirtualSp new_sp
  80   = do  { stk_usg <- getStkUsage
  81         ; setStkUsage (stk_usg {virtSp = new_sp,
  82                                 realSp = new_sp,
  83                                 hwSp   = new_sp}) }
  84
  85 getVirtSp :: FCode VirtualSpOffset
  86 getVirtSp
  87   = do  { stk_usg <- getStkUsage
  88         ; return (virtSp stk_usg) }
  89
  90 getRealSp :: FCode VirtualSpOffset
  91 getRealSp
  92   = do  { stk_usg <- getStkUsage
  93         ; return (realSp stk_usg) }
  94
  95 setRealSp :: VirtualSpOffset -> Code
  96 setRealSp new_real_sp
  97   = do  { stk_usg <- getStkUsage
  98         ; setStkUsage (stk_usg {realSp = new_real_sp}) }
  99
 100 getSpRelOffset :: VirtualSpOffset -> FCode CmmExpr
 101 getSpRelOffset virtual_offset
 102   = do  { real_sp <- getRealSp
 103         ; return (cmmRegOffW spReg (spRel real_sp virtual_offset)) }
 104 \end{code}
 105
 106
 107 %************************************************************************
 108 %*                                                                      *
 109 \subsection[CgStackery-layout]{Laying out a stack frame}
 110 %*                                                                      *
 111 %************************************************************************
 112
 113 'mkVirtStkOffsets' is given a list of arguments.  The first argument
 114 gets the /largest/ virtual stack offset (remember, virtual offsets
 115 increase towards the top of stack).
 116
 117 \begin{code}
 118 mkVirtStkOffsets
 119           :: VirtualSpOffset    -- Offset of the last allocated thing
 120           -> [(CgRep,a)]                -- things to make offsets for
 121           -> (VirtualSpOffset,          -- OUTPUTS: Topmost allocated word
 122               [(a, VirtualSpOffset)])   -- things with offsets (voids filtered out)
 123
 124 mkVirtStkOffsets init_Sp_offset things
 125     = loop init_Sp_offset [] (reverse things)
 126   where
 127     loop offset offs [] = (offset,offs)
 128     loop offset offs ((VoidArg,t):things) = loop offset offs things
 129         -- ignore Void arguments
 130     loop offset offs ((rep,t):things)
 131         = loop thing_slot ((t,thing_slot):offs) things
 132         where
 133           thing_slot = offset + cgRepSizeW rep
 134             -- offset of thing is offset+size, because we're
 135             -- growing the stack *downwards* as the offsets increase.
 136
 137 -- | 'mkStkAmodes' is a higher-level version of
 138 -- 'mkVirtStkOffsets'.  It starts from the tail-call locations.
 139 -- It returns a single list of addressing modes for the stack
 140 -- locations, and therefore is in the monad.  It /doesn't/ adjust the
 141 -- high water mark.
 142
 143 mkStkAmodes
 144         :: VirtualSpOffset          -- Tail call positions
 145         -> [(CgRep,CmmExpr)]        -- things to make offsets for
 146         -> FCode (VirtualSpOffset,  -- OUTPUTS: Topmost allocated word
 147                   CmmStmts)         -- Assignments to appropriate stk slots
 148
 149 mkStkAmodes tail_Sp things
 150   = do  { rSp <- getRealSp
 151         ; let (last_Sp_offset, offsets) = mkVirtStkOffsets tail_Sp things
 152               abs_cs = [ CmmStore (cmmRegOffW spReg (spRel rSp offset)) amode
 153                        | (amode, offset) <- offsets
 154                        ]
 155         ; returnFC (last_Sp_offset, toOL abs_cs) }
 156 \end{code}
 157
 158 %************************************************************************
 159 %*                                                                      *
 160 \subsection[CgStackery-monadery]{Inside-monad functions for stack manipulation}
 161 %*                                                                      *
 162 %************************************************************************
 163
 164 Allocate a virtual offset for something.
 165
 166 \begin{code}
 167 allocPrimStack :: CgRep -> FCode VirtualSpOffset
 168 allocPrimStack rep
 169   = do  { stk_usg <- getStkUsage
 170         ; let free_stk = freeStk stk_usg
 171         ; case find_block free_stk of
 172              Nothing -> do
 173                 { let push_virt_sp = virtSp stk_usg + size
 174                 ; setStkUsage (stk_usg { virtSp = push_virt_sp,
 175                                          hwSp   = hwSp stk_usg `max` push_virt_sp })
 176                                                 -- Adjust high water mark
 177                 ; return push_virt_sp }
 178              Just slot -> do
 179                 { setStkUsage (stk_usg { freeStk = delete_block free_stk slot })
 180                 ; return slot }
 181         }
 182   where
 183     size :: WordOff
 184     size = cgRepSizeW rep
 185
 186         -- Find_block looks for a contiguous chunk of free slots
 187         -- returning the offset of its topmost word
 188     find_block :: [VirtualSpOffset] -> Maybe VirtualSpOffset
 189     find_block [] = Nothing
 190     find_block (slot:slots)
 191         | take size (slot:slots) == [slot..top_slot]
 192         = Just top_slot
 193         | otherwise
 194         = find_block slots
 195         where   -- The stack grows downwards, with increasing virtual offsets.
 196                 -- Therefore, the address of a multi-word object is the *highest*
 197                 -- virtual offset it occupies (top_slot below).
 198             top_slot = slot+size-1
 199
 200     delete_block free_stk slot = [ s | s <- free_stk,
 201                                        (s<=slot-size) || (s>slot) ]
 202                       -- Retain slots which are not in the range
 203                       -- slot-size+1..slot
 204 \end{code}
 205
 206 Allocate a chunk ON TOP OF the stack.
 207
 208 \begin{code}
 209 allocStackTop :: WordOff -> FCode VirtualSpOffset
 210 allocStackTop size
 211   = do  { stk_usg <- getStkUsage
 212         ; let push_virt_sp = virtSp stk_usg + size
 213         ; setStkUsage (stk_usg { virtSp = push_virt_sp,
 214                                  hwSp   = hwSp stk_usg `max` push_virt_sp })
 215         ; return push_virt_sp }
 216 \end{code}
 217
 218 Pop some words from the current top of stack.  This is used for
 219 de-allocating the return address in a case alternative.
 220
 221 \begin{code}
 222 deAllocStackTop :: WordOff -> FCode VirtualSpOffset
 223 deAllocStackTop size
 224   = do  { stk_usg <- getStkUsage
 225         ; let pop_virt_sp = virtSp stk_usg - size
 226         ; setStkUsage (stk_usg { virtSp = pop_virt_sp })
 227         ; return pop_virt_sp }
 228 \end{code}
 229
 230 \begin{code}
 231 adjustStackHW :: VirtualSpOffset -> Code
 232 adjustStackHW offset
 233   = do  { stk_usg <- getStkUsage
 234         ; setStkUsage (stk_usg { hwSp = hwSp stk_usg `max` offset }) }
 235 \end{code}
 236
 237 A knot-tying beast.
 238
 239 \begin{code}
 240 getFinalStackHW :: (VirtualSpOffset -> Code) -> Code
 241 getFinalStackHW fcode
 242   = do  { fixC (\hw_sp -> do
 243                 { fcode hw_sp
 244                 ; stk_usg <- getStkUsage
 245                 ; return (hwSp stk_usg) })
 246         ; return () }
 247 \end{code}
 248
 249 \begin{code}
 250 setStackFrame :: VirtualSpOffset -> Code
 251 setStackFrame offset
 252   = do  { stk_usg <- getStkUsage
 253         ; setStkUsage (stk_usg { frameSp = offset }) }
 254
 255 getStackFrame :: FCode VirtualSpOffset
 256 getStackFrame
 257   = do  { stk_usg <- getStkUsage
 258         ; return (frameSp stk_usg) }
 259 \end{code}
 260
 261
 262 %********************************************************
 263 %*                                                      *
 264 %*              Setting up update frames                *
 265 %*                                                      *
 266 %********************************************************
 267
 268 @pushUpdateFrame@ $updatee$ pushes a general update frame which
 269 points to $updatee$ as the thing to be updated.  It is only used
 270 when a thunk has just been entered, so the (real) stack pointers
 271 are guaranteed to be nicely aligned with the top of stack.
 272 @pushUpdateFrame@ adjusts the virtual and tail stack pointers
 273 to reflect the frame pushed.
 274
 275 \begin{code}
 276 pushUpdateFrame :: CmmExpr -> Code -> Code
 277
 278 pushUpdateFrame updatee code
 279   = do  {
 280       when debugIsOn $ do
 281         { EndOfBlockInfo _ sequel <- getEndOfBlockInfo ;
 282         ; MASSERT(case sequel of { OnStack -> True; _ -> False}) }
 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}