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"
39 %************************************************************************
41 \subsection[CgUsages-stackery]{Monad things for fiddling with stack usage}
43 %************************************************************************
45 spRel is a little function that abstracts the stack direction. Note that most
46 of the code generator is dependent on the stack direction anyway, so
47 changing this on its own spells certain doom. ToDo: remove?
49 THIS IS DIRECTION SENSITIVE!
51 Stack grows down, positive virtual offsets correspond to negative
52 additions to the stack pointer.
55 spRel :: VirtualSpOffset -- virtual offset of Sp
56 -> VirtualSpOffset -- virtual offset of The Thing
57 -> WordOff -- integer offset
58 spRel sp off = sp - off
61 @setRealAndVirtualSp@ sets into the environment the offsets of the
62 current position of the real and virtual stack pointers in the current
63 stack frame. The high-water mark is set too. It generates no code.
64 It is used to initialise things at the beginning of a closure body.
67 setRealAndVirtualSp :: VirtualSpOffset -- New real Sp
70 setRealAndVirtualSp new_sp
71 = do { stk_usg <- getStkUsage
72 ; setStkUsage (stk_usg {virtSp = new_sp,
76 getVirtSp :: FCode VirtualSpOffset
78 = do { stk_usg <- getStkUsage
79 ; return (virtSp stk_usg) }
81 getRealSp :: FCode VirtualSpOffset
83 = do { stk_usg <- getStkUsage
84 ; return (realSp stk_usg) }
86 setRealSp :: VirtualSpOffset -> Code
88 = do { stk_usg <- getStkUsage
89 ; setStkUsage (stk_usg {realSp = new_real_sp}) }
91 getSpRelOffset :: VirtualSpOffset -> FCode CmmExpr
92 getSpRelOffset virtual_offset
93 = do { real_sp <- getRealSp
94 ; return (cmmRegOffW spReg (spRel real_sp virtual_offset)) }
98 %************************************************************************
100 \subsection[CgStackery-layout]{Laying out a stack frame}
102 %************************************************************************
104 'mkVirtStkOffsets' is given a list of arguments. The first argument
105 gets the /largest/ virtual stack offset (remember, virtual offsets
106 increase towards the top of stack).
110 :: VirtualSpOffset -- Offset of the last allocated thing
111 -> [(CgRep,a)] -- things to make offsets for
112 -> (VirtualSpOffset, -- OUTPUTS: Topmost allocated word
113 [(a, VirtualSpOffset)]) -- things with offsets (voids filtered out)
115 mkVirtStkOffsets init_Sp_offset things
116 = loop init_Sp_offset [] (reverse things)
118 loop offset offs [] = (offset,offs)
119 loop offset offs ((VoidArg,t):things) = loop offset offs things
120 -- ignore Void arguments
121 loop offset offs ((rep,t):things)
122 = loop thing_slot ((t,thing_slot):offs) things
124 thing_slot = offset + cgRepSizeW rep
125 -- offset of thing is offset+size, because we're
126 -- growing the stack *downwards* as the offsets increase.
128 -- | 'mkStkAmodes' is a higher-level version of
129 -- 'mkVirtStkOffsets'. It starts from the tail-call locations.
130 -- It returns a single list of addressing modes for the stack
131 -- locations, and therefore is in the monad. It /doesn't/ adjust the
135 :: VirtualSpOffset -- Tail call positions
136 -> [(CgRep,CmmExpr)] -- things to make offsets for
137 -> FCode (VirtualSpOffset, -- OUTPUTS: Topmost allocated word
138 CmmStmts) -- Assignments to appropriate stk slots
140 mkStkAmodes tail_Sp things
141 = do { rSp <- getRealSp
142 ; let (last_Sp_offset, offsets) = mkVirtStkOffsets tail_Sp things
143 abs_cs = [ CmmStore (cmmRegOffW spReg (spRel rSp offset)) amode
144 | (amode, offset) <- offsets
146 ; returnFC (last_Sp_offset, toOL abs_cs) }
149 %************************************************************************
151 \subsection[CgStackery-monadery]{Inside-monad functions for stack manipulation}
153 %************************************************************************
155 Allocate a virtual offset for something.
158 allocPrimStack :: CgRep -> FCode VirtualSpOffset
160 = do { stk_usg <- getStkUsage
161 ; let free_stk = freeStk stk_usg
162 ; case find_block free_stk of
164 { let push_virt_sp = virtSp stk_usg + size
165 ; setStkUsage (stk_usg { virtSp = push_virt_sp,
166 hwSp = hwSp stk_usg `max` push_virt_sp })
167 -- Adjust high water mark
168 ; return push_virt_sp }
170 { setStkUsage (stk_usg { freeStk = delete_block free_stk slot })
175 size = cgRepSizeW rep
177 -- Find_block looks for a contiguous chunk of free slots
178 -- returning the offset of its topmost word
179 find_block :: [VirtualSpOffset] -> Maybe VirtualSpOffset
180 find_block [] = Nothing
181 find_block (slot:slots)
182 | take size (slot:slots) == [slot..top_slot]
186 where -- The stack grows downwards, with increasing virtual offsets.
187 -- Therefore, the address of a multi-word object is the *highest*
188 -- virtual offset it occupies (top_slot below).
189 top_slot = slot+size-1
191 delete_block free_stk slot = [ s | s <- free_stk,
192 (s<=slot-size) || (s>slot) ]
193 -- Retain slots which are not in the range
197 Allocate a chunk ON TOP OF the stack.
200 allocStackTop :: WordOff -> FCode VirtualSpOffset
202 = do { stk_usg <- getStkUsage
203 ; let push_virt_sp = virtSp stk_usg + size
204 ; setStkUsage (stk_usg { virtSp = push_virt_sp,
205 hwSp = hwSp stk_usg `max` push_virt_sp })
206 ; return 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 VirtualSpOffset
215 = do { stk_usg <- getStkUsage
216 ; let pop_virt_sp = virtSp stk_usg - size
217 ; setStkUsage (stk_usg { virtSp = pop_virt_sp })
218 ; return pop_virt_sp }
222 adjustStackHW :: VirtualSpOffset -> Code
224 = do { stk_usg <- getStkUsage
225 ; setStkUsage (stk_usg { hwSp = hwSp stk_usg `max` offset }) }
231 getFinalStackHW :: (VirtualSpOffset -> Code) -> Code
232 getFinalStackHW fcode
233 = do { fixC (\hw_sp -> do
235 ; stk_usg <- getStkUsage
236 ; return (hwSp stk_usg) })
241 setStackFrame :: VirtualSpOffset -> Code
243 = do { stk_usg <- getStkUsage
244 ; setStkUsage (stk_usg { frameSp = offset }) }
246 getStackFrame :: FCode VirtualSpOffset
248 = do { stk_usg <- getStkUsage
249 ; return (frameSp stk_usg) }
253 %********************************************************
255 %* Setting up update frames *
257 %********************************************************
259 @pushUpdateFrame@ $updatee$ pushes a general update frame which
260 points to $updatee$ as the thing to be updated. It is only used
261 when a thunk has just been entered, so the (real) stack pointers
262 are guaranteed to be nicely aligned with the top of stack.
263 @pushUpdateFrame@ adjusts the virtual and tail stack pointers
264 to reflect the frame pushed.
267 pushUpdateFrame :: CmmExpr -> Code -> Code
269 pushUpdateFrame updatee code
272 EndOfBlockInfo _ sequel <- getEndOfBlockInfo ;
273 ASSERT(case sequel of { OnStack -> True; _ -> False})
276 allocStackTop (fixedHdrSize +
277 sIZEOF_StgUpdateFrame_NoHdr `quot` wORD_SIZE)
280 ; frame_addr <- getSpRelOffset vsp
281 -- The location of the lowest-address
282 -- word of the update frame itself
284 ; setEndOfBlockInfo (EndOfBlockInfo vsp UpdateCode) $
285 do { emitPushUpdateFrame frame_addr updatee
289 emitPushUpdateFrame :: CmmExpr -> CmmExpr -> Code
290 emitPushUpdateFrame frame_addr updatee = do
291 stmtsC [ -- Set the info word
292 CmmStore frame_addr (mkLblExpr mkUpdInfoLabel)
294 CmmStore (cmmOffsetB frame_addr off_updatee) updatee ]
295 initUpdFrameProf frame_addr
297 off_updatee :: ByteOff
298 off_updatee = fixedHdrSize*wORD_SIZE + oFFSET_StgUpdateFrame_updatee
302 %************************************************************************
304 \subsection[CgStackery-free]{Free stack slots}
306 %************************************************************************
308 Explicitly free some stack space.
311 freeStackSlots :: [VirtualSpOffset] -> Code
312 freeStackSlots extra_free
313 = do { stk_usg <- getStkUsage
314 ; let all_free = addFreeSlots (freeStk stk_usg) (sortLe (<=) extra_free)
315 ; let (new_vsp, new_free) = trim (virtSp stk_usg) all_free
316 ; setStkUsage (stk_usg { virtSp = new_vsp, freeStk = new_free }) }
318 addFreeSlots :: [VirtualSpOffset] -> [VirtualSpOffset] -> [VirtualSpOffset]
319 -- Merge the two, assuming both are in increasing order
320 addFreeSlots cs [] = cs
321 addFreeSlots [] ns = ns
322 addFreeSlots (c:cs) (n:ns)
323 | c < n = c : addFreeSlots cs (n:ns)
324 | otherwise = n : addFreeSlots (c:cs) ns
326 trim :: VirtualSpOffset -> [VirtualSpOffset] -> (VirtualSpOffset, [VirtualSpOffset])
327 -- Try to trim back the virtual stack pointer, where there is a
328 -- continuous bunch of free slots at the end of the free list
329 trim vsp [] = (vsp, [])
330 trim vsp (slot:slots)
331 = case trim vsp slots of
333 | vsp' < slot -> pprTrace "trim: strange" (ppr vsp <+> ppr (slot:slots))
335 | vsp' == slot -> (vsp'-1, [])
336 | otherwise -> (vsp', [slot])
337 (vsp', slots') -> (vsp', slot:slots')