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 ()
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
270 { EndOfBlockInfo _ sequel <- getEndOfBlockInfo ;
271 ; MASSERT(case sequel of { OnStack -> True; _ -> False}) }
272 ; allocStackTop (fixedHdrSize +
273 sIZEOF_StgUpdateFrame_NoHdr `quot` wORD_SIZE)
276 ; frame_addr <- getSpRelOffset vsp
277 -- The location of the lowest-address
278 -- word of the update frame itself
280 ; setEndOfBlockInfo (EndOfBlockInfo vsp UpdateCode) $
281 do { emitPushUpdateFrame frame_addr updatee
285 emitPushUpdateFrame :: CmmExpr -> CmmExpr -> Code
286 emitPushUpdateFrame frame_addr updatee = do
287 stmtsC [ -- Set the info word
288 CmmStore frame_addr (mkLblExpr mkUpdInfoLabel)
290 CmmStore (cmmOffsetB frame_addr off_updatee) updatee ]
291 initUpdFrameProf frame_addr
293 off_updatee :: ByteOff
294 off_updatee = fixedHdrSize*wORD_SIZE + oFFSET_StgUpdateFrame_updatee
298 %************************************************************************
300 \subsection[CgStackery-free]{Free stack slots}
302 %************************************************************************
304 Explicitly free some stack space.
307 freeStackSlots :: [VirtualSpOffset] -> Code
308 freeStackSlots extra_free
309 = do { stk_usg <- getStkUsage
310 ; let all_free = addFreeSlots (freeStk stk_usg) (sortLe (<=) extra_free)
311 ; let (new_vsp, new_free) = trim (virtSp stk_usg) all_free
312 ; setStkUsage (stk_usg { virtSp = new_vsp, freeStk = new_free }) }
314 addFreeSlots :: [VirtualSpOffset] -> [VirtualSpOffset] -> [VirtualSpOffset]
315 -- Merge the two, assuming both are in increasing order
316 addFreeSlots cs [] = cs
317 addFreeSlots [] ns = ns
318 addFreeSlots (c:cs) (n:ns)
319 | c < n = c : addFreeSlots cs (n:ns)
320 | otherwise = n : addFreeSlots (c:cs) ns
322 trim :: VirtualSpOffset -> [VirtualSpOffset] -> (VirtualSpOffset, [VirtualSpOffset])
323 -- Try to trim back the virtual stack pointer, where there is a
324 -- continuous bunch of free slots at the end of the free list
325 trim vsp [] = (vsp, [])
326 trim vsp (slot:slots)
327 = case trim vsp slots of
329 | vsp' < slot -> pprTrace "trim: strange" (ppr vsp <+> ppr (slot:slots))
331 | vsp' == slot -> (vsp'-1, [])
332 | otherwise -> (vsp', [slot])
333 (vsp', slots') -> (vsp', slot:slots')