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, 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 VirtualSpOffset
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 }
210 Pop some words from the current top of stack. This is used for
211 de-allocating the return address in a case alternative.
214 deAllocStackTop :: WordOff -> FCode VirtualSpOffset
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 }
223 adjustStackHW :: VirtualSpOffset -> Code
225 = do { stk_usg <- getStkUsage
226 ; setStkUsage (stk_usg { hwSp = hwSp stk_usg `max` offset }) }
232 getFinalStackHW :: (VirtualSpOffset -> Code) -> Code
233 getFinalStackHW fcode
234 = do { fixC (\hw_sp -> do
236 ; stk_usg <- getStkUsage
237 ; return (hwSp stk_usg) })
242 setStackFrame :: VirtualSpOffset -> Code
244 = do { stk_usg <- getStkUsage
245 ; setStkUsage (stk_usg { frameSp = offset }) }
247 getStackFrame :: FCode VirtualSpOffset
249 = do { stk_usg <- getStkUsage
250 ; return (frameSp stk_usg) }
254 %********************************************************
256 %* Setting up update frames *
258 %********************************************************
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.
268 pushUpdateFrame :: CmmExpr -> Code -> Code
269 pushUpdateFrame updatee code
272 { EndOfBlockInfo _ sequel <- getEndOfBlockInfo ;
273 ; MASSERT(case sequel of { OnStack -> True; _ -> False}) }
274 ; allocStackTop (fixedHdrSize +
275 sIZEOF_StgUpdateFrame_NoHdr `quot` wORD_SIZE)
278 ; frame_addr <- getSpRelOffset vsp
279 -- The location of the lowest-address
280 -- word of the update frame itself
282 ; setEndOfBlockInfo (EndOfBlockInfo vsp UpdateCode) $
283 do { emitPushUpdateFrame frame_addr updatee
287 emitPushUpdateFrame :: CmmExpr -> CmmExpr -> Code
288 emitPushUpdateFrame frame_addr updatee = do
289 stmtsC [ -- Set the info word
290 CmmStore frame_addr (mkLblExpr mkUpdInfoLabel)
292 CmmStore (cmmOffsetB frame_addr off_updatee) updatee ]
293 initUpdFrameProf frame_addr
295 off_updatee :: ByteOff
296 off_updatee = fixedHdrSize*wORD_SIZE + oFFSET_StgUpdateFrame_updatee
300 %************************************************************************
302 \subsection[CgStackery-free]{Free stack slots}
304 %************************************************************************
306 Explicitly free some stack space.
309 freeStackSlots :: [VirtualSpOffset] -> Code
310 freeStackSlots extra_free
311 = do { stk_usg <- getStkUsage
312 ; let all_free = addFreeSlots (freeStk stk_usg) (sortLe (<=) extra_free)
313 ; let (new_vsp, new_free) = trim (virtSp stk_usg) all_free
314 ; setStkUsage (stk_usg { virtSp = new_vsp, freeStk = new_free }) }
316 addFreeSlots :: [VirtualSpOffset] -> [VirtualSpOffset] -> [VirtualSpOffset]
317 -- Merge the two, assuming both are in increasing order
318 addFreeSlots cs [] = cs
319 addFreeSlots [] ns = ns
320 addFreeSlots (c:cs) (n:ns)
321 | c < n = c : addFreeSlots cs (n:ns)
322 | otherwise = n : addFreeSlots (c:cs) ns
324 trim :: VirtualSpOffset -> [VirtualSpOffset] -> (VirtualSpOffset, [VirtualSpOffset])
325 -- Try to trim back the virtual stack pointer, where there is a
326 -- continuous bunch of free slots at the end of the free list
327 trim vsp [] = (vsp, [])
328 trim vsp (slot:slots)
329 = case trim vsp slots of
331 | vsp' < slot -> pprTrace "trim: strange" (ppr vsp <+> ppr (slot:slots))
333 | vsp' == slot -> (vsp'-1, [])
334 | otherwise -> (vsp', [slot])
335 (vsp', slots') -> (vsp', slot:slots')