compiler/codeGen/CgStackery.lhs

   1 %
   2 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
   3 %
   4 % $Id: CgStackery.lhs,v 1.27 2004/09/30 10:35:49 simonpj Exp $
   5 %
   6 \section[CgStackery]{Stack management functions}
   7
   8 Stack-twiddling operations, which are pretty low-down and grimy.
   9 (This is the module that knows all about stack layouts, etc.)
  10
  11 \begin{code}
  12 module CgStackery (
  13         spRel, getVirtSp, getRealSp, setRealSp,
  14         setRealAndVirtualSp, getSpRelOffset,
  15
  16         allocPrimStack, allocStackTop, deAllocStackTop,
  17         adjustStackHW, getFinalStackHW,
  18         setStackFrame, getStackFrame,
  19         mkVirtStkOffsets, mkStkAmodes,
  20         freeStackSlots,
  21         pushUpdateFrame, emitPushUpdateFrame,
  22     ) where
  23
  24 #include "HsVersions.h"
  25
  26 import CgMonad
  27 import CgUtils          ( cmmOffsetB, cmmRegOffW )
  28 import CgProf           ( initUpdFrameProf )
  29 import SMRep
  30 import Cmm
  31 import CmmUtils         ( CmmStmts, mkLblExpr )
  32 import CLabel           ( mkUpdInfoLabel )
  33 import Constants
  34 import Util             ( sortLe )
  35 import FastString       ( LitString )
  36 import OrdList          ( toOL )
  37 import Outputable
  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,t):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
 270 pushUpdateFrame updatee code
 271   = do  {
 272 #ifdef DEBUG
 273           EndOfBlockInfo _ sequel <- getEndOfBlockInfo ;
 274           ASSERT(case sequel of { OnStack -> True; _ -> False})
 275 #endif
 276
 277           allocStackTop (fixedHdrSize +
 278                            sIZEOF_StgUpdateFrame_NoHdr `quot` wORD_SIZE)
 279         ; vsp <- getVirtSp
 280         ; setStackFrame vsp
 281         ; frame_addr <- getSpRelOffset vsp
 282                 -- The location of the lowest-address
 283                 -- word of the update frame itself
 284
 285         ; setEndOfBlockInfo (EndOfBlockInfo vsp UpdateCode) $
 286             do  { emitPushUpdateFrame frame_addr updatee
 287                 ; code }
 288         }
 289
 290 emitPushUpdateFrame :: CmmExpr -> CmmExpr -> Code
 291 emitPushUpdateFrame frame_addr updatee = do
 292         stmtsC [  -- Set the info word
 293                   CmmStore frame_addr (mkLblExpr mkUpdInfoLabel)
 294                 , -- And the updatee
 295                   CmmStore (cmmOffsetB frame_addr off_updatee) updatee ]
 296         initUpdFrameProf frame_addr
 297
 298 off_updatee :: ByteOff
 299 off_updatee = fixedHdrSize*wORD_SIZE + oFFSET_StgUpdateFrame_updatee
 300 \end{code}
 301
 302
 303 %************************************************************************
 304 %*                                                                      *
 305 \subsection[CgStackery-free]{Free stack slots}
 306 %*                                                                      *
 307 %************************************************************************
 308
 309 Explicitly free some stack space.
 310
 311 \begin{code}
 312 freeStackSlots :: [VirtualSpOffset] -> Code
 313 freeStackSlots extra_free
 314   = do  { stk_usg <- getStkUsage
 315         ; let all_free = addFreeSlots (freeStk stk_usg) (sortLe (<=) extra_free)
 316         ; let (new_vsp, new_free) = trim (virtSp stk_usg) all_free
 317         ; setStkUsage (stk_usg { virtSp = new_vsp, freeStk = new_free }) }
 318
 319 addFreeSlots :: [VirtualSpOffset] -> [VirtualSpOffset] -> [VirtualSpOffset]
 320 -- Merge the two, assuming both are in increasing order
 321 addFreeSlots cs [] = cs
 322 addFreeSlots [] ns = ns
 323 addFreeSlots (c:cs) (n:ns)
 324   | c < n     = c : addFreeSlots cs (n:ns)
 325   | otherwise = n : addFreeSlots (c:cs) ns
 326
 327 trim :: VirtualSpOffset -> [VirtualSpOffset] -> (VirtualSpOffset, [VirtualSpOffset])
 328 -- Try to trim back the virtual stack pointer, where there is a
 329 -- continuous bunch of free slots at the end of the free list
 330 trim vsp [] = (vsp, [])
 331 trim vsp (slot:slots)
 332   = case trim vsp slots of
 333       (vsp', [])
 334         | vsp' < slot  -> pprTrace "trim: strange" (ppr vsp <+> ppr (slot:slots))
 335                           (vsp',   [])
 336         | vsp' == slot -> (vsp'-1, [])
 337         | otherwise    -> (vsp',   [slot])
 338       (vsp', slots')   -> (vsp',   slot:slots')
 339 \end{code}