2 % (c) The University of Glasgow 2006
3 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
5 \section[CgStackery]{Stack management functions}
7 Stack-twiddling operations, which are pretty low-down and grimy.
8 (This is the module that knows all about stack layouts, etc.)
12 spRel, getVirtSp, getRealSp, setRealSp,
13 setRealAndVirtualSp, getSpRelOffset,
15 allocPrimStack, allocStackTop, deAllocStackTop,
16 adjustStackHW, getFinalStackHW,
17 setStackFrame, getStackFrame,
18 mkVirtStkOffsets, mkStkAmodes,
20 pushUpdateFrame, pushBHUpdateFrame, emitPushUpdateFrame,
23 #include "HsVersions.h"
40 %************************************************************************
42 \subsection[CgUsages-stackery]{Monad things for fiddling with stack usage}
44 %************************************************************************
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?
50 THIS IS DIRECTION SENSITIVE!
52 Stack grows down, positive virtual offsets correspond to negative
53 additions to the stack pointer.
56 spRel :: VirtualSpOffset -- virtual offset of Sp
57 -> VirtualSpOffset -- virtual offset of The Thing
58 -> WordOff -- integer offset
59 spRel sp off = sp - off
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.
68 setRealAndVirtualSp :: VirtualSpOffset -- New real Sp
71 setRealAndVirtualSp new_sp
72 = do { stk_usg <- getStkUsage
73 ; setStkUsage (stk_usg {virtSp = new_sp,
77 getVirtSp :: FCode VirtualSpOffset
79 = do { stk_usg <- getStkUsage
80 ; return (virtSp stk_usg) }
82 getRealSp :: FCode VirtualSpOffset
84 = do { stk_usg <- getStkUsage
85 ; return (realSp stk_usg) }
87 setRealSp :: VirtualSpOffset -> Code
89 = do { stk_usg <- getStkUsage
90 ; setStkUsage (stk_usg {realSp = new_real_sp}) }
92 getSpRelOffset :: VirtualSpOffset -> FCode CmmExpr
93 getSpRelOffset virtual_offset
94 = do { real_sp <- getRealSp
95 ; return (cmmRegOffW spReg (spRel real_sp virtual_offset)) }
99 %************************************************************************
101 \subsection[CgStackery-layout]{Laying out a stack frame}
103 %************************************************************************
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).
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)
116 mkVirtStkOffsets init_Sp_offset things
117 = loop init_Sp_offset [] (reverse things)
119 loop offset offs [] = (offset,offs)
120 loop offset offs ((VoidArg,_):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
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.
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
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
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
147 ; returnFC (last_Sp_offset, toOL abs_cs) }
150 %************************************************************************
152 \subsection[CgStackery-monadery]{Inside-monad functions for stack manipulation}
154 %************************************************************************
156 Allocate a virtual offset for something.
159 allocPrimStack :: CgRep -> FCode VirtualSpOffset
161 = do { stk_usg <- getStkUsage
162 ; let free_stk = freeStk stk_usg
163 ; case find_block free_stk of
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 }
171 { setStkUsage (stk_usg { freeStk = delete_block free_stk slot })
176 size = cgRepSizeW rep
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]
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
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
198 Allocate a chunk ON TOP OF the stack.
201 allocStackTop :: WordOff -> FCode ()
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 }) }
209 Pop some words from the current top of stack. This is used for
210 de-allocating the return address in a case alternative.
213 deAllocStackTop :: WordOff -> FCode ()
215 = do { stk_usg <- getStkUsage
216 ; let pop_virt_sp = virtSp stk_usg - size
217 ; setStkUsage (stk_usg { virtSp = pop_virt_sp }) }
221 adjustStackHW :: VirtualSpOffset -> Code
223 = do { stk_usg <- getStkUsage
224 ; setStkUsage (stk_usg { hwSp = hwSp stk_usg `max` offset }) }
230 getFinalStackHW :: (VirtualSpOffset -> Code) -> Code
231 getFinalStackHW fcode
232 = do { fixC_ (\hw_sp -> do
234 ; stk_usg <- getStkUsage
235 ; return (hwSp stk_usg) })
240 setStackFrame :: VirtualSpOffset -> Code
242 = do { stk_usg <- getStkUsage
243 ; setStkUsage (stk_usg { frameSp = offset }) }
245 getStackFrame :: FCode VirtualSpOffset
247 = do { stk_usg <- getStkUsage
248 ; return (frameSp stk_usg) }
252 %********************************************************
254 %* Setting up update frames *
256 %********************************************************
258 @pushUpdateFrame@ $updatee$ pushes a general update frame which
259 points to $updatee$ as the thing to be updated. It is only used
260 when a thunk has just been entered, so the (real) stack pointers
261 are guaranteed to be nicely aligned with the top of stack.
262 @pushUpdateFrame@ adjusts the virtual and tail stack pointers
263 to reflect the frame pushed.
266 pushUpdateFrame :: CmmExpr -> Code -> Code
267 pushUpdateFrame updatee code
268 = pushSpecUpdateFrame mkUpdInfoLabel updatee code
270 pushBHUpdateFrame :: CmmExpr -> Code -> Code
271 pushBHUpdateFrame updatee code
272 = pushSpecUpdateFrame mkBHUpdInfoLabel updatee code
274 pushSpecUpdateFrame :: CLabel -> CmmExpr -> Code -> Code
275 pushSpecUpdateFrame lbl updatee code
278 { EndOfBlockInfo _ sequel <- getEndOfBlockInfo ;
279 ; MASSERT(case sequel of { OnStack -> True; _ -> False}) }
280 ; allocStackTop (fixedHdrSize +
281 sIZEOF_StgUpdateFrame_NoHdr `quot` wORD_SIZE)
284 ; frame_addr <- getSpRelOffset vsp
285 -- The location of the lowest-address
286 -- word of the update frame itself
288 -- NB. we used to set the Sequel to 'UpdateCode' so
289 -- that we could jump directly to the update code if
290 -- we know that the next frame on the stack is an
291 -- update frame. However, the RTS can sometimes
292 -- change an update frame into something else (see
293 -- e.g. Note [upd-black-hole] in rts/sm/Scav.c), so we
294 -- no longer make this assumption.
295 ; setEndOfBlockInfo (EndOfBlockInfo vsp OnStack) $
296 do { emitSpecPushUpdateFrame lbl frame_addr updatee
300 emitPushUpdateFrame :: CmmExpr -> CmmExpr -> Code
301 emitPushUpdateFrame = emitSpecPushUpdateFrame mkUpdInfoLabel
303 emitSpecPushUpdateFrame :: CLabel -> CmmExpr -> CmmExpr -> Code
304 emitSpecPushUpdateFrame lbl frame_addr updatee = do
305 stmtsC [ -- Set the info word
306 CmmStore frame_addr (mkLblExpr lbl)
308 CmmStore (cmmOffsetB frame_addr off_updatee) updatee ]
309 initUpdFrameProf frame_addr
311 off_updatee :: ByteOff
312 off_updatee = fixedHdrSize*wORD_SIZE + oFFSET_StgUpdateFrame_updatee
316 %************************************************************************
318 \subsection[CgStackery-free]{Free stack slots}
320 %************************************************************************
322 Explicitly free some stack space.
325 freeStackSlots :: [VirtualSpOffset] -> Code
326 freeStackSlots extra_free
327 = do { stk_usg <- getStkUsage
328 ; let all_free = addFreeSlots (freeStk stk_usg) (sortLe (<=) extra_free)
329 ; let (new_vsp, new_free) = trim (virtSp stk_usg) all_free
330 ; setStkUsage (stk_usg { virtSp = new_vsp, freeStk = new_free }) }
332 addFreeSlots :: [VirtualSpOffset] -> [VirtualSpOffset] -> [VirtualSpOffset]
333 -- Merge the two, assuming both are in increasing order
334 addFreeSlots cs [] = cs
335 addFreeSlots [] ns = ns
336 addFreeSlots (c:cs) (n:ns)
337 | c < n = c : addFreeSlots cs (n:ns)
338 | otherwise = n : addFreeSlots (c:cs) ns
340 trim :: VirtualSpOffset -> [VirtualSpOffset] -> (VirtualSpOffset, [VirtualSpOffset])
341 -- Try to trim back the virtual stack pointer, where there is a
342 -- continuous bunch of free slots at the end of the free list
343 trim vsp [] = (vsp, [])
344 trim vsp (slot:slots)
345 = case trim vsp slots of
347 | vsp' < slot -> pprTrace "trim: strange" (ppr vsp <+> ppr (slot:slots))
349 | vsp' == slot -> (vsp'-1, [])
350 | otherwise -> (vsp', [slot])
351 (vsp', slots') -> (vsp', slot:slots')