Add a class HasDynFlags(getDynFlags)
[ghc.git] / 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 -fno-warn-tabs #-}
12 -- The above warning supression flag is a temporary kludge.
13 -- While working on this module you are encouraged to remove it and
14 -- detab the module (please do the detabbing in a separate patch). See
15 --     http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#TabsvsSpaces
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, pushBHUpdateFrame, emitPushUpdateFrame,
28     ) where
29
30 #include "HsVersions.h"
31
32 import CgMonad
33 import CgUtils
34 import CgProf
35 import ClosureInfo( CgRep(..), cgRepSizeW )
36 import SMRep
37 import OldCmm
38 import OldCmmUtils
39 import CLabel
40 import Constants
41 import Util
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,_):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 ()
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 \end{code}
216
217 Pop some words from the current top of stack.  This is used for
218 de-allocating the return address in a case alternative.
219
220 \begin{code}
221 deAllocStackTop :: WordOff -> FCode ()
222 deAllocStackTop size
223   = do  { stk_usg <- getStkUsage
224         ; let pop_virt_sp = virtSp stk_usg - size
225         ; setStkUsage (stk_usg { virtSp = 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 pushUpdateFrame updatee code
276   = pushSpecUpdateFrame mkUpdInfoLabel updatee code
277
278 pushBHUpdateFrame :: CmmExpr -> Code -> Code
279 pushBHUpdateFrame updatee code
280   = pushSpecUpdateFrame mkBHUpdInfoLabel updatee code
281
282 pushSpecUpdateFrame :: CLabel -> CmmExpr -> Code -> Code
283 pushSpecUpdateFrame lbl updatee code
284   = do  {
285       when debugIsOn $ do
286         { EndOfBlockInfo _ sequel <- getEndOfBlockInfo ;
287         ; MASSERT(case sequel of { OnStack -> True; _ -> False}) }
288         ; allocStackTop (fixedHdrSize + 
289                            sIZEOF_StgUpdateFrame_NoHdr `quot` wORD_SIZE)
290         ; vsp <- getVirtSp
291         ; setStackFrame vsp
292         ; frame_addr <- getSpRelOffset vsp
293                 -- The location of the lowest-address
294                 -- word of the update frame itself
295
296                 -- NB. we used to set the Sequel to 'UpdateCode' so
297                 -- that we could jump directly to the update code if
298                 -- we know that the next frame on the stack is an
299                 -- update frame.  However, the RTS can sometimes
300                 -- change an update frame into something else (see
301                 -- e.g. Note [upd-black-hole] in rts/sm/Scav.c), so we
302                 -- no longer make this assumption.
303         ; setEndOfBlockInfo (EndOfBlockInfo vsp OnStack) $
304             do  { emitSpecPushUpdateFrame lbl frame_addr updatee
305                 ; code }
306         }
307
308 emitPushUpdateFrame :: CmmExpr -> CmmExpr -> Code
309 emitPushUpdateFrame = emitSpecPushUpdateFrame mkUpdInfoLabel
310
311 emitSpecPushUpdateFrame :: CLabel -> CmmExpr -> CmmExpr -> Code
312 emitSpecPushUpdateFrame lbl frame_addr updatee = do
313         stmtsC [  -- Set the info word
314                   CmmStore frame_addr (mkLblExpr lbl)
315                 , -- And the updatee
316                   CmmStore (cmmOffsetB frame_addr off_updatee) updatee ]
317         initUpdFrameProf frame_addr
318
319 off_updatee :: ByteOff
320 off_updatee = fixedHdrSize*wORD_SIZE + oFFSET_StgUpdateFrame_updatee
321 \end{code}
322
323
324 %************************************************************************
325 %*                                                                      *
326 \subsection[CgStackery-free]{Free stack slots}
327 %*                                                                      *
328 %************************************************************************
329
330 Explicitly free some stack space.
331
332 \begin{code}
333 freeStackSlots :: [VirtualSpOffset] -> Code
334 freeStackSlots extra_free
335   = do  { stk_usg <- getStkUsage
336         ; let all_free = addFreeSlots (freeStk stk_usg) (sortLe (<=) extra_free)
337         ; let (new_vsp, new_free) = trim (virtSp stk_usg) all_free
338         ; setStkUsage (stk_usg { virtSp = new_vsp, freeStk = new_free }) }
339
340 addFreeSlots :: [VirtualSpOffset] -> [VirtualSpOffset] -> [VirtualSpOffset]
341 -- Merge the two, assuming both are in increasing order
342 addFreeSlots cs [] = cs
343 addFreeSlots [] ns = ns
344 addFreeSlots (c:cs) (n:ns)
345   | c < n     = c : addFreeSlots cs (n:ns)
346   | otherwise = n : addFreeSlots (c:cs) ns
347
348 trim :: VirtualSpOffset -> [VirtualSpOffset] -> (VirtualSpOffset, [VirtualSpOffset])
349 -- Try to trim back the virtual stack pointer, where there is a
350 -- continuous bunch of free slots at the end of the free list
351 trim vsp [] = (vsp, [])
352 trim vsp (slot:slots)
353   = case trim vsp slots of
354       (vsp', []) 
355         | vsp' < slot  -> pprTrace "trim: strange" (ppr vsp <+> ppr (slot:slots))
356                           (vsp',   [])
357         | vsp' == slot -> (vsp'-1, [])
358         | otherwise    -> (vsp',   [slot])
359       (vsp', slots')   -> (vsp',   slot:slots')
360 \end{code}